;; 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) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.main.data.history
  (:require [cuerdas.core :as str]
            [beicon.core :as rx]
            [lentes.core :as l]
            [uxbox.util.rstore :as rs]
            [uxbox.util.router :as r]
            [uxbox.main.repo :as rp]
            [uxbox.util.i18n :refer (tr)]
            [uxbox.util.forms :as sc]
            [uxbox.main.data.pages :as udp]
            [uxbox.main.state :as st]
            [uxbox.util.datetime :as dt]
            [uxbox.util.data :refer (without-keys
                                     replace-by-id
                                     index-by)]))

;; --- Watch Page Changes

(declare fetch-page-history)
(declare fetch-pinned-page-history)

(defn watch-page-changes
  "A function that starts watching for `IPageUpdate`
  events emited to the global event stream and just
  reacts on them emiting an other event that just
  persists the state of the page in an undo stack."
  []
  (letfn [(on-value [id]
            (rs/emit! (fetch-page-history id)
                      (fetch-pinned-page-history id)))]
    (as-> rs/stream $
      (rx/filter udp/page-persisted? $)
      (rx/delay 500 $)
      (rx/map (comp :id :page) $)
      (rx/on-value $ on-value))))

;; --- Pinned Page History Fetched

(declare update-history-index)

(defrecord PinnedPageHistoryFetched [history]
  rs/UpdateEvent
  (-apply-update [_ state]
    (-> state
        (assoc-in [:workspace :history :pinned-items] (mapv :version history))
        (update-history-index history true))))

;; --- Fetch Pinned Page History

(defrecord FetchPinnedPageHistory [id]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (letfn [(on-success [{history :payload}]
              (->PinnedPageHistoryFetched (into [] history)))]
      (let [params {:page id :pinned true}]
        (->> (rp/req :fetch/page-history params)
             (rx/map on-success))))))

(defn fetch-pinned-page-history
  [id]
  (->FetchPinnedPageHistory id))

;; --- Page History Fetched

(defrecord PageHistoryFetched [history append?]
  rs/UpdateEvent
  (-apply-update [_ state]
    (letfn [(update-counters [state items]
              (-> (assoc state :min-version (apply min items))
                  (assoc :max-version (apply max items))))

            (update-lists [state items]
              (if append?
                (update state :items #(reduce conj %1 items))
                (assoc state :items items)))]

      (let [items (mapv :version history)
            hstate (-> (get-in state [:workspace :history] {})
                       (update-counters items)
                       (update-lists items))]
        (-> state
            (assoc-in [:workspace :history] hstate)
            (update-history-index history append?))))))

;; --- Fetch Page History

(defrecord FetchPageHistory [id since max]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (letfn [(on-success [{history :payload}]
              (let [history (into [] history)]
                (->PageHistoryFetched history (not (nil? since)))))]
      (let [params (merge
                    {:page id :max (or max 15)}
                    (when since {:since since}))]
        (->> (rp/req :fetch/page-history params)
             (rx/map on-success))))))

(defn fetch-page-history
  ([id]
   (fetch-page-history id nil))
  ([id params]
   (map->FetchPageHistory (assoc params :id id))))

;; --- Select Page History

(defrecord SelectPageHistory [version]
  rs/UpdateEvent
  (-apply-update [_ state]
    (let [item (get-in state [:workspace :history :by-version version])
          page (get-in state [:pages (:page item)])
          page (assoc page
                      :history true
                      :data (:data item))]
      (-> state
          (udp/assoc-page page)
          (assoc-in [:workspace :history :selected] version)))))

(defn select-page-history
  [version]
  (SelectPageHistory. version))

;; --- Apply selected history

(defrecord ApplySelectedHistory [id]
  rs/UpdateEvent
  (-apply-update [_ state]
    (-> state
        (update-in [:pages id] dissoc :history)
        (assoc-in [:workspace :history :selected] nil)))

  rs/WatchEvent
  (-apply-watch [_ state s]
    (rx/of (udp/persist-page id))))

(defn apply-selected-history
  [id]
  (ApplySelectedHistory. id))

;; --- Deselect Page History

(defrecord DeselectPageHistory [id]
  rs/UpdateEvent
  (-apply-update [_ state]
    (let [packed (get-in state [:packed-pages id])]
      (-> (udp/assoc-page state packed)
          (assoc-in [:workspace :history :deselecting] true)
          (assoc-in [:workspace :history :selected] nil))))

  rs/WatchEvent
  (-apply-watch [_ state s]
    (->> (rx/of #(assoc-in % [:workspace :history :deselecting] false))
         (rx/delay 500))))

(defn deselect-page-history
  [id]
  (DeselectPageHistory. id))

;; --- History Item Updated

(defrecord HistoryItemUpdated [item]
  rs/UpdateEvent
  (-apply-update [_ state]
    (-> state
        (update-in [:workspace :history :items] replace-by-id item)
        (update-in [:workspace :history :pinned-items] replace-by-id item))))

(defn history-updated?
  [item]
  (instance? HistoryItemUpdated item))

(defn history-updated
  [item]
  (HistoryItemUpdated. item))

;; --- Refresh Page History

(defrecord RefreshPageHistory [id]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (let [history (get-in state [:workspace :history])
          maxitems (count (:items history))]
      (rx/of (fetch-page-history id {:max maxitems})
             (fetch-pinned-page-history id)))))

(defn refres-page-history
  [id]
  (RefreshPageHistory. id))

;; --- Update History Item

(defrecord UpdateHistoryItem [item]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (letfn [(on-success [{item :payload}]
              (->HistoryItemUpdated item))]
      (rx/merge
       (->> (rp/req :update/page-history item)
            (rx/map on-success))
       (->> (rx/filter history-updated? s)
            (rx/take 1)
            (rx/map #(refres-page-history (:page item))))))))

(defn update-history-item
  [item]
  (UpdateHistoryItem. item))

;; --- Forward to Next Version

(defrecord ForwardToNextVersion []
  rs/WatchEvent
  (-apply-watch [_ state s]
    (let [workspace (:workspace state)
          history (:history workspace)
          version (:selected history)]
      (cond
        (nil? version)
        (rx/empty)

        (>= (:max-version history) (inc version))
        (rx/of (select-page-history (inc version)))

        (> (inc version) (:max-version history))
        (rx/of (deselect-page-history (:page workspace)))

        :else
        (rx/empty)))))

(defn forward-to-next-version
  []
  (ForwardToNextVersion.))

;; --- Backwards to Previous Version

(defrecord BackwardsToPreviousVersion []
  rs/WatchEvent
  (-apply-watch [_ state s]
    (let [workspace (:workspace state)
          history (:history workspace)
          version (:selected history)]
      (cond
        (nil? version)
        (let [maxv (:max-version history)]
          (rx/of (select-page-history maxv)))

        (pos? (dec version))
        (if (contains? (:by-version history) (dec version))
          (rx/of (select-page-history (dec version)))
          (let [since (:min-version history)
                page (:page workspace)
                params {:since since}]
            (rx/of (fetch-page-history page params)
                   (select-page-history (dec version)))))

        :else
        (rx/empty)))))

(defn backwards-to-previous-version
  []
  (BackwardsToPreviousVersion.))

;; --- Helpers

(defn- update-history-index
  [state history append?]
  (let [index (index-by history :version)]
    (if append?
      (update-in state [:workspace :history :by-version] merge index)
      (assoc-in state [:workspace :history :by-version] index))))

;; 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) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.main.data.history
  (:require [cuerdas.core :as str]
            [beicon.core :as rx]
            [lentes.core :as l]
            [uxbox.util.rstore :as rs]
            [uxbox.util.router :as r]
            [uxbox.main.repo :as rp]
            [uxbox.util.i18n :refer (tr)]
            [uxbox.util.forms :as sc]
            [uxbox.main.data.pages :as udp]
            [uxbox.main.state :as st]
            [uxbox.util.datetime :as dt]
            [uxbox.util.data :refer (without-keys
                                     replace-by-id
                                     index-by)]))

;; --- Watch Page Changes

(declare fetch-page-history)
(declare fetch-pinned-page-history)

(defn watch-page-changes
  "A function that starts watching for `IPageUpdate`
  events emited to the global event stream and just
  reacts on them emiting an other event that just
  persists the state of the page in an undo stack."
  []
  (letfn [(on-value [id]
            (rs/emit! (fetch-page-history id)
                      (fetch-pinned-page-history id)))]
    (as-> rs/stream $
      (rx/filter udp/page-persisted? $)
      (rx/debounce 500 $)
      (rx/map (comp :id :data) $)
      (rx/on-value $ on-value))))

;; --- Pinned Page History Fetched

(declare update-history-index)

(defrecord PinnedPageHistoryFetched [history]
  rs/UpdateEvent
  (-apply-update [_ state]
    (-> state
        (assoc-in [:workspace :history :pinned-items] (mapv :version history))
        (update-history-index history true))))

;; --- Fetch Pinned Page History

(defrecord FetchPinnedPageHistory [id]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (letfn [(on-success [{history :payload}]
              (->PinnedPageHistoryFetched (into [] history)))]
      (let [params {:page id :pinned true}]
        (->> (rp/req :fetch/page-history params)
             (rx/map on-success))))))

(defn fetch-pinned-page-history
  [id]
  (->FetchPinnedPageHistory id))

;; --- Page History Fetched

(defrecord PageHistoryFetched [history append?]
  rs/UpdateEvent
  (-apply-update [_ state]
    (letfn [(update-counters [state items]
              (-> (assoc state :min-version (apply min items))
                  (assoc :max-version (apply max items))))

            (update-lists [state items]
              (if append?
                (update state :items #(reduce conj %1 items))
                (assoc state :items items)))]

      (let [items (mapv :version history)
            hstate (-> (get-in state [:workspace :history] {})
                       (update-counters items)
                       (update-lists items))]
        (-> state
            (assoc-in [:workspace :history] hstate)
            (update-history-index history append?))))))

;; --- Fetch Page History

(defrecord FetchPageHistory [id since max]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (letfn [(on-success [{history :payload}]
              (let [history (into [] history)]
                (->PageHistoryFetched history (not (nil? since)))))]
      (let [params (merge
                    {:page id :max (or max 15)}
                    (when since {:since since}))]
        (->> (rp/req :fetch/page-history params)
             (rx/map on-success))))))

(defn fetch-page-history
  ([id]
   (fetch-page-history id nil))
  ([id params]
   (map->FetchPageHistory (assoc params :id id))))

;; --- Select Page History

(defrecord SelectPageHistory [version]
  rs/UpdateEvent
  (-apply-update [_ state]
    (let [item (get-in state [:workspace :history :by-version version])
          page (get-in state [:pages (:page item)])
          page (assoc page
                      :history true
                      :data (:data item))]
      (-> state
          (udp/assoc-page page)
          (assoc-in [:workspace :history :selected] version)))))

(defn select-page-history
  [version]
  (SelectPageHistory. version))

;; --- Apply selected history

(defrecord ApplySelectedHistory [id]
  rs/UpdateEvent
  (-apply-update [_ state]
    (-> state
        (update-in [:pages id] dissoc :history)
        (assoc-in [:workspace :history :selected] nil)))

  rs/WatchEvent
  (-apply-watch [_ state s]
    (rx/of (udp/persist-page id))))

(defn apply-selected-history
  [id]
  (ApplySelectedHistory. id))

;; --- Deselect Page History

(defrecord DeselectPageHistory [id]
  rs/UpdateEvent
  (-apply-update [_ state]
    (let [packed (get-in state [:packed-pages id])]
      (-> (udp/assoc-page state packed)
          (assoc-in [:workspace :history :deselecting] true)
          (assoc-in [:workspace :history :selected] nil))))

  rs/WatchEvent
  (-apply-watch [_ state s]
    (->> (rx/of #(assoc-in % [:workspace :history :deselecting] false))
         (rx/delay 500))))

(defn deselect-page-history
  [id]
  (DeselectPageHistory. id))

;; --- History Item Updated

(defrecord HistoryItemUpdated [item]
  rs/UpdateEvent
  (-apply-update [_ state]
    (-> state
        (update-in [:workspace :history :items] replace-by-id item)
        (update-in [:workspace :history :pinned-items] replace-by-id item))))

(defn history-updated?
  [item]
  (instance? HistoryItemUpdated item))

(defn history-updated
  [item]
  (HistoryItemUpdated. item))

;; --- Refresh Page History

(defrecord RefreshPageHistory [id]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (let [history (get-in state [:workspace :history])
          maxitems (count (:items history))]
      (rx/of (fetch-page-history id {:max maxitems})
             (fetch-pinned-page-history id)))))

(defn refres-page-history
  [id]
  (RefreshPageHistory. id))

;; --- Update History Item

(defrecord UpdateHistoryItem [item]
  rs/WatchEvent
  (-apply-watch [_ state s]
    (letfn [(on-success [{item :payload}]
              (->HistoryItemUpdated item))]
      (rx/merge
       (->> (rp/req :update/page-history item)
            (rx/map on-success))
       (->> (rx/filter history-updated? s)
            (rx/take 1)
            (rx/map #(refres-page-history (:page item))))))))

(defn update-history-item
  [item]
  (UpdateHistoryItem. item))

;; --- Forward to Next Version

(defrecord ForwardToNextVersion []
  rs/WatchEvent
  (-apply-watch [_ state s]
    (let [workspace (:workspace state)
          history (:history workspace)
          version (:selected history)]
      (cond
        (nil? version)
        (rx/empty)

        (>= (:max-version history) (inc version))
        (rx/of (select-page-history (inc version)))

        (> (inc version) (:max-version history))
        (rx/of (deselect-page-history (:page workspace)))

        :else
        (rx/empty)))))

(defn forward-to-next-version
  []
  (ForwardToNextVersion.))

;; --- Backwards to Previous Version

(defrecord BackwardsToPreviousVersion []
  rs/WatchEvent
  (-apply-watch [_ state s]
    (let [workspace (:workspace state)
          history (:history workspace)
          version (:selected history)]
      (cond
        (nil? version)
        (let [maxv (:max-version history)]
          (rx/of (select-page-history maxv)))

        (pos? (dec version))
        (if (contains? (:by-version history) (dec version))
          (rx/of (select-page-history (dec version)))
          (let [since (:min-version history)
                page (:page workspace)
                params {:since since}]
            (rx/of (fetch-page-history page params)
                   (select-page-history (dec version)))))

        :else
        (rx/empty)))))

(defn backwards-to-previous-version
  []
  (BackwardsToPreviousVersion.))

;; --- Helpers

(defn- update-history-index
  [state history append?]
  (let [index (index-by history :version)]
    (if append?
      (update-in state [:workspace :history :by-version] merge index)
      (assoc-in state [:workspace :history :by-version] index))))

Fix history loading.

Fix history loading.


(ns one.repmax.datastore-configuration.view
  (:use [domina.xpath :only (xpath)])
  (:require-macros [one.repmax.snippets :as snippets])
  (:require [clojure.browser.event :as event]
            [domina :as d]
            [one.dispatch :as dispatch]))

(def snippets (snippets/snippets))

(defn disable [id]
  (d/set-attr! (d/by-id id) "disabled" "disabled"))

(defn enable [id]
  ;; TODO Add a remove-attr! function to Domina
  (.removeAttribute (.getElementById js/document id) "disabled"))

(defmulti render (fn [{:keys [message]}] (:action message)))

(defmethod render :default [event])

(defmethod render :datastore-configuration/initialize [{:keys [new]}]
  (let [datastore-configuration (:datastore-configuration new)]
    (render-datastore-configuration-view datastore-configuration)
    (render-datastore-configuration-state datastore-configuration)))

(defmethod render :datastore-configuration/credentials-verified [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defmethod render :datastore-configuration/database-verified [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defmethod render :datastore-configuration/collections-verified [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defmethod render :datastore-configuration/initialization-failed [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defn render-datastore-configuration-view [datastore-configuration]
  (let [header (d/by-id "header")
        content (d/by-id "content")]
    (d/swap-content! header (:datastore-configuration-header snippets))
    (d/swap-content! content (:datastore-configuration-form snippets))
    (d/set-value! (d/by-id "api-key-input") (:api-key datastore-configuration))
    (event/listen (d/by-id "datastore-configuration-form-button")
                  "click"
                  #(dispatch/fire :action
                                  {:action :datastore-configuration/update
                                   :api-key (d/value (d/by-id "api-key-input"))}))))

(defmulti render-datastore-configuration-state
  (fn [datastore-configuration] (:state datastore-configuration)))

(defmethod render-datastore-configuration-state :obtain-credentials [config]
  (let [steps (xpath "//ul[@class='progress-list']/li")]
    (d/set-attr! steps "data-status" "pending")
    (enable-datastore-configuration-form)))

; TODO Render error message in (-> config :error :text)
(defmethod render-datastore-configuration-state :initialization-failed [config]
  (let [failed-step (-> config :error :occured-in-state)
        failed-step-id (str "step-" (name failed-step))]
    (render-datastore-configuration-progress failed-step-id :failure)))

(defmethod render-datastore-configuration-state :default [config]
  (let [state (:state config)
        current-step-id (str "step-" (name state))]
    (render-datastore-configuration-progress current-step-id :working)))

(defn render-datastore-configuration-progress
  "Update the view to reflect the status of the datastore initialization
  workflow, based on the given status of the given step:

  * Find steps that _precede_ the given step and mark them as having
    completed successfully.

  * Find steps that _follow_ the given step and mark them as pending.

  * Finds the given step and mark it as 'working' (i.e., in progress).

  * If the given status is :working (i.e., initialization is currently
    in progress, disable the form elements. Otherwise, enable the form
    elements (so that the user can edit the configuration and kick-off
    the initialization workflow."
  [current-step-id status]
  (let [current-step (d/by-id current-step-id)
        preceding-steps (xpath current-step "./preceding-sibling::*")
        following-steps (xpath current-step "./following-sibling::*")]
    (d/set-attr! preceding-steps "data-status" "success")
    (d/set-attr! following-steps "data-status" "pending")
    (if (= :working status)
      (do
        (d/set-attr! current-step "data-status" "working")
        (disable-datastore-configuration-form))
      (do
        (d/set-attr! current-step "data-status" "failure")
        (enable-datastore-configuration-form)))))

(defn disable-datastore-configuration-form []
  (disable "api-key-input")
  (disable "datastore-configuration-form-button"))

(defn enable-datastore-configuration-form []
  (enable "api-key-input")
  (enable "datastore-configuration-form-button"))

;;; Register reactors

(dispatch/react-to #{:model-change}
                   (fn [_ event] (render event)))

(ns one.repmax.datastore-configuration.view
  (:use [domina.xpath :only (xpath)])
  (:require-macros [one.repmax.snippets :as snippets])
  (:require [clojure.browser.event :as event]
            [domina :as d]
            [one.dispatch :as dispatch]))

(def snippets (snippets/snippets))

(defn disable [id]
  (d/set-attr! (d/by-id id) "disabled" "disabled"))

(defn enable [id]
  (d/remove-attr! (d/by-id id) "disabled"))

(defmulti render (fn [{:keys [message]}] (:action message)))

(defmethod render :default [event])

(defmethod render :datastore-configuration/initialize [{:keys [new]}]
  (let [datastore-configuration (:datastore-configuration new)]
    (render-datastore-configuration-view datastore-configuration)
    (render-datastore-configuration-state datastore-configuration)))

(defmethod render :datastore-configuration/credentials-verified [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defmethod render :datastore-configuration/database-verified [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defmethod render :datastore-configuration/collections-verified [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defmethod render :datastore-configuration/initialization-failed [{:keys [new]}]
  (render-datastore-configuration-state (:datastore-configuration new)))

(defn render-datastore-configuration-view [datastore-configuration]
  (let [header (d/by-id "header")
        content (d/by-id "content")]
    (d/swap-content! header (:datastore-configuration-header snippets))
    (d/swap-content! content (:datastore-configuration-form snippets))
    (d/set-value! (d/by-id "api-key-input") (:api-key datastore-configuration))
    (event/listen (d/by-id "datastore-configuration-form-button")
                  "click"
                  #(dispatch/fire :action
                                  {:action :datastore-configuration/update
                                   :api-key (d/value (d/by-id "api-key-input"))}))))

(defmulti render-datastore-configuration-state
  (fn [datastore-configuration] (:state datastore-configuration)))

(defmethod render-datastore-configuration-state :obtain-credentials [config]
  (let [steps (xpath "//ul[@class='progress-list']/li")]
    (d/set-attr! steps "data-status" "pending")
    (enable-datastore-configuration-form)))

; TODO Render error message in (-> config :error :text)
(defmethod render-datastore-configuration-state :initialization-failed [config]
  (let [failed-step (-> config :error :occured-in-state)
        failed-step-id (str "step-" (name failed-step))]
    (render-datastore-configuration-progress failed-step-id :failure)))

(defmethod render-datastore-configuration-state :default [config]
  (let [state (:state config)
        current-step-id (str "step-" (name state))]
    (render-datastore-configuration-progress current-step-id :working)))

(defn render-datastore-configuration-progress
  "Update the view to reflect the status of the datastore initialization
  workflow, based on the given status of the given step:

  * Find steps that _precede_ the given step and mark them as having
    completed successfully.

  * Find steps that _follow_ the given step and mark them as pending.

  * Finds the given step and mark it as 'working' (i.e., in progress).

  * If the given status is :working (i.e., initialization is currently
    in progress, disable the form elements. Otherwise, enable the form
    elements (so that the user can edit the configuration and kick-off
    the initialization workflow."
  [current-step-id status]
  (let [current-step (d/by-id current-step-id)
        preceding-steps (xpath current-step "./preceding-sibling::*")
        following-steps (xpath current-step "./following-sibling::*")]
    (d/set-attr! preceding-steps "data-status" "success")
    (d/set-attr! following-steps "data-status" "pending")
    (if (= :working status)
      (do
        (d/set-attr! current-step "data-status" "working")
        (disable-datastore-configuration-form))
      (do
        (d/set-attr! current-step "data-status" "failure")
        (enable-datastore-configuration-form)))))

(defn disable-datastore-configuration-form []
  (disable "api-key-input")
  (disable "datastore-configuration-form-button"))

(defn enable-datastore-configuration-form []
  (enable "api-key-input")
  (enable "datastore-configuration-form-button"))

;;; Register reactors

(dispatch/react-to #{:model-change}
                   (fn [_ event] (render event)))

Use Domina's new remove-attr! fn instead of low-level JS calls


(ns snergly.image
  (:require [snergly.grid :as g]
            [snergly.util :as util]
            [schema.core :as s :include-macros true]
            [clojure.set :as set]))

;; File conventions:
;;
;; Any variable called 'g' is a CanvasRenderingContext2D object.

(def *optimize-drawing* false)

(defn fill-rect [g style x y w h]
  (aset g "fillStyle" style)
  (.fillRect g x y w h))

(defn draw-line [g style x1 y1 x2 y2]
  (aset g "strokeStyle" style)
  (.beginPath g)
  (.moveTo g x1 y1)
  (.lineTo g x2 y2)
  (.stroke g))

(def DistanceMap
  "Schema for Distances with rendering info"
  {:distances g/Distances
   :color-family s/Keyword
   :max-distance s/Int})

(def PathMap
  "Schema for Path with rendering info"
  {:distances g/Distances
   :color-family s/Keyword})

(s/defn draw-cell-backgrounds [g
                               grid :- g/Grid
                               cell-size :- g/NonNegativeInt
                               background :- s/Str
                               distance-maps :- [DistanceMap]]
  (doseq [coord (g/grid-coords grid)]
    (let [{:keys [distances color-family max-distance] :as distance-map} (first (filter #(contains? (:distances %) coord) distance-maps))
          [y x] (map #(* % cell-size) coord)
          cell (g/grid-cell grid coord)
          w (if (g/linked? cell (:east cell)) (inc cell-size) cell-size)
          h (if (g/linked? cell (:south cell)) (inc cell-size) cell-size)
          color (if distance-map
                  (util/make-color max-distance (distances coord) color-family)
                  background)]
      (fill-rect g color x y w h))))

(s/defn draw-cell-walls [g
                         grid :- g/Grid
                         cell-size :- g/NonNegativeInt
                         wall :- s/Str]
  (doseq [coord (g/grid-coords grid)]
    (let [[y1 x1] (map #(* % cell-size) coord)
          [y2 x2] (map #(+ % cell-size) [y1 x1])
          cell (g/grid-cell grid coord)]
      (when-not (:north cell) (draw-line g wall x1 y1 x2 y1))
      (when-not (:west cell) (draw-line g wall x1 y1 x1 y2))

      (when-not (g/linked? cell (:east cell)) (draw-line g wall x2 y1 x2 y2))
      (when-not (g/linked? cell (:south cell)) (draw-line g wall x1 y2 x2 y2)))))

(defn center [coord cell-size]
  (map #(+ (* % cell-size) (/ cell-size 2)) (reverse coord)))

(s/defn draw-path [g
                   cell-size :- g/NonNegativeInt
                   path-map :- PathMap]
  (let [path-distances (:distances path-map)
        color (util/make-color 1 1 (:color-family path-map))
        inverted-path-map (set/map-invert (dissoc path-distances :max))
        path-cells (take-while (complement nil?) (map inverted-path-map (range (:max path-distances) -1 -1)))
        move-to (fn [g [x y]] (.moveTo g x y))
        line-to (fn [g [x y]] (.lineTo g x y))]
    (aset g "strokeStyle" "#f00")
    (aset g "lineWidth" 2)
    (.beginPath g)
    (move-to g (center (first path-cells) cell-size))
    (doseq [next (rest path-cells)]
      (line-to g (center next cell-size)))
    (.stroke g)))

(s/defn draw-cells [g
                    grid :- g/Grid
                    cell-size :- g/NonNegativeInt
                    background :- s/Str
                    wall :- s/Str
                    distance-maps :- [DistanceMap]
                    path-map :- (s/maybe PathMap)]
  (draw-cell-backgrounds g grid cell-size background distance-maps)
  (draw-cell-walls g grid cell-size wall)
  (when path-map (draw-path g cell-size path-map))
  )

(s/defn image-grid [g
                    {:keys [rows columns dist1 dist2 path] :as grid} :- g/Grid
                    cell-size :- g/NonNegativeInt]
  (println "image-grid called")
  (let [img-width (inc (* cell-size columns))
        img-height (inc (* cell-size rows))
        background "#fff"
        wall "#000"
        ;; if we aren't optimizing drawing, discard optimization information
        grid (if *optimize-drawing* grid (assoc grid :changed-cells nil))]
    (aset g "imageSmoothingEnabled" false)
    (aset g "fillStyle" background)
    (aset g "lineWidth" 0.5)
    (when (g/new? grid) (fill-rect g background 0 0 img-width img-height))
    (draw-cells g grid cell-size background wall (remove nil? [dist2 dist1]) path)
    )
  )

(ns snergly.image
  (:require [snergly.grid :as g]
            [snergly.util :as util]
            [schema.core :as s :include-macros true]
            [clojure.set :as set]))

;; File conventions:
;;
;; Any variable called 'g' is a CanvasRenderingContext2D object.

(def *optimize-drawing* false)

(defn fill-rect [g style x y w h]
  (aset g "fillStyle" style)
  (.fillRect g x y w h))

(defn draw-line [g style x1 y1 x2 y2]
  (aset g "strokeStyle" style)
  (.beginPath g)
  (.moveTo g x1 y1)
  (.lineTo g x2 y2)
  (.stroke g))

(def DistanceMap
  "Schema for Distances with rendering info"
  {:distances g/Distances
   :color-family s/Keyword
   :max-distance s/Int})

(def PathMap
  "Schema for Path with rendering info"
  {:distances g/Distances
   :color-family s/Keyword})

(s/defn draw-cell-backgrounds [g
                               grid :- g/Grid
                               cell-size :- g/NonNegativeInt
                               background :- s/Str
                               distance-maps :- [DistanceMap]]
  (doseq [coord (g/grid-coords grid)]
    (let [{:keys [distances color-family max-distance] :as distance-map} (first (filter #(contains? (:distances %) coord) distance-maps))
          [y x] (map #(* % cell-size) coord)
          cell (g/grid-cell grid coord)
          w (if (g/linked? cell (:east cell)) (inc cell-size) cell-size)
          h (if (g/linked? cell (:south cell)) (inc cell-size) cell-size)
          color (if distance-map
                  (util/make-color max-distance (distances coord) color-family)
                  background)]
      (fill-rect g color x y w h))))

(s/defn draw-cell-walls [g
                         grid :- g/Grid
                         cell-size :- g/NonNegativeInt
                         wall :- s/Str]
  (doseq [coord (g/grid-coords grid)]
    (let [[y1 x1] (map #(* % cell-size) coord)
          [y2 x2] (map #(+ % cell-size) [y1 x1])
          cell (g/grid-cell grid coord)]
      (when-not (:north cell) (draw-line g wall x1 y1 x2 y1))
      (when-not (:west cell) (draw-line g wall x1 y1 x1 y2))

      (when-not (g/linked? cell (:east cell)) (draw-line g wall x2 y1 x2 y2))
      (when-not (g/linked? cell (:south cell)) (draw-line g wall x1 y2 x2 y2)))))

(defn center [coord cell-size]
  (map #(+ (* % cell-size) (/ cell-size 2)) (reverse coord)))

(s/defn draw-path [g
                   cell-size :- g/NonNegativeInt
                   path-map :- PathMap]
  (let [path-distances (:distances path-map)
        color (util/make-color 1 1 (:color-family path-map))
        inverted-path-map (set/map-invert (dissoc path-distances :max))
        path-cells (take-while (complement nil?) (map inverted-path-map (range (:max path-distances) -1 -1)))
        move-to (fn [g [x y]] (.moveTo g x y))
        line-to (fn [g [x y]] (.lineTo g x y))]
    (aset g "strokeStyle" "#f00")
    (aset g "lineWidth" 2)
    (.beginPath g)
    (move-to g (center (first path-cells) cell-size))
    (doseq [next (rest path-cells)]
      (line-to g (center next cell-size)))
    (.stroke g)))

(s/defn draw-cells [g
                    grid :- g/Grid
                    cell-size :- g/NonNegativeInt
                    background :- s/Str
                    wall :- s/Str
                    distance-maps :- [DistanceMap]
                    path-map :- (s/maybe PathMap)]
  (draw-cell-backgrounds g grid cell-size background distance-maps)
  (draw-cell-walls g grid cell-size wall)
  (when path-map (draw-path g cell-size path-map))
  )

(s/defn image-grid [g
                    {:keys [rows columns dist1 dist2 path] :as grid} :- g/Grid
                    cell-size :- g/NonNegativeInt]
  (println "image-grid called")
  (let [img-width (inc (* cell-size columns))
        img-height (inc (* cell-size rows))
        background "#fff"
        wall "#000"
        ;; if we aren't optimizing drawing, discard optimization information
        grid (if *optimize-drawing* grid (assoc grid :changed-cells nil))]
    (aset g "imageSmoothingEnabled" false)
    (aset g "fillStyle" background)
    (aset g "lineWidth" 1)
    (when (g/new? grid) (fill-rect g background 0 0 img-width img-height))
    (draw-cells g grid cell-size background wall (remove nil? [dist2 dist1]) path)
    )
  )

Increase wall width to 1.0

Increase wall width to 1.0


(ns lambdacd.steps.support
  (:require [clojure.core.async :as async]
            [lambdacd.execution.internal.execute-steps :as execute-steps]
            [lambdacd.execution.internal.serial-step-result-producer :as serial-step-result-producer]
            [clojure.walk :as walk]
            [lambdacd.step-id :as step-id]
            [lambdacd.steps.result :as step-results]
            [lambdacd.execution.internal.util :as execution-util])
  (:import (java.io Writer StringWriter)))

(defn- merge-step-results-with-joined-output [a b]
  (step-results/merge-two-step-results a b :resolvers [step-results/status-resolver
                                                       step-results/merge-nested-maps-resolver
                                                       step-results/join-output-resolver
                                                       step-results/second-wins-resolver]))

(defn- wrap-step-to-allow-nil-values [step]
  (fn [args ctx]
    (let [result (step args ctx)]
      (if (nil? result)
        args
        result))))

(defn- step-results-sorted-by-id [outputs]
  (->> outputs
       (into (sorted-map-by step-id/before?))
       (vals)))

(defn unify-results [step-results]
  (-> step-results
      (step-results-sorted-by-id)
      (step-results/merge-step-results merge-step-results-with-joined-output)))

(defn- do-chain-steps-with-execute-steps [args ctx steps step-result-producer]
  (let [execute-step-result (execute-steps/execute-steps steps args ctx
                                                     :step-result-producer step-result-producer
                                                     :unify-results-fn unify-results)
        sorted-step-results (step-results-sorted-by-id (:outputs execute-step-result))
        merged-step-results (step-results/merge-step-results sorted-step-results merge-step-results-with-joined-output)]
    (merge merged-step-results execute-step-result)))

(defn chain-steps
  ([args ctx & steps]
   (do-chain-steps-with-execute-steps args ctx
                                      (map wrap-step-to-allow-nil-values steps)
                                      (serial-step-result-producer/serial-step-result-producer))))

(defn always-chain-steps
  ([args ctx & steps]
   (do-chain-steps-with-execute-steps args ctx
                                      (map wrap-step-to-allow-nil-values steps)
                                      (serial-step-result-producer/serial-step-result-producer :stop-predicate (constantly false)))))

(defn to-fn [form]
  (let [f# (first form)
        r# (next form)]
    (if (map? form)
      `(fn [& _# ] ~form)
      `(fn [args# ctx#] (~f# args# ctx# ~@r#)))))

;; Placeholders where args and ctx are injected by the chaining-macro.
(def injected-args)
(def injected-ctx)

(defn replace-args-and-ctx [args ctx]
  (fn [x]
    (cond
      (and
        (symbol? x)
        (= (var injected-args) (resolve x))) args
      (and
        (symbol? x)
        (= (var injected-ctx) (resolve x))) ctx
      :else x)))

(defn to-fn-with-args [form]
  (let [f# (first form)
        ctx (gensym "ctx")
        args (gensym "args")
        r# (walk/postwalk
             (replace-args-and-ctx args ctx)
             (next form))]
    (if (map? form)
      `(fn [& _# ] ~form)
      `(fn [~args ~ctx] (~f# ~@r#)))))

(defn- do-chaining [chain-fn args ctx forms]
  (let [fns (vec (map to-fn-with-args forms))]
    `(apply ~chain-fn ~args ~ctx ~fns)))

(defmacro chaining [args ctx & forms]
  "syntactic sugar for chain-steps. can work with arbitrary code and can inject args and ctx"
  (do-chaining chain-steps args ctx forms))

(defmacro always-chaining [args ctx & forms]
  "syntactic sugar for always-chain-steps. can work with arbitrary code and can inject args and ctx"
  (do-chaining always-chain-steps args ctx forms))

(defn last-step-status-wins [step-result]
  (let [winning-status (->> step-result
                           :outputs
                           (sort-by #(vec (first %)))
                           last
                           second
                           :status)]
    (assoc step-result :status winning-status)))

(defn- append-output [msg]
  (fn [old-output]
    (str old-output msg "\n")))

(defn new-printer []
  (atom ""))

(defn set-output [ctx msg]
  (async/>!! (:result-channel ctx) [:out msg]))

(defn print-to-output [ctx printer msg]
  (let [new-out (swap! printer (append-output msg))]
    (set-output ctx new-out)))

(defn printed-output [printer]
  @printer)

(defn killed? [ctx]
  @(:is-killed ctx))

(defmacro if-not-killed [ctx & body]
  `(if (killed? ~ctx)
     (do
       (async/>!! (:result-channel ~ctx) [:status :killed])
       {:status :killed})
     ~@body))

(defn merge-globals [step-results]
  (or (:global (reduce execution-util/keep-globals {} step-results)) {}))

(defn merge-step-results [step-results]
  (reduce execution-util/merge-two-step-results {} step-results))

; not part of the public interface, just public for the macro
(defn writer-to-ctx [ctx]
  (let [buf (StringWriter.)]
    {:writer (proxy [Writer] []
              (write [& [x ^Integer off ^Integer len]]
                (cond
                  (number? x) (.append buf (char x))
                  (not off) (.append buf x)
                  ; the CharSequence overload of append takes an *end* idx, not length!
                  (instance? CharSequence x) (.append buf ^CharSequence x (int off) (int (+ len off)))
                  :else (do
                          (.append buf (String. ^chars x) off len))))
              (flush []
                (set-output ctx (.toString (.getBuffer buf)))))
     :buffer (.getBuffer buf)}))

(defmacro capture-output [ctx & body]
  `(let [{x#      :writer
          buffer# :buffer} (writer-to-ctx ~ctx)
         body-result# (binding [*out* x#]
                        (do ~@body))]
     (if (associative? body-result#)
       (update body-result# :out #(if (nil? %) (str buffer#) (str buffer# "\n" % ))))))

(defn unify-only-status
  "Converts a function that can unify statuses into a unify-results-fn suitable for execute-steps"
  [unify-status-fn]
  (execute-steps/unify-only-status unify-status-fn))

(defn assoc-build-metadata! [ctx & kvs]
  (swap! (:build-metadata-atom ctx) #(apply assoc % kvs)))

(ns lambdacd.steps.support
  (:require [clojure.core.async :as async]
            [lambdacd.execution.internal.execute-steps :as execute-steps]
            [lambdacd.execution.internal.serial-step-result-producer :as serial-step-result-producer]
            [clojure.walk :as walk]
            [lambdacd.step-id :as step-id]
            [lambdacd.steps.result :as step-results]
            [lambdacd.execution.internal.util :as execution-util])
  (:import (java.io Writer StringWriter)))

(defn- merge-step-results-with-joined-output [a b]
  (step-results/merge-two-step-results a b :resolvers [step-results/status-resolver
                                                       step-results/merge-nested-maps-resolver
                                                       step-results/join-output-resolver
                                                       step-results/second-wins-resolver]))

(defn- wrap-step-to-allow-nil-values [step]
  (fn [args ctx]
    (let [result (step args ctx)]
      (if (nil? result)
        args
        result))))

(defn- step-results-sorted-by-id [outputs]
  (->> outputs
       (into (sorted-map-by step-id/before?))
       (vals)))

(defn unify-results [step-results]
  (-> step-results
      (step-results-sorted-by-id)
      (step-results/merge-step-results merge-step-results-with-joined-output)))

(defn- do-chain-steps-with-execute-steps [args ctx steps step-result-producer]
  (let [execute-step-result (execute-steps/execute-steps steps args ctx
                                                     :step-result-producer step-result-producer
                                                     :unify-results-fn unify-results)]
    (merge (unify-results (:outputs execute-step-result)) execute-step-result)))

(defn chain-steps
  ([args ctx & steps]
   (do-chain-steps-with-execute-steps args ctx
                                      (map wrap-step-to-allow-nil-values steps)
                                      (serial-step-result-producer/serial-step-result-producer))))

(defn always-chain-steps
  ([args ctx & steps]
   (do-chain-steps-with-execute-steps args ctx
                                      (map wrap-step-to-allow-nil-values steps)
                                      (serial-step-result-producer/serial-step-result-producer :stop-predicate (constantly false)))))

(defn to-fn [form]
  (let [f# (first form)
        r# (next form)]
    (if (map? form)
      `(fn [& _# ] ~form)
      `(fn [args# ctx#] (~f# args# ctx# ~@r#)))))

;; Placeholders where args and ctx are injected by the chaining-macro.
(def injected-args)
(def injected-ctx)

(defn replace-args-and-ctx [args ctx]
  (fn [x]
    (cond
      (and
        (symbol? x)
        (= (var injected-args) (resolve x))) args
      (and
        (symbol? x)
        (= (var injected-ctx) (resolve x))) ctx
      :else x)))

(defn to-fn-with-args [form]
  (let [f# (first form)
        ctx (gensym "ctx")
        args (gensym "args")
        r# (walk/postwalk
             (replace-args-and-ctx args ctx)
             (next form))]
    (if (map? form)
      `(fn [& _# ] ~form)
      `(fn [~args ~ctx] (~f# ~@r#)))))

(defn- do-chaining [chain-fn args ctx forms]
  (let [fns (vec (map to-fn-with-args forms))]
    `(apply ~chain-fn ~args ~ctx ~fns)))

(defmacro chaining [args ctx & forms]
  "syntactic sugar for chain-steps. can work with arbitrary code and can inject args and ctx"
  (do-chaining chain-steps args ctx forms))

(defmacro always-chaining [args ctx & forms]
  "syntactic sugar for always-chain-steps. can work with arbitrary code and can inject args and ctx"
  (do-chaining always-chain-steps args ctx forms))

(defn last-step-status-wins [step-result]
  (let [winning-status (->> step-result
                           :outputs
                           (sort-by #(vec (first %)))
                           last
                           second
                           :status)]
    (assoc step-result :status winning-status)))

(defn- append-output [msg]
  (fn [old-output]
    (str old-output msg "\n")))

(defn new-printer []
  (atom ""))

(defn set-output [ctx msg]
  (async/>!! (:result-channel ctx) [:out msg]))

(defn print-to-output [ctx printer msg]
  (let [new-out (swap! printer (append-output msg))]
    (set-output ctx new-out)))

(defn printed-output [printer]
  @printer)

(defn killed? [ctx]
  @(:is-killed ctx))

(defmacro if-not-killed [ctx & body]
  `(if (killed? ~ctx)
     (do
       (async/>!! (:result-channel ~ctx) [:status :killed])
       {:status :killed})
     ~@body))

(defn merge-globals [step-results]
  (or (:global (reduce execution-util/keep-globals {} step-results)) {}))

(defn merge-step-results [step-results]
  (reduce execution-util/merge-two-step-results {} step-results))

; not part of the public interface, just public for the macro
(defn writer-to-ctx [ctx]
  (let [buf (StringWriter.)]
    {:writer (proxy [Writer] []
              (write [& [x ^Integer off ^Integer len]]
                (cond
                  (number? x) (.append buf (char x))
                  (not off) (.append buf x)
                  ; the CharSequence overload of append takes an *end* idx, not length!
                  (instance? CharSequence x) (.append buf ^CharSequence x (int off) (int (+ len off)))
                  :else (do
                          (.append buf (String. ^chars x) off len))))
              (flush []
                (set-output ctx (.toString (.getBuffer buf)))))
     :buffer (.getBuffer buf)}))

(defmacro capture-output [ctx & body]
  `(let [{x#      :writer
          buffer# :buffer} (writer-to-ctx ~ctx)
         body-result# (binding [*out* x#]
                        (do ~@body))]
     (if (associative? body-result#)
       (update body-result# :out #(if (nil? %) (str buffer#) (str buffer# "\n" % ))))))

(defn unify-only-status
  "Converts a function that can unify statuses into a unify-results-fn suitable for execute-steps"
  [unify-status-fn]
  (execute-steps/unify-only-status unify-status-fn))

(defn assoc-build-metadata! [ctx & kvs]
  (swap! (:build-metadata-atom ctx) #(apply assoc % kvs)))

Remove duplicated code

Remove duplicated code


(ns runbld.hosting.aws-ec2
  (:require
   [clj-http.client :as http]
   [robert.bruce :refer [try-try-again]]
   [runbld.hosting :refer [HostingProvider] :as hosting]
   [runbld.schema :refer :all]
   [schema.core :as s]
   [slingshot.slingshot :refer [try+ throw+]]))

(s/defn region-name :- s/Str
  "Given us-east-1c, we want us-east-1."
  ([az :- s/Str]
   (when az
     (when-let [[_ reg _] (re-find #"(.+-.+-[0-9]+)([a-z]+)" az)]
       reg))))

(s/defn ec2-meta
  ([]
   (ec2-meta "/"))
  ([postfix]
   (try-try-again
    {:sleep 500
     :tries 20}
    #(try+
      (:body
       (http/get (str "http://169.254.169.254/latest/meta-data" postfix)
                 {:socket-timeout 500 :conn-timeout 500}))
      (catch java.net.SocketTimeoutException _)
      (catch org.apache.http.conn.ConnectTimeoutException _)
      (catch java.net.ConnectException _)
      ;; Non-AWS Windows
      (catch java.net.SocketException _)
      (catch java.net.UnknownHostException _)))))

(s/defn this-host? :- s/Bool
  "Is this host in AWS EC2?"
  ([]
   (boolean (ec2-meta))))

(defrecord AwsEc2Hosting [facts]
  HostingProvider
  (datacenter    [x]
    (ec2-meta "/placement/availability-zone"))

  (image-id      [x]
    (ec2-meta "/ami-id"))

  (instance-id   [x]
    (ec2-meta "/instance-id"))

  (instance-type [x]
    (ec2-meta "/instance-type"))

  (provider [x]
    "aws-ec2")

  (region        [x]
    (region-name (hosting/datacenter x))))

(s/defn make
  ([facts]
   (AwsEc2Hosting. facts)))

(ns runbld.hosting.aws-ec2
  (:require
   [clj-http.client :as http]
   [robert.bruce :refer [try-try-again]]
   [runbld.hosting :refer [HostingProvider] :as hosting]
   [runbld.schema :refer :all]
   [schema.core :as s]
   [slingshot.slingshot :refer [try+ throw+]]))

(s/defn region-name :- s/Str
  "Given us-east-1c, we want us-east-1."
  ([az :- s/Str]
   (when az
     (when-let [[_ reg _] (re-find #"(.+-.+-[0-9]+)([a-z]+)" az)]
       reg))))

(s/defn ec2-meta
  ([]
   (ec2-meta "/"))
  ([postfix]
   (try-try-again
    {:sleep 500
     :tries 20}
    #(try+
      (:body
       (http/get (str "http://169.254.169.254/latest/meta-data" postfix)
                 {:socket-timeout 500 :conn-timeout 500}))
      (catch java.net.SocketTimeoutException _)
      (catch org.apache.http.conn.ConnectTimeoutException _)
      (catch org.apache.http.conn.NoHttpResponseException _)
      (catch java.net.ConnectException _)
      ;; Non-AWS Windows
      (catch java.net.SocketException _)
      (catch java.net.UnknownHostException _)))))

(s/defn this-host? :- s/Bool
  "Is this host in AWS EC2?"
  ([]
   (boolean (ec2-meta))))

(defrecord AwsEc2Hosting [facts]
  HostingProvider
  (datacenter    [x]
    (ec2-meta "/placement/availability-zone"))

  (image-id      [x]
    (ec2-meta "/ami-id"))

  (instance-id   [x]
    (ec2-meta "/instance-id"))

  (instance-type [x]
    (ec2-meta "/instance-type"))

  (provider [x]
    "aws-ec2")

  (region        [x]
    (region-name (hosting/datacenter x))))

(s/defn make
  ([facts]
   (AwsEc2Hosting. facts)))

Fix intermittent issues in AWS node detection on Vagrant


(ns comic-reader.history
  (:require [goog.events :as events]
            [goog.history.EventType :as EventType]
            [secretary.core :as secretary])
  (:import goog.History))

(defn hook-browser-navigation! []
  (doto (History. false
                  "/blank"
                  (.getElementById js/document "history_state"))
    (events/listen
        EventType/NAVIGATE
        (fn [event]
          (secretary/dispatch! (.-token event))))
    (.setEnabled true)))

(ns comic-reader.history
  (:require [goog.events :as events]
            [goog.history.EventType :as EventType]
            [secretary.core :as secretary])
  (:import goog.History))

(defonce goog-history (atom nil))

(defn hook-browser-navigation! []
  (when (nil? @goog-history)
    (let [hist (History. false
                         "/blank"
                         (.getElementById js/document
                                          "history_state"))]
      (reset! goog-history hist)
      (doto hist
        (events/listen
            EventType/NAVIGATE
            (fn [event]
              (secretary/dispatch! (.-token event))))
        (.setEnabled true)))))

Make history initialization idempotent

Make history initialization idempotent


(ns clojure-images-server.save
  (:require [ring.middleware.multipart-params :as mp])
  (:use [ring.util.json-response]))

(def route-settings)

(defn- get-files [req]
  (get (:params (mp/multipart-params-request req)) "imageFiles"))

(defn- save-file [file]
  (:filename file))

(defn- save-files [files]
  (if (map? files)
      (list (save-file files))
      (if (:multiple route-settings)
        (map save-file files)
        (list (save-file (get files 0))))))

(defn handler [req rs]
  (do
    (def route-settings rs)
    (-> (get-files req)
        (save-files)
        (json-response))))

(ns clojure-images-server.save
  (:require [ring.middleware.multipart-params :as mp])
  (:use [ring.util.json-response]))

(defn- get-files [req]
  (get (:params (mp/multipart-params-request req)) "imageFiles"))

(defn- save-file [file]
  (:filename file))

(defn- save-files [rs files]
  (do (println rs)
    (if (map? files)
        (list (save-file files))
        (if (:multiple rs)
          (map save-file files)
          (list (save-file (get files 0)))))))

(defn handler [req rs]
  (-> (get-files req)
      ((partial save-files rs))
      (json-response)))

fix race condition

fix race condition


;; Copyright © 2015, JUXT LTD.

(ns aero.core
  (:require [clojure
             [edn :as edn]
             [string :refer [trim]]
             [walk :refer [walk postwalk]]]
            [clojure.java
             [io :as io]
             [shell :as sh]]))

(declare read-config)

(defmulti reader (fn [opts tag value] tag))

(defmethod reader :default
  [_ tag value]
  (if tag
    (with-meta value {::tag tag})
    value))

(defmethod reader 'env
  [opts tag value]
  (System/getenv (str value)))

(defmethod reader 'or
  [opts tag value]
  (first (filter some? value)))

(defmethod reader 'profile
  [{:keys [profile]} tag value]
  (cond (contains? value profile) (clojure.core/get value profile)
        (contains? value :default) (clojure.core/get value :default)
        :otherwise nil))

;; Deprecated
(defmethod reader 'cond
  [opts tag value]
  (reader opts 'profile value))

(defmethod reader 'hostname
  [{:keys [hostname]} tag value]
  (let [hostn (or hostname (-> (sh/sh "hostname") :out trim))]
    (or
     (some (fn [[k v]]
             (when (or (= k hostn)
                       (and (set? k) (contains? k hostn)))
               v))
           value)
     (get value :default))))

(defmethod reader 'user
  [{:keys [user]} tag value]
  (let [user (or user (-> (sh/sh "whoami") :out trim))]
    (or
     (some (fn [[k v]]
             (when (or (= k user)
                       (and (set? k) (contains? k user)))
               v))
           value)
     (get value :default))))

(defmethod reader 'include
  [opts tag value]
  (read-config value opts))

;; Deprecated
(defmethod reader 'file
  [opts tag value]
  (read-config value opts))

(defmethod reader 'join
  [opts tag value]
  (apply str value))

(defn read-config
  "Optional second argument is a map. Keys are :profile, indicating the
  profile for use with #cond"
  ([r opts]
   (let [config
         (with-open [pr (java.io.PushbackReader. (io/reader r))]
           (edn/read
            {:eof nil
             :default (partial reader (merge {:profile :default} opts))}
            pr))]
     (postwalk (fn [v]
                 (if-not (contains? (meta v) :ref)
                   v
                   (recur (get-in config v))))
               config)))
  ([r] (read-config r {})))

;; Copyright © 2015, JUXT LTD.

(ns aero.core
  (:require [clojure
             [edn :as edn]
             [string :refer [trim]]
             [walk :refer [walk postwalk]]]
            [clojure.java
             [io :as io]
             [shell :as sh]]))

(declare read-config)

(defmulti reader (fn [opts tag value] tag))

(defmethod reader :default
  [_ tag value]
  (if tag
    (with-meta value {::tag tag})
    value))

(defmethod reader 'env
  [opts tag value]
  (System/getenv (str value)))

(defmethod reader 'or
  [opts tag value]
  (first (filter some? value)))

(defmethod reader 'profile
  [{:keys [profile]} tag value]
  (cond (contains? value profile) (clojure.core/get value profile)
        (contains? value :default) (clojure.core/get value :default)
        :otherwise nil))

(defmethod reader 'hostname
  [{:keys [hostname]} tag value]
  (let [hostn (or hostname (-> (sh/sh "hostname") :out trim))]
    (or
     (some (fn [[k v]]
             (when (or (= k hostn)
                       (and (set? k) (contains? k hostn)))
               v))
           value)
     (get value :default))))

(defmethod reader 'user
  [{:keys [user]} tag value]
  (let [user (or user (-> (sh/sh "whoami") :out trim))]
    (or
     (some (fn [[k v]]
             (when (or (= k user)
                       (and (set? k) (contains? k user)))
               v))
           value)
     (get value :default))))

(defmethod reader 'include
  [opts tag value]
  (read-config value opts))

(defmethod reader 'join
  [opts tag value]
  (apply str value))

(defn read-config
  "Optional second argument is a map. Keys are :profile, indicating the
  profile for use with #cond"
  ([r opts]
   (let [config
         (with-open [pr (java.io.PushbackReader. (io/reader r))]
           (edn/read
            {:eof nil
             :default (partial reader (merge {:profile :default} opts))}
            pr))]
     (postwalk (fn [v]
                 (if-not (contains? (meta v) :ref)
                   v
                   (recur (get-in config v))))
               config)))
  ([r] (read-config r {})))

Remove deprecated tags

Remove deprecated tags


(ns babel.test.fr
  (:refer-clojure :exclude [get-in])
  (:require [babel.engine :as engine]
            [babel.forest :as forest]
            [babel.francais.writer :as fr :refer [small lexicon]]
            [babel.francais.morphology :refer [fo]]
            [babel.over :refer [over]]
            [babel.writer :as writer]
            [clojure.string :as string]
            [clojure.test :refer :all]
            [clojure.tools.logging :as log]
            [dag-unify.core :refer [fail-path fail? get-in strip-refs unifyc]]))

(deftest conditional
  (let [result (engine/generate {:synsem {:subcat '()
                                          :sem {:pred :sleep
                                                :subj {:pred :I}
                                                :tense :conditional}}}
                                fr/small)]
    (is (= "je dormirais" (fo result)))))

(deftest present-irregular
  (let [result (engine/generate {:synsem {:subcat '()
                                          :sem {:pred :be
                                                :subj {:pred :I}
                                                :tense :present}}}
                                fr/small)]
    (is (= "je suis" (fo result)))))

(deftest imperfect-irregular-être
  (let [result (engine/generate {:synsem {:subcat '()
                                          :infl :imperfect
                                          :sem {:pred :be
                                                :subj {:pred :I}}}}

                                fr/small)]
    (is (= "j'étais" (fo result)))))

(deftest imperfect-irregular-avoir
  (let [result (engine/generate {:synsem {:subcat '()
                                          :infl :imperfect
                                          :sem {:pred :avere
                                                :subj {:pred :I}}}}
                                fr/small)]
    (and (is (not (nil? result)))
         (is (= "av" (get-in result [:head :français :imperfect-stem])))
         (is (= "j'avais" (fo result))))))

(deftest être-as-aux
  (let [result
        (filter #(not (fail? %))
                (map (fn [rule]
                       (unifyc rule
                               {:head (last (get @lexicon "être"))}))
                     (:grammar @small)))]
    (and (is (not (empty? result)))
         (is (= (get-in (first result) [:rule]) "vp-aux")))))

(def vp-aux (first (filter #(= (:rule %) "vp-aux")
                           (:grammar @small))))

(def etre (first (filter #(= true (get-in % [:synsem :aux]))
                         (get @lexicon "être"))))

(deftest over-test
  (let [result
        (over (get @fr/small :grammar)
              (get @fr/lexicon "je")
              (over (get @fr/small :grammar)
                    (get @fr/lexicon "sommes") (get @fr/lexicon "aller")))]
    (and (not (nil? result))
         (not (empty? result))
         (= 1 (.size result)))))

(deftest passe-compose-1
  (let [result
        (forest/generate
         {:synsem {:subcat '()
                   :sem {:tense :passe-compose
                         :subj {:pred :noi}
                         :pred :andare}}}
         (:grammar @fr/small)
         (:lexicon @fr/small)
         (:index @fr/small)
         (:morph @fr/small))]
    (and (is (not (nil? result)))
         (is (= (fo result) "nous sommes allées")))))

(deftest passe-compose
  (let [result (engine/generate {:synsem {:sem {:pred :andare
                                                :tense :passe-compose
                                                :subj {:pred :noi
                                                       :gender :fem}}}}
                                fr/small)]
    (and (is (not (nil? result)))
         (is (= (fo result) "nous sommes allées")))))

(ns babel.test.fr
  (:refer-clojure :exclude [get-in])
  (:require [babel.engine :as engine]
            [babel.forest :as forest]
            [babel.francais.writer :as fr :refer [small lexicon]]
            [babel.francais.morphology :refer [fo]]
            [babel.over :refer [over]]
            [babel.writer :as writer]
            [clojure.string :as string]
            [clojure.test :refer :all]
            [clojure.tools.logging :as log]
            [dag-unify.core :refer [fail-path fail? get-in strip-refs unifyc]]))

(deftest conditional
  (let [result (engine/generate {:synsem {:subcat '()
                                          :sem {:pred :sleep
                                                :subj {:pred :I}
                                                :tense :conditional}}}
                                fr/small)]
    (is (= "je dormirais" (fo result)))))

(deftest present-irregular
  (let [result (engine/generate {:synsem {:subcat '()
                                          :sem {:pred :be
                                                :subj {:pred :I}
                                                :tense :present}}}
                                fr/small)]
    (is (= "je suis" (fo result)))))

(deftest imperfect-irregular-être
  (let [result (engine/generate {:synsem {:subcat '()
                                          :infl :imperfect
                                          :sem {:pred :be
                                                :subj {:pred :I}}}}

                                fr/small)]
    (is (= "j'étais" (fo result)))))

(deftest imperfect-irregular-avoir
  (let [result (engine/generate {:synsem {:subcat '()
                                          :infl :imperfect
                                          :sem {:pred :avere
                                                :subj {:pred :I}}}}
                                fr/small)]
    (and (is (not (nil? result)))
         (is (= "av" (get-in result [:head :français :imperfect-stem])))
         (is (= "j'avais" (fo result))))))

(deftest être-as-aux
  (let [result
        (filter #(not (fail? %))
                (map (fn [rule]
                       (unifyc rule
                               {:head (last (get @lexicon "être"))}))
                     (:grammar @small)))]
    (and (is (not (empty? result)))
         (is (= (get-in (first result) [:rule]) "vp-aux")))))

(def vp-aux (first (filter #(= (:rule %) "vp-aux")
                           (:grammar @small))))

(def etre (first (filter #(= true (get-in % [:synsem :aux]))
                         (get @lexicon "être"))))
(deftest over-test
  (let [result
        (over (get @fr/small :grammar)
              (get @fr/lexicon "je")
              (over (get @fr/small :grammar)
                    (get @fr/lexicon "sommes") (get @fr/lexicon "aller")))]
    (and (not (nil? result))
         (not (empty? result))
         (= 1 (.size result)))))

(deftest passe-compose-morphology
  (let [result
        {:français
         {:a {:initial true,
              :français "nous"},
          :b {:b {:future-stem "ir",
                  :agr {:number :plur,
                        :person :1st},
                  :present {:3plur "vont",
                            :2plur "allez",
                            :3sing "va",
                            :1sing "vais",
                            :2sing "vas",
                            :1plur "allons"},
                  :français "aller",
                  :infl :passe-compose,
                  :essere true,
                  :initial false},
              :initial false,
              :a {:infl :present,
                  :infinitive "être",
                  :initial true,
                  :agr {:number :plur,
                        :person :1st},
                  :essere false,
                  :passato "été",
                  :imperfect {:2sing "étais",
                              :3plur "étaient",
                              :2plur "étiez",
                              :1sing "étais",
                              :3sing "était",
                              :1plur "étions"},
                  :present {:2sing "es",
                            :3plur "sont",
                            :2plur "êtes",
                            :1sing "suis",
                            :3sing "est",
                            :1plur "sommes"},
                  :futuro {:2sing "seras",
                           :3plur "seront",
                           :2plur "serez",
                           :1sing "serai",
                           :3sing "sera",
                           :1plur "serons"},
                  :futuro-stem "ser",
                  :exception true,
                  :français "sommes"}}}}]
    (is (= (fo result) "nous sommes allées"))))

(deftest passe-compose-1
  (let [result
        (forest/generate
         {:synsem {:subcat '()
                   :sem {:tense :passe-compose
                         :subj {:pred :noi}
                         :pred :andare}}}
         (:grammar @fr/small)
         (:lexicon @fr/small)
         (:index @fr/small)
         (:morph @fr/small))]
    (and (is (not (nil? result)))
         (is (= (fo result) "nous sommes allées")))))

(deftest passe-compose
  (let [result (engine/generate {:synsem {:sem {:pred :andare
                                                :tense :passe-compose
                                                :subj {:pred :noi
                                                       :gender :fem}}}}
                                fr/small)]
    (and (is (not (nil? result)))
         (is (= (fo result) "nous sommes allées")))))

add test for passé composé morphology

add test for passé composé morphology


(ns status-im.ui.components.text-input.view
  (:require [status-im.ui.components.react :as react]
            [status-im.ui.components.text-input.styles :as styles]
            [status-im.ui.components.colors :as colors]
            [status-im.utils.platform :as platform]
            [status-im.ui.components.tooltip.views :as tooltip]))

(defn text-input-with-label [{:keys [label content error style height container text] :as props}]
  [react/view
   (when label
     [react/text {:style styles/label}
      label])
   [react/view {:style (merge (styles/input-container height) container)}
    [react/text-input
     (merge
      {:style                  (merge styles/input style)
       :placeholder-text-color colors/gray
       :auto-focus             true
       :auto-capitalize        :none}
      (dissoc props :style :height)
      (when-not platform/desktop?
        {:value text}))]
    (when content content)]
   (when error
     [tooltip/tooltip error (styles/error label)])])

(ns status-im.ui.components.text-input.view
  (:require [status-im.ui.components.react :as react]
            [status-im.ui.components.text-input.styles :as styles]
            [status-im.ui.components.colors :as colors]
            [status-im.utils.platform :as platform]
            [status-im.ui.components.tooltip.views :as tooltip]))

(defn text-input-with-label [{:keys [label content error style height container text] :as props}]
  [react/view
   (when label
     [react/text {:style styles/label}
      label])
   [react/view {:style (merge (styles/input-container height) container)}
    [react/text-input
     (merge
      {:style                  (merge styles/input style)
       :placeholder-text-color colors/gray
       :auto-focus             true
       :auto-capitalize        :none}
      (dissoc props :style :height)
      ;; Workaround until `value` TextInput field is available on desktop:
      ;; https://github.com/status-im/react-native-desktop/issues/320
      (when-not platform/desktop?
        {:value text}))]
    (when content content)]
   (when error
     [tooltip/tooltip error (styles/error label)])])

Add comment describing the rationale for the workaround


(ns org.broadinstitute.firecloud-ui.page.methods-configs-acl
  (:require
   [dmohs.react :as react]
   [clojure.string :refer [trim]]
   [org.broadinstitute.firecloud-ui.common :as common]
   [org.broadinstitute.firecloud-ui.common.components :as comps]
   [org.broadinstitute.firecloud-ui.common.style :as style]
   [org.broadinstitute.firecloud-ui.common.table :as table]
   [org.broadinstitute.firecloud-ui.endpoints :as endpoints]
   [org.broadinstitute.firecloud-ui.utils :as utils]
   ))

(defn- get-ordered-name [entity]
  (clojure.string/join ":"
    [(entity "namespace")
     (entity "name")
     (entity "snapshotId")]))

(def ^:private access-levels
  ["READER" "OWNER" "NO ACCESS"])

(def ^:private column-width "calc(50% - 4px)")

(react/defc AgoraPermsEditor
  {:render
   (fn [{:keys [props state this]}]
     [comps/Dialog
      {:width "75%"
       :blocking? true
       :dismiss-self (:dismiss-self props)
       :content (react/create-element
                  [:div {:style {:background "#fff" :padding "2em"}}
                   (cond
                     (:acl-vec @state)
                     [:div {}
                      (when (:saving? @state)
                        [comps/Blocker {:banner "Updating..."}])
                      [:div {:style {:paddingBottom "0.5em" :fontSize "90%"}}
                       [:h4 {} (let [sel-ent (:selected-entity props)
                                     ent-type (sel-ent "entityType")
                                     disp (get-ordered-name sel-ent)]
                                 (str "Permissions for " ent-type " " disp))]
                       [:div {:style
                              {:float "left" :width column-width}}
                        "User or Group ID"]
                       [:div {:style
                              {:float "right" :width column-width}}
                        "Access Level"]
                       (common/clear-both)]
                      (map-indexed
                        (fn [i acl-entry]
                          [:div {}
                           (style/create-text-field
                             {:ref (str "acl-key" i)
                              :style {:float "left" :width column-width
                                      :backgroundColor (when (< i (:count-orig @state))
                                                         (:background-gray style/colors))}
                              :disabled (< i (:count-orig @state))
                              :spellCheck false
                              :defaultValue (acl-entry "user")})
                           (style/create-select
                             {:ref (str "acl-value" i)
                              :style {:float "right" :width column-width :height 33}
                              :defaultValue (acl-entry "accessLevel")}
                             access-levels)
                           (common/clear-both)])
                        (:acl-vec @state))
                      [comps/Button
                       {:text "Add new" :style :add
                        :onClick #(swap! state assoc
                                   :acl-vec (flatten [(:acl-vec @state)
                                                      {"user" "" "accessLevel" "READER"}]))}]
                      [:div {:style {:textAlign "center" :marginTop "1em"}}
                       [:a {:href "javascript:;"
                            :style {:textDecoration "none"
                                    :color (:button-blue style/colors)
                                    :marginRight "1.5em"}
                            :onClick #((:dismiss-self props))}
                        "Cancel"]
                       [comps/Button {:text "Save"
                                      :onClick #(react/call :persist-acl this)}]]]
                     (:error @state) (style/create-server-error-message (:error @state))
                     :else [comps/Spinner {:text
                                           (str "Loading Permissions for "
                                             ((:selected-entity props) "entityType") " "
                                             (get-ordered-name (:selected-entity props))
                                             "...")}])])}])
   :component-did-mount
   (fn [{:keys [props state]}]
     (endpoints/call-ajax-orch
       {:endpoint (let [ent (:selected-entity props)
                        name (ent "name")
                        nmsp (ent "namespace")
                        sid (ent "snapshotId")]
                    (endpoints/get-agora-method-acl
                      nmsp name sid (:is-conf props)))
        :on-done (fn [{:keys [success? get-parsed-response status-text]}]
                   (if success?
                     (let [acl-vec (get-parsed-response)]
                       (swap! state assoc :acl-vec acl-vec :count-orig (count acl-vec)))
                     (swap! state assoc :error status-text)))}))
   :persist-acl
   (fn [{:keys [props state this]}]
     (swap! state assoc :saving? true)
     (swap! state assoc :acl-vec (react/call :capture-ui-state this))
     (endpoints/call-ajax-orch
       {:endpoint (endpoints/persist-agora-method-acl (:selected-entity props))
        :headers {"Content-Type" "application/json"}
        :payload (filterv #(not (empty? (:user %))) (:acl-vec @state))
        :on-done (fn [{:keys [success? status-text]}]
                   (swap! state dissoc :saving?)
                   (if success?
                     ((:dismiss-self props))
                     (js/alert "Error saving permissions: " status-text)))}))
   :capture-ui-state
   (fn [{:keys [state refs]}]
     (mapv
       (fn [i]
         {:user (-> (@refs (str "acl-key" i)) .getDOMNode .-value trim)
          :accessLevel (-> (@refs (str "acl-value" i)) .getDOMNode .-value)})
       (range (count (:acl-vec @state)))))})

(ns org.broadinstitute.firecloud-ui.page.methods-configs-acl
  (:require
   [dmohs.react :as react]
   [clojure.string :refer [trim]]
   [org.broadinstitute.firecloud-ui.common :as common]
   [org.broadinstitute.firecloud-ui.common.components :as comps]
   [org.broadinstitute.firecloud-ui.common.style :as style]
   [org.broadinstitute.firecloud-ui.common.table :as table]
   [org.broadinstitute.firecloud-ui.endpoints :as endpoints]
   [org.broadinstitute.firecloud-ui.utils :as utils]
   ))

(defn- get-ordered-name [entity]
  (clojure.string/join ":"
    [(entity "namespace")
     (entity "name")
     (entity "snapshotId")]))

(def ^:private access-levels
  ["READER" "OWNER" "NO ACCESS"])

(def ^:private column-width "calc(50% - 4px)")

(react/defc AgoraPermsEditor
  {:render
   (fn [{:keys [props state this]}]
     [comps/Dialog
      {:width "75%"
       :blocking? true
       :dismiss-self (:dismiss-self props)
       :content (react/create-element
                  [:div {:style {:background "#fff" :padding "2em"}}
                   [comps/XButton {:dismiss (:dismiss-self props)}]
                   (cond
                     (:acl-vec @state)
                     [:div {}
                      (when (:saving? @state)
                        [comps/Blocker {:banner "Updating..."}])
                      [:div {:style {:paddingBottom "0.5em" :fontSize "90%"}}
                       [:h4 {} (let [sel-ent (:selected-entity props)
                                     ent-type (sel-ent "entityType")
                                     disp (get-ordered-name sel-ent)]
                                 (str "Permissions for " ent-type " " disp))]
                       [:div {:style
                              {:float "left" :width column-width}}
                        "User or Group ID"]
                       [:div {:style
                              {:float "right" :width column-width}}
                        "Access Level"]
                       (common/clear-both)]
                      (map-indexed
                        (fn [i acl-entry]
                          [:div {}
                           (style/create-text-field
                             {:ref (str "acl-key" i)
                              :style {:float "left" :width column-width
                                      :backgroundColor (when (< i (:count-orig @state))
                                                         (:background-gray style/colors))}
                              :disabled (< i (:count-orig @state))
                              :spellCheck false
                              :defaultValue (acl-entry "user")})
                           (style/create-select
                             {:ref (str "acl-value" i)
                              :style {:float "right" :width column-width :height 33}
                              :defaultValue (acl-entry "accessLevel")}
                             access-levels)
                           (common/clear-both)])
                        (:acl-vec @state))
                      [comps/Button
                       {:text "Add new" :style :add
                        :onClick #(swap! state assoc
                                   :acl-vec (flatten [(:acl-vec @state)
                                                      {"user" "" "accessLevel" "READER"}]))}]
                      [:div {:style {:textAlign "center" :marginTop "1em"}}
                       [:a {:href "javascript:;"
                            :style {:textDecoration "none"
                                    :color (:button-blue style/colors)
                                    :marginRight "1.5em"}
                            :onClick #((:dismiss-self props))}
                        "Cancel"]
                       [comps/Button {:text "Save"
                                      :onClick #(react/call :persist-acl this)}]]]
                     (:error @state) (style/create-server-error-message (:error @state))
                     :else [comps/Spinner {:text
                                           (str "Loading Permissions for "
                                             ((:selected-entity props) "entityType") " "
                                             (get-ordered-name (:selected-entity props))
                                             "...")}])])}])
   :component-did-mount
   (fn [{:keys [props state]}]
     (endpoints/call-ajax-orch
       {:endpoint (let [ent (:selected-entity props)
                        name (ent "name")
                        nmsp (ent "namespace")
                        sid (ent "snapshotId")]
                    (endpoints/get-agora-method-acl
                      nmsp name sid (:is-conf props)))
        :on-done (fn [{:keys [success? get-parsed-response status-text]}]
                   (if success?
                     (let [acl-vec (get-parsed-response)]
                       (swap! state assoc :acl-vec acl-vec :count-orig (count acl-vec)))
                     (swap! state assoc :error status-text)))}))
   :persist-acl
   (fn [{:keys [props state this]}]
     (swap! state assoc :saving? true)
     (swap! state assoc :acl-vec (react/call :capture-ui-state this))
     (endpoints/call-ajax-orch
       {:endpoint (endpoints/persist-agora-method-acl (:selected-entity props))
        :headers {"Content-Type" "application/json"}
        :payload (filterv #(not (empty? (:user %))) (:acl-vec @state))
        :on-done (fn [{:keys [success? status-text]}]
                   (swap! state dissoc :saving?)
                   (if success?
                     ((:dismiss-self props))
                     (js/alert "Error saving permissions: " status-text)))}))
   :capture-ui-state
   (fn [{:keys [state refs]}]
     (mapv
       (fn [i]
         {:user (-> (@refs (str "acl-key" i)) .getDOMNode .-value trim)
          :accessLevel (-> (@refs (str "acl-value" i)) .getDOMNode .-value)})
       (range (count (:acl-vec @state)))))})

Add dismiss button to the method permissions modal


(ns cake.file
  (:use cake
        cake.core
        cake.ant
        [clojure.string :only [join]])
  (:import [org.apache.tools.ant.taskdefs Copy Move Touch Delete Mkdir]
           [java.io File]))

(defn expand-path [& path]
  (let [root (or (first path) "")]
    (cond (instance? File root)  (cons (.getPath root) (rest path))
          (.startsWith root "/") path
          (.startsWith root "~") (cons (.replace root "~" (System/getProperty "user.home")) (rest path))
          :else                  (cons *root* path))))

(defn file-name [& path]
  (join (File/separator) (apply expand-path path)))

(defn file
  "Create a File object from a string or seq"
  [& path]
  (File. (apply file-name path)))

(defn cp [from to]
  (ant Copy {:file (file from)
             :tofile (file to)}))

(defn mv [from to]
  (ant Move {:file (file from)
             :tofile (file to)}))

(defn touch [f]
  (ant Touch {:file (file f)}))

(defn rm [f]
  (ant Delete {:file (file f)}))

(defn rmdir [f]
  (ant Delete {:dir (file f)}))

(defn mkdir [f]
  (ant Mkdir {:dir (file f)}))

(ns cake.file
  (:use cake
        cake.core
        cake.ant
        [clojure.string :only [join]])
  (:import [org.apache.tools.ant.taskdefs Copy Move Touch Delete Mkdir]
           [java.io File]))

(defn expand-path [& path]
  (let [root (or (first path) "")]
    (cond (instance? File root)  (cons (.getPath root) (rest path))
          (.startsWith root "/") path
          (.startsWith root "~") (cons (.replace root "~" (System/getProperty "user.home")) (rest path))
          :else                  (cons *root* path))))

(defn file-name [& path]
  (join (File/separator) (apply expand-path path)))

(defn file
  "Create a File object from a string or seq"
  [& path]
  (File. (apply file-name path)))

(defn cp [from to]
  (ant Copy {:file (file from)
             :tofile (file to)}))

(defn mv [from to]
  (ant Move {:file (file from)
             :tofile (file to)}))

(defn touch [& args]
  (ant Touch {:file (apply file args)}))

(defn rm [f]
  (ant Delete {:file (file f)}))

(defn rmdir [f]
  (ant Delete {:dir (file f)}))

(defn mkdir [f]
  (ant Mkdir {:dir (file f)}))

apply args to file

apply args to file


(ns myshelf.core
  (:require [clj-http.client :as http]
            [clojure.data.xml :as xml]
            [clojure.java.io :refer [input-stream]]
            [oauth.client :as oauth]))

(def goodreads-request-token-url
  "http://www.goodreads.com/oauth/request_token")
(def goodreads-authorize-url
  "http://www.goodreads.com/oauth/authorize")
(def goodreads-access-token-url
  "http://www.goodreads.com/oauth/access_token")
(def goodreads-base-url "http://goodreads.com/")
(def goodreads-crypto-default :hmac-sha1)

(defn get-consumer
  "Get an API consumer for Goodreads"
  [key secret]
  (oauth/make-consumer key
                       secret
                       goodreads-request-token-url
                       goodreads-access-token-url
                       goodreads-authorize-url
                       :hmac-sha1))

(defn get-request-token
  "Get a Goodreads request token for a particular application"
  [consumer]
  (oauth/request-token consumer))

(defn find-approval-uri
  "Fetch the uri to be opened in a browser for the user to grant approval
  to this application"
  [consumer request-token]
  (oauth/user-approval-uri consumer
                           (:oauth_token request-token)))

(defn get-access-token
  "Once access has been granted, fetch an access token for using the API"
  [consumer request-token]
  (oauth/access-token consumer request-token))

(defn make-auth-request-GET
  [consumer access-token url params]
    (let [{:keys [oauth_token oauth_token_secret]} access-token
        credentials (oauth/credentials consumer
                                       oauth_token
                                       oauth_token_secret
                                       :GET
                                       url
                                       params)]
      (xml/parse-str
       (:body
        (http/get url
                  {:query-params (merge credentials
                                        params)})))))

(defn get-user-id
  "Fetch the Goodreads user id for the user that has granted access"
  [consumer access-token]
  (let [user-id-url "https://www.goodreads.com/api/auth_user"
        resp (make-auth-request-GET consumer
                                    access-token
                                    user-id-url
                                    {})]
    (->> resp
        :content
        (filter #(= :user (:tag %)))
        first
        :attrs
        :id)))

(defn element->map
  "Convert a clojure.data.xml Element into a hashmap"
  [element]
  {(:tag element)
   (if (string? (first (:content element)))
     (first (:content element))
     (apply merge (map element->map (:content element))))})

(defn extract-book-data
  "Given a <book> in a <review>, pull out the book's info into
  a more useful hashmap"
  [review-element]
  (->> review-element
       :content
       (filter #(= :book (:tag %)))
       first
       :content
       (reduce (fn [book-map book-tag]
                 (merge book-map (element->map book-tag)))
               {})))

(defn get-books-on-shelf
  "Returns list of hashmaps representing the books on a given
  user's bookshelf"
  [consumer access-token user-id shelf]
  (let [shelf-url (str "https://www.goodreads.com/review/list/"
                       user-id)
        resp (make-auth-request-GET consumer
                                    access-token
                                    shelf-url
                                    {:shelf shelf
                                     :format "xml"
                                     :v 2})]
    (->> resp
         :content
         second
         :content
         (map extract-book-data))))

Add fns for listing a user's books on a shelf.

Also add fns for converting that xml data into useful hash-maps.


(ns linkification
  (:use clojure.test
        [statuses.views.common :only [linkify]]))

(defn dcompare [actual expected]
  (cond (not= actual expected)
    (str ; XXX: unecessary hack
        (println actual)
        (println "        ^")
        (println "        |")
        (println "---- actual vs. expected ----")
        (println "                    |")
        (println "                    v")
        (println expected)))
  (is (= actual expected)))

(deftest linkify-basic []
  (is (= (linkify "lorem ipsum") "lorem ipsum")))

(deftest linkify-uris []
  (is (=
      (linkify "lorem http://example.org ipsum")
      "lorem http://example.org ipsum"))
  (is (=
      (linkify "http://example.org lipsum")
      "http://example.org lipsum"))
  (is (=
      (linkify "lipsum http://example.org")
      "lipsum http://example.org")))

(deftest linkify-hashtags []
  (is (=
      (linkify "lorem #hashtag ipsum")
      "lorem #hashtag ipsum"))
  (is (=
      (linkify "#hashtag lipsum")
      "#hashtag lipsum"))
  (is (=
      (linkify "lipsum #hashtag")
      "lipsum #hashtag")))

(deftest linkify-uris-with-fragment-identifier []
  (dcompare
      (linkify "lorem http://example.org#anchor ipsum")
      "lorem http://example.org#anchor ipsum"))
  (dcompare
      (linkify "#hashtag lipsum http://example.org#anchor-name")
      "#hashtag lipsum http://example.org#anchor-name")
  (dcompare
      (linkify "lipsum http://example.org#anchor-name #hashtag")
      "lipsum http://example.org#anchor-name #hashtag")

(ns linkification
  (:use clojure.test
        [statuses.views.common :only [linkify]]))

(deftest linkify-basic []
  (is (= (linkify "lorem ipsum") "lorem ipsum")))

(deftest linkify-uris []
  (is (=
      (linkify "lorem http://example.org ipsum")
      "lorem http://example.org ipsum"))
  (is (=
      (linkify "http://example.org lipsum")
      "http://example.org lipsum"))
  (is (=
      (linkify "lipsum http://example.org")
      "lipsum http://example.org")))

(deftest linkify-hashtags []
  (is (=
      (linkify "lorem #hashtag ipsum")
      "lorem #hashtag ipsum"))
  (is (=
      (linkify "#hashtag lipsum")
      "#hashtag lipsum"))
  (is (=
      (linkify "lipsum #hashtag")
      "lipsum #hashtag")))

(deftest linkify-uris-with-fragment-identifier []
  (is (=
      (linkify "lorem http://example.org#anchor ipsum")
      "lorem http://example.org#anchor ipsum")))
  (is (=
      (linkify "#hashtag lipsum http://example.org#anchor-name")
      "#hashtag lipsum http://example.org#anchor-name"))
  (is (=
      (linkify "lipsum http://example.org#anchor-name #hashtag")
      "lipsum http://example.org#anchor-name #hashtag"))

remove dcompare hack

remove dcompare hack


(ns todomvc.item
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [cljs.core.async :refer [>! <! put! alts!]]
            [todomvc.utils :refer [now]]
            [clojure.string :as string]
            [om.core :as om]
            [om.dom :as dom :include-macros true]))

(def ESCAPE_KEY 27)
(def ENTER_KEY 13)

;; =============================================================================
;; Todo Item

(defn handle-submit [e todo {:keys [owner chans]}]
  (let [val (.trim (dom/get-node todo "editText"))]
    (if-not (string/blank? val)
      (go
        (>! (:on-save chans) [todo val])
        (om/replace! todo :title (:edit-text todo)))
      (put! (:on-destroy chans) (:id todo)))
    false))

(defn handle-edit [e todo {:keys [owner chans]}]
  (put! (:on-edit chans) todo)
  (let [node (dom/get-node owner "editField")]
    (.focus node)
    (.setSelectionRange (.. node -value -length) (.. node -value -length)))
  (om/replace! todo :edit-text (:title todo)))

(defn handle-key-down [e todo opts]
  (if (identical? (.-keyCode e) ESCAPE_KEY)
    (om/replace! todo :edit-text (:title todo))
    (handle-submit e todo opts)))

(defn handle-change [e todo]
  (om/replace! todo :edit-text (.. e -target -value)))

(defn todo-item [{:keys [completed editing] :as todo} chans]
  (reify
    dom/IRender
    (-render [_ owner]
      (let [m {:owner owner :chans chans}]
        (dom/li #js {:className (str (and completed "completed") " "
                                  (and editing "editing"))}
          (dom/div #js {:className "view"}
            (dom/input #js {:className "toggle"
                            :type "checkbox"
                            :checked (and completed "checked")
                            :onChange (fn [_] (put! (:toggle chans) todo))})
            (dom/label #js {:onDoubleClick #(handle-edit % todo owner)}
              (:title todo))
            (dom/button #js {:className "destroy"
                             :onClick (fn [_] (put! (:delete chans) todo))})
            (dom/input #js {:ref "editField"
                            :className "edit"
                            :value (:edit-text todo)
                            :onBlur #(handle-submit % todo m)
                            :onChange #(handle-change % todo)
                            :onKeyDown #(handle-key-down % todo m)})))))))

(ns todomvc.item
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [cljs.core.async :refer [>! <! put!]]
            [todomvc.utils :refer [now]]
            [clojure.string :as string]
            [om.core :as om]
            [om.dom :as dom :include-macros true]))

(def ESCAPE_KEY 27)
(def ENTER_KEY 13)

;; =============================================================================
;; Todo Item

(defn handle-submit [e todo {:keys [owner chans]}]
  (let [val (.trim (dom/get-node todo "editText"))]
    (if-not (string/blank? val)
      (go
        (>! (:on-save chans) [todo val])
        (om/replace! todo :title (:edit-text todo)))
      (put! (:on-destroy chans) (:id todo)))
    false))

(defn handle-edit [e todo {:keys [owner chans]}]
  (put! (:on-edit chans) todo)
  (let [node (dom/get-node owner "editField")]
    (.focus node)
    (.setSelectionRange (.. node -value -length) (.. node -value -length)))
  (om/replace! todo :edit-text (:title todo)))

(defn handle-key-down [e todo opts]
  (if (identical? (.-keyCode e) ESCAPE_KEY)
    (om/replace! todo :edit-text (:title todo))
    (handle-submit e todo opts)))

(defn handle-change [e todo]
  (om/replace! todo :edit-text (.. e -target -value)))

(defn todo-item [{:keys [completed editing] :as todo} chans]
  (reify
    dom/IRender
    (-render [_ owner]
      (let [m {:owner owner :chans chans}]
        (dom/li #js {:className (str (and completed "completed") " "
                                     (and editing "editing"))}
          (dom/div #js {:className "view"}
            (dom/input #js {:className "toggle"
                            :type "checkbox"
                            :checked (and completed "checked")
                            :onChange (fn [_] (put! (:toggle chans) todo))})
            (dom/label #js {:onDoubleClick #(handle-edit % todo owner)}
              (:title todo))
            (dom/button #js {:className "destroy"
                             :onClick (fn [_] (put! (:destroy chans) todo))})
            (dom/input #js {:ref "editField"
                            :className "edit"
                            :value (:edit-text todo)
                            :onBlur #(handle-submit % todo m)
                            :onChange #(handle-change % todo)
                            :onKeyDown #(handle-key-down % todo m)})))))))

fix bugs

fix bugs