(ns semtag-web.client.main
  (:require [semtag-web.client.view :refer [generate-table path-to] :as view]
            [semtag-web.client.util :refer [log log-clj return-key-pressed] :as util]
            [jayq.core :refer [$ bind inner] :as jq]))

;; possible util fns
(defn- error-msg [path err]
  (format "Request '%s' failed with: %s" path (pr-str err)))

(defn- console-error [path _ _ err]
  (.log js/console (error-msg path err)))

(defn- alert
  ([msg] (alert msg :error))
  ([msg alert-type]
    (jq/prepend ($ :#main) (view/alert msg (str "alert-" (name alert-type))))))

(defn- alert-error [path a b err]
  (let [msg (or (.-responseText a) err)]
    (alert (error-msg path msg))))

(defn backend-request
  "Given a path and success fn makes a request using $.ajax. Additional arguments are
  interpreted as options to $.ajax. Also accepts a :alert-fn option to create a
  specialized error fn."
  [path f & {:keys [type alert-fn] :or {type "GET" alert-fn alert-error} :as options}]
  (jq/ajax
    (str "http://localhost:3000/api" path)
    (merge
      {:dataType "edn"
       :error #(apply alert-fn path %&)
       :type type
       :success f
       } options)))

;;; js update fns
(defn- add-sort-to [parent-div]
  (.tablesorter (jq/find parent-div :table)))

(defn- create-sort-table [& args]
  (apply inner args)
  (add-sort-to (first args)))

(defn- set-edit-state [klass event]
  (let [$elem ($ (.-target event))]
    (doseq [c (->> (jq/attr $elem :class) (re-seq #"\S+") (filter #(re-find #"^edit-" %)))]
      (jq/remove-class $elem c))
    (jq/add-class $elem klass)))

(defn- saves-edit [event]
  (.preventDefault event)
  (let [$elem ($ (.-target event))
        id (.data (jq/parent $elem) "id")
        field (.data $elem "field")
        value (jq/text $elem)]
    (.blur $elem)
    (backend-request
      (path-to "/edit")
      (fn [data]
        (log "Received from server:")
        (log-clj data)
        (set-edit-state "edit-completed" event))
      :type "POST"
      :data {:id id field value}
      :alert-fn (fn [& args]
        (set-edit-state "edit-failed" event)
        (apply alert-error args)
        ))))

(defn- expand-editable-text [event]
  (let [$elem ($ (.-target event))]
    (jq/remove-class $elem "ellipsis")
    ;; quick and dirty way - cleaner way would be to track editing state
    ;; this check ensures we don't clobber that the user has come back to finish edit
    (when (re-find #"\.\.\.$" (jq/text $elem))
      (inner $elem (jq/attr $elem "title")))))

(defn- make-table-editable []
  (let [editable-cells ($ :td.editable)]
    (.attr editable-cells "contentEditable" true)
    (.attr (jq/find editable-cells "a") "contentEditable" false)
    (bind editable-cells "click" (juxt expand-editable-text (partial set-edit-state "edit-in-progress")))
    (bind editable-cells :keypress (return-key-pressed saves-edit))))

(defn- create-search-table [parent data]
  (jq/remove ($ :#search_table))
  (jq/after (jq/find parent :h2)
            (generate-table "search_table" data
                            :fields [:namespace :name :url :desc :tags]
                            :row-partial view/tag-search-row
                            :caption (str "Total: " (count data))))

  (make-table-editable)
  (add-sort-to parent))

(defn mls-search
  [search-box text-field & [callback event]]
  (let [query (jq/val text-field)]
    (-> (jq/find search-box :h2)
      (inner (str "Search results for '" query "'")))
    (.blur text-field)
    (backend-request (path-to "/mls") (partial create-search-table search-box) :data {:query query})
    (when callback (callback query))))

(defn create-url [$text $button]
  (backend-request (path-to "/add")
    (fn [data]
      (alert (format "Added '%s'" (jq/val $text)) :info)
      (jq/text $button "Add Url")
      (jq/val $text "")
      (jq/hide $text))
    :type "POST"
    :data {:input (jq/val $text)}))

(defn add-url [$text $button event]
  (if (jq/is $text ":visible")
    (create-url $text $button)
    (do
      (jq/text $button "Create Url")
      (jq/show $text))))

;;; on-load js fns for specific pages
(defn ^:export tag-show []
  (let [$tag-box ($ :#tag_box)
        tag (util/match-from-current-uri #"[^\/]+$")]
    (backend-request (path-to "/tag")
      (fn [data]
        (if (string? data)
          (alert data)
          (do
            (create-sort-table $tag-box
                   (generate-table "tag_show_table"
                                   data
                                   :caption (view/link-tagged tag)
                                   :row-partial view/tag-row
                                   :fields [:attribute :value]))
            (make-table-editable))
          ))
       :data {:tag tag})))

(defn ^:export tag-stats []
  (backend-request (path-to "/tag-stats")
    #(create-sort-table ($ :#tag_stats_box)
            (generate-table "tag_stats_table" %
                            :row-partial view/tag-stats-row
                            :caption (str "Total: " (count %))
                            :fields [:tag :count :desc]))))

(defn ^:export home []
  (let [$button ($ :#url_search_button)
        $text-field ($ :#url_search_text)
        $add-button ($ :#add_url_button)
        $add-text ($ :#add_url_text)
        create-url (partial add-url $add-text $add-button)
        search-and-update-page (partial mls-search ($ :#search_box) $text-field)
        search-and-update-page-and-url (partial search-and-update-page
                                                #(.pushState window.history "" "" (path-to "/?query=" %)))
        query-param (re-find #"[\?&]?query=([^&]+)" (.-search window.location))]

    (bind $button "click" search-and-update-page-and-url)
    (bind $add-button "click" create-url)
    (bind $add-text :keypress (return-key-pressed create-url))
    (bind $text-field :keypress (return-key-pressed search-and-update-page-and-url))

    (backend-request (path-to "/tags")
      #(jq/after $text-field (view/generate-datalist %))
      :alert-fn console-error)

    (when-let [query (when (seq query-param) (second query-param))]
      (jq/val $text-field query)
      (search-and-update-page))))

(defn ^:export entity-add []
  (home)
  (.click ($ :#add_url_button))
  (if-let [input (util/param-value "input")]
    (do
      (.text ($ :#add_url_text) (.decodeURI js/window input))
      (.click ($ :#add_url_button)))
    (alert "No input given.")))

(defn ^:export model-show []
  (let [model (util/match-from-current-uri #"[^\/]+$")]
    (backend-request (path-to "/model")
      (fn [data]
        (create-sort-table ($ :#model_show_box)
              (generate-table "model_show_table" data
                              :row-partial view/model-row
                              :caption (str "Total: " (count data))
                              :fields [:name :url :desc :tags]))
        (make-table-editable))
      :data {:model model})))

(defn ^:export model-stats []
  (backend-request (path-to "/models")
    #(create-sort-table ($ :#model_stats_box)
            (generate-table "model_stats_table" %
                            :row-partial view/model-stats-row
                            :fields [:name :count :name-percent :url-percent]))))

(ns semtag-web.client.main
  (:require [semtag-web.client.view :refer [generate-table path-to] :as view]
            [semtag-web.client.util :refer [log log-clj return-key-pressed] :as util]
            clojure.string
            [jayq.core :refer [$ bind inner] :as jq]))

;; possible util fns
(defn- error-msg [path err]
  (format "Request '%s' failed with: %s" path (pr-str err)))

(defn- console-error [path _ _ err]
  (.log js/console (error-msg path err)))

(defn- alert
  ([msg] (alert msg :error))
  ([msg alert-type]
    (jq/prepend ($ :#main) (view/alert msg (str "alert-" (name alert-type))))))

(defn- alert-error [path a b err]
  (let [msg (or (.-responseText a) err)]
    (alert (error-msg path msg))))

(defn backend-request
  "Given a path and success fn makes a request using $.ajax. Additional arguments are
  interpreted as options to $.ajax. Also accepts a :alert-fn option to create a
  specialized error fn."
  [path f & {:keys [type alert-fn] :or {type "GET" alert-fn alert-error} :as options}]
  (jq/ajax
    (str "http://localhost:3000/api" path)
    (merge
      {:dataType "edn"
       :error #(apply alert-fn path %&)
       :type type
       :success f
       } options)))

;;; js update fns
(defn- add-sort-to [parent-div]
  (.tablesorter (jq/find parent-div :table)))

(defn- create-sort-table [& args]
  (apply inner args)
  (add-sort-to (first args)))

(defn- set-edit-state [klass event]
  (let [$elem ($ (.-target event))]
    (doseq [c (->> (jq/attr $elem :class) (re-seq #"\S+") (filter #(re-find #"^edit-" %)))]
      (jq/remove-class $elem c))
    (jq/add-class $elem klass)))

(defn- saves-edit [event]
  (.preventDefault event)
  (let [$elem ($ (.-target event))
        id (.data (jq/parent $elem) "id")
        field (.data $elem "field")
        value (jq/text $elem)]
    (.blur $elem)
    (backend-request
      (path-to "/edit")
      (fn [data]
        (log "Received from server:")
        (log-clj data)
        (set-edit-state "edit-completed" event))
      :type "POST"
      :data {:id id field value}
      :alert-fn (fn [& args]
        (set-edit-state "edit-failed" event)
        (apply alert-error args)
        ))))

(defn- expand-editable-text [event]
  (let [$elem ($ (.-target event))]
    (jq/remove-class $elem "ellipsis")
    ;; quick and dirty way - cleaner way would be to track editing state
    ;; this check ensures we don't clobber that the user has come back to finish edit
    (when (re-find #"\.\.\.$" (jq/text $elem))
      (inner $elem (jq/attr $elem "title")))))

(defn- make-table-editable []
  (let [editable-cells ($ :td.editable)]
    (.attr editable-cells "contentEditable" true)
    (.attr (jq/find editable-cells "a") "contentEditable" false)
    (bind editable-cells "click" (juxt expand-editable-text (partial set-edit-state "edit-in-progress")))
    (bind editable-cells :keypress (return-key-pressed saves-edit))))

(defn- create-search-table [parent data]
  (jq/remove ($ :#search_table))
  (jq/after (jq/find parent :h2)
            (generate-table "search_table" data
                            :fields [:namespace :name :url :desc :tags]
                            :row-partial view/tag-search-row
                            :caption (str "Total: " (count data))))

  (make-table-editable)
  (add-sort-to parent))

(defn mls-search
  [search-box text-field & [callback event]]
  (let [query (jq/val text-field)]
    (-> (jq/find search-box :h2)
      (inner (str "Search results for '" query "'")))
    (.blur text-field)
    (backend-request (path-to "/mls") (partial create-search-table search-box) :data {:query query})
    (when callback (callback query))))

(defn create-url [$text $button]
  (backend-request (path-to "/add")
    (fn [data]
      (alert (format "Added '%s'" (jq/val $text)) :info)
      (jq/text $button "Add Url")
      (jq/val $text "")
      (jq/hide $text))
    :type "POST"
    :data {:input (jq/val $text)}))

(defn add-url [$text $button event]
  (if (jq/is $text ":visible")
    (create-url $text $button)
    (do
      (jq/text $button "Create Url")
      (jq/show $text))))

;;; on-load js fns for specific pages
(defn ^:export tag-show []
  (let [$tag-box ($ :#tag_box)
        tag (util/match-from-current-uri #"[^\/]+$")]
    (backend-request (path-to "/tag")
      (fn [data]
        (if (string? data)
          (alert data)
          (do
            (create-sort-table $tag-box
                   (generate-table "tag_show_table"
                                   data
                                   :caption (view/link-tagged tag)
                                   :row-partial view/tag-row
                                   :fields [:attribute :value]))
            (make-table-editable))
          ))
       :data {:tag tag})))

(defn ^:export tag-stats []
  (backend-request (path-to "/tag-stats")
    #(create-sort-table ($ :#tag_stats_box)
            (generate-table "tag_stats_table" %
                            :row-partial view/tag-stats-row
                            :caption (str "Total: " (count %))
                            :fields [:tag :count :desc]))))

(defn ^:export home []
  (let [$button ($ :#url_search_button)
        $text-field ($ :#url_search_text)
        $add-button ($ :#add_url_button)
        $add-text ($ :#add_url_text)
        create-url (partial add-url $add-text $add-button)
        search-and-update-page (partial mls-search ($ :#search_box) $text-field)
        search-and-update-page-and-url (partial search-and-update-page
                                                #(.pushState window.history "" "" (path-to "/?query=" %)))
        query-param (re-find #"[\?&]?query=([^&]+)" (.-search window.location))]

    (bind $button "click" search-and-update-page-and-url)
    (bind $add-button "click" create-url)
    (bind $add-text :keypress (return-key-pressed create-url))
    (bind $text-field :keypress (return-key-pressed search-and-update-page-and-url))

    (backend-request (path-to "/tags")
      #(jq/after $text-field (view/generate-datalist %))
      :alert-fn console-error)

    (when-let [query (when (seq query-param) (second query-param))]
      (jq/val $text-field query)
      (search-and-update-page))))

(defn ^:export entity-add []
  (home)
  (.click ($ :#add_url_button))
  (if-let [input (util/param-value "input")]
    ; remove hack when not using cmd service that overrides ':'
    (let [input (-> (clojure.string/replace input #"\.\." ":"))]
      (.text ($ :#add_url_text) (.decodeURI js/window input))
      (.click ($ :#add_url_button)))
    (alert "No input given.")))

(defn ^:export model-show []
  (let [model (util/match-from-current-uri #"[^\/]+$")]
    (backend-request (path-to "/model")
      (fn [data]
        (create-sort-table ($ :#model_show_box)
              (generate-table "model_show_table" data
                              :row-partial view/model-row
                              :caption (str "Total: " (count data))
                              :fields [:name :url :desc :tags]))
        (make-table-editable))
      :data {:model model})))

(defn ^:export model-stats []
  (backend-request (path-to "/models")
    #(create-sort-table ($ :#model_stats_box)
            (generate-table "model_stats_table" %
                            :row-partial view/model-stats-row
                            :fields [:name :count :name-percent :url-percent]))))

add a hack to bypass queriac's arg parsing


(ns momentum.core.deferred
  (:import
   [momentum.async
    AsyncSeq
    AsyncVal
    Pipeline
    Pipeline$Catcher
    Pipeline$Recur
    Receiver]))

(defprotocol DeferredValue
  (received? [_])
  (receive   [_ success error]))

(extend-protocol DeferredValue
  AsyncVal
  (received? [val]
    (.isRealized val))
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  AsyncSeq
  (received? [seq]
    (.isRealized seq))
  (receive [seq success error]
    (doto seq
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Pipeline
  (received? [pipeline]
    (.isRealized pipeline))
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Object
  (received? [o] true)
  (receive [o success _]
    (success o)
    o)

  nil
  (received? [_] true)
  (receive [_ success _]
    (success nil)
    nil))

(defprotocol DeferredRealizer
  (put [_ v])
  (abort [_ err]))

(extend-protocol DeferredRealizer
  AsyncVal
  (put [dval val]   (.put dval val))
  (abort [dval err] (.abort dval err))

  Pipeline
  (put   [pipeline val] (.put pipeline val))
  (abort [pipeline err] (.abort pipeline err)))

(defn deferred
  []
  (AsyncVal.))

;; ==== Pipeline stuff

(defn pipeline
  [stages catchers finalizer]
  (Pipeline. (reverse stages) catchers finalizer))

(defn recur*
  ([]    (Pipeline$Recur. nil))
  ([val] (Pipeline$Recur. val)))

(defn join
  [& args]
  )

;; ==== Async macro

(defn- catch?
  [clause]
  (and (seq? clause) (= 'catch (first clause))))

(defn- finally?
  [clause]
  (and (seq? clause) (= 'finally (first clause))))

(defn- partition-clauses
  [clauses]
  (reduce
   (fn [[stages catches finally] clause]
     (cond
      (and (catch? clause) (not finally))
      [stages (conj catches clause) finally]

      (and (finally? clause) (not finally))
      [stages catches clause]

      (or (catch? clause) (finally? clause) (first catches) finally)
      (throw (IllegalArgumentException. (str "malformed pipeline statement: " clause)))

      :else
      [(conj stages clause) catches finally]))
   [[] [] nil] clauses))

(defn- to-catcher
  [[ _ k b & stmts]]
  `(Pipeline$Catcher. ~k (fn [~b] ~@stmts)))

(defn- to-finally
  [[_ & stmts]]
  `(fn [] ~@stmts))

(defmacro doasync
  [seed & clauses]
  (let [[stages catches finally] (partition-clauses clauses)]
    `(doto (pipeline [~@stages] [~@(map to-catcher catches)] ~(to-finally finally))
       (put ~seed))))

(defn async-seq
  ([f] (AsyncSeq. f)))

(defn batch
  "Returns a deferred value that is realized with the given collection
  when all (or n if supplied) elements of the collection have been
  realized."
  [coll]
  (doasync coll
    (fn [x]
      (if x
        (recur* (next x))
        coll))))
;; ([n coll] (throw (Exception. "Not implemented - requires (join ...)")))

(defn map*
  [f coll]
  (async-seq
    (fn [_]
      (doasync coll
        (fn [[v & more]]
          (cons v (map* f more)))))))

(ns momentum.core.deferred
  (:import
   [momentum.async
    AsyncSeq
    AsyncVal
    Pipeline
    Pipeline$Catcher
    Pipeline$Recur
    Receiver]))

(defprotocol DeferredValue
  (receive   [_ success error]))

(extend-protocol DeferredValue
  AsyncVal
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  AsyncSeq
  (receive [seq success error]
    (doto seq
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Pipeline
  (receive [val success error]
    (doto val
      (.receive
       (reify Receiver
         (success [_ val] (success val))
         (error   [_ err] (error err))))))

  Object
  (receive [o success _]
    (success o)
    o)

  nil
  (receive [_ success _]
    (success nil)
    nil))

(defprotocol DeferredRealizer
  (put [_ v])
  (abort [_ err]))

(extend-protocol DeferredRealizer
  AsyncVal
  (put [dval val]   (.put dval val))
  (abort [dval err] (.abort dval err))

  Pipeline
  (put   [pipeline val] (.put pipeline val))
  (abort [pipeline err] (.abort pipeline err)))

(defn deferred
  []
  (AsyncVal.))

;; ==== Pipeline stuff

(defn pipeline
  [stages catchers finalizer]
  (Pipeline. (reverse stages) catchers finalizer))

(defn recur*
  ([]    (Pipeline$Recur. nil))
  ([val] (Pipeline$Recur. val)))

(defn join
  [& args]
  )

;; ==== Async macro

(defn- catch?
  [clause]
  (and (seq? clause) (= 'catch (first clause))))

(defn- finally?
  [clause]
  (and (seq? clause) (= 'finally (first clause))))

(defn- partition-clauses
  [clauses]
  (reduce
   (fn [[stages catches finally] clause]
     (cond
      (and (catch? clause) (not finally))
      [stages (conj catches clause) finally]

      (and (finally? clause) (not finally))
      [stages catches clause]

      (or (catch? clause) (finally? clause) (first catches) finally)
      (throw (IllegalArgumentException. (str "malformed pipeline statement: " clause)))

      :else
      [(conj stages clause) catches finally]))
   [[] [] nil] clauses))

(defn- to-catcher
  [[ _ k b & stmts]]
  `(Pipeline$Catcher. ~k (fn [~b] ~@stmts)))

(defn- to-finally
  [[_ & stmts]]
  `(fn [] ~@stmts))

(defmacro doasync
  [seed & clauses]
  (let [[stages catches finally] (partition-clauses clauses)]
    `(doto (pipeline [~@stages] [~@(map to-catcher catches)] ~(to-finally finally))
       (put ~seed))))

(defn async-seq
  ([f] (AsyncSeq. f)))

(defn batch
  "Returns a deferred value that is realized with the given collection
  when all (or n if supplied) elements of the collection have been
  realized."
  [coll]
  (doasync coll
    (fn [x]
      (if x
        (recur* (next x))
        coll))))
;; ([n coll] (throw (Exception. "Not implemented - requires (join ...)")))

(defn map*
  [f coll]
  (async-seq
    (fn [_]
      (doasync coll
        (fn [[v & more]]
          (cons v (map* f more)))))))

Remove dead code (received? _)

Remove dead code (received? _)


(ns clj-money.web.transactions
  (:refer-clojure :exclude [update])
  (:require [clojure.tools.logging :as log]
            [clojure.pprint :refer [pprint]]
            [environ.core :refer [env]]
            [hiccup.core :refer :all]
            [hiccup.page :refer :all]
            [ring.util.response :refer :all]
            [ring.util.codec :refer [url-encode]]
            [clj-time.core :as t]
            [clj-money.authorization :refer [authorize
                                             allowed?
                                             tag-resource
                                             apply-scope]]
            [clj-money.util :refer [ensure-local-date]]
            [clj-money.url :refer :all]
            [clj-money.coercion :as coercion]
            [clj-money.validation :as validation]
            [clj-money.pagination :as pagination]
            [clj-money.models.entities :as entities]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.permissions.transactions]
            [clj-money.web.money-shared :refer [grouped-options-for-accounts
                                                budget-monitors]]
            [clj-money.util :refer [format-date]])
  (:use [clj-money.web.shared :refer :all]))

(defmacro with-transactions-layout
  [page-title entity-or-id options & content]
  `(let [entity# (if (integer? ~entity-or-id)
                   (entities/find-by-id (env :db) ~entity-or-id)
                   ~entity-or-id)]
     (with-layout
       ~page-title (assoc ~options :side-bar (budget-monitors (:id entity#))
                          :entity entity#)
       ~@content)))

(defn- transaction-row
  "Renders a row in the transaction table"
  [transaction]
  [:tr
   [:td (format-date (:transaction-date transaction))]
   [:td (:description transaction)]
   [:td
    [:div.btn-group
     (when (allowed? :update transaction)
       (glyph-button :pencil
                     (format "/transactions/%s/edit" (:id transaction))
                     {:level :info
                      :size :extra-small
                      :title "Click here to edit this transaction."}))
     (when (allowed? :delete transaction)
       (let [can-delete? (transactions/can-delete? transaction)]
         (glyph-button :remove
                       (format "/transactions/%s/delete" (:id transaction))
                       {:level :danger
                        :disabled (not can-delete?)
                        :size :extra-small
                        :data-method :post
                        :data-confirm "Are you sure you want to delete this transaction?"
                        :title (if can-delete?
                                 "Click here to remove this transaction."
                                 "This transaction contains reconciled items and cannot be removed")})))]]])

(defn index
  ([req] (index req {}))
  ([{{entity-id :entity-id :as params} :params} options]
   (with-transactions-layout "Transactions" entity-id options
     (let [criteria (apply-scope {:entity-id entity-id} :transaction)]
       (html
         [:table.table.table-striped
          [:tr
           [:th.col-sm-2 "Date"]
           [:th.col-sm-8 "Description"]
           [:th.col-sm-2 " "]]
          (map transaction-row
               (transactions/search (env :db)
                                    criteria
                                    (merge {:limit 100
                                            :sort [[:transaction-date :desc]]} ; TODO Need to get :limit and :per-page in sync
                                           (pagination/prepare-options params))))]
         (pagination/nav (assoc params
                                :url (-> (path "/entities" entity-id "transactions"))
                                :total (transactions/record-count (env :db) criteria)))))
     (when (allowed? :create (-> {:entity-id entity-id}
                                 (tag-resource :transaction)))
       [:p
        [:a.btn.btn-primary
         {:href (str"/entities/" entity-id "/transactions/new")
          :title "Click here to enter a new transaction."}
         "Add"]]))))

(defn- item-row
  "Renders an individual row for a transaction item"
  [entity-id index item]
  [:tr
   [:td.col-sm-4
    (html
      (when-let [id (:id item)]
        (hidden-input-element (str "id-" index) id))
      (select-element (str "account-id-" index)
                      (:account-id item)
                      (grouped-options-for-accounts entity-id
                                                    {:include-none? true
                                                     :selected-id (:account-id item)})
                      {:suppress-label? true}))]
   [:td.col-sm-4
    (text-input-element (str "memo-" index) (:memo item) {:suppress-label? true}) ]
   [:td.col-sm-2
    (text-input-element (str "credit-amount-" index) (:credit-amount item) {:suppress-label? true})]
   [:td.col-sm-2
    (text-input-element (str "debit-amount-" index) (:debit-amount item) {:suppress-label? true})]])

(defn- ->form-item
  "Tranforms a transaction item as managed by the system into a
  item that can be used by the form"
  [transaction-item]
  (-> transaction-item
      (assoc :credit-amount (when (= :credit (:action transaction-item))
                              (:amount transaction-item))
             :debit-amount (when (= :debit (:action transaction-item))
                             (:amount transaction-item)))
      (dissoc :amount :action)))

(defn- ->transaction-item
  "Transforms a form item into a transaction item"
  [{:keys [credit-amount debit-amount] :as item}]
  (let [[action amount] (if (seq credit-amount)
                          [:credit (bigdec credit-amount)]
                          [:debit (bigdec debit-amount)])]
    (-> item
        (assoc :action action
               :amount amount)
        (dissoc :credit-amount :debit-amount))))

(defn- items-for-form
  [transaction]
  (map-indexed #(->> %2
                        ->form-item
                        (item-row (:entity-id transaction) %1))
               (concat (:items transaction)
                       (repeat {:action nil
                                :account-id nil
                                :amount nil}))))

(defn- form-fields
  [transaction back-url]
  (html
    [:div.row
     [:div.col-md-6
      (date-input-field transaction :transaction-date)]
     [:div.col-md-6
      (text-input-field transaction :description)]]
    [:div.row
     [:div.col-md-12
      (text-input-field transaction :memo)]]
    [:table.table.table-striped
     [:tr
      [:th "Account"]
      [:th "Memo"]
      [:th "Credit"]
      [:th "Debit"]]
     (take 10 (items-for-form transaction))]
    [:input.btn.btn-primary {:type :submit :value "Save"}]
    " "
    [:a.btn.btn-default
     {:href back-url
      :title "Click here to return to the list of transactions"}
     "Back"]))

(defn- validate-redirect-url
  [url]
  (when (and url (not (re-matches #"\Ahttps?:://" url)))
    url))

(defn- redirect-url
  [entity-id params]
  (or (validate-redirect-url (:redirect params))
      (format "/entities/%s/transactions" entity-id)))

(defn new-transaction
  ([{params :params}]
   (new-transaction params
                    (-> {:entity-id (:entity-id params)
                         :items [{:action :debit}
                                 {:action :credit}]
                         :transaction-date (t/today)}
                        (tag-resource :transaction)
                        (authorize :new))
                    {}))
  ([params transaction options]
   (with-transactions-layout "New Transaction" (:entity-id transaction) options
     (form (cond-> (path "/entities"
                         (:entity-id transaction)
                         "transactions")
             (contains? params :redirect) (query {:redirect (-> params
                                                                :redirect
                                                                url-encode)})
             true format-url) {}
           (form-fields transaction (redirect-url (:entity-id transaction) params))))))

(defn- valid-item?
  [{account-id :account-id :as item}]
  (or (integer? account-id)
      (and (string? account-id)
           (seq account-id))))

(defn- extract-items
  [params]
  (->> (iterate inc 0)
       (map (fn [index]
               (let [attr [:id :account-id :debit-amount :credit-amount :memo]
                     indexed-attr (map #(keyword (str (name %) "-" index)) attr)
                     item (zipmap attr (map #(% params) indexed-attr))]
                 item)))
       (take-while valid-item?)
       (map ->transaction-item)))

(defn create
  [{params :params}]
  (let [transaction (-> params
                        (assoc :items (extract-items params))
                        (select-keys [:entity-id :transaction-date :description :items :memo])
                        (update-in [:items] (partial map #(select-keys % [:account-id :action :amount :memo])))
                        (tag-resource :transaction)
                        (authorize :create))
        result (transactions/create (env :db) transaction)
        redirect-url (redirect-url (:entity-id result) params)]
    (if (validation/has-error? result)
      (new-transaction params result {})
      (redirect redirect-url))))

(defn edit
  ([req] (edit req {}))
  ([{params :params transaction :transaction} options]
   (let [id (:id params)
         transaction (or transaction
                         (authorize (transactions/find-by-id (env :db) id) :update))
         action (cond-> (path "/transactions"
                              (:id transaction))

                  (:redirect params)
                  (query {:redirect (url-encode (:redirect params))})

                  true
                  format-url)]
     (with-transactions-layout "New Transaction" (:entity-id transaction) options
       (form action {}
             (form-fields transaction (redirect-url (:entity-id transaction) params)))))))

(defn update
  [{params :params}]
  (let [transaction (authorize (transactions/find-by-id
                                 (env :db)
                                 (:id params)
                                 (ensure-local-date (:original-transaction-date params)))
                               :update)
        updated (merge transaction
                       (-> params
                           (select-keys [:id
                                         :transaction-date
                                         :original-transaction-date
                                         :description
                                         :memo])
                           (assoc :items (extract-items params))))
        result (transactions/update (env :db) updated)
        redirect-url (redirect-url (:entity-id result) params)]
    (if (validation/has-error? result)
      (edit result {:alerts [{:type :danger :message (str "Unable to save the transaction " (validation/error-messages updated))}]})
      (redirect redirect-url))))

(defn delete
  [{{id :id :as params} :params}]
  (let [transaction (authorize (transactions/find-by-id (env :db) id) :delete)
        redirect-url (redirect-url (:entity-id transaction) params)]
    (transactions/delete (env :db) id)
    (redirect redirect-url)))

(ns clj-money.web.transactions
  (:refer-clojure :exclude [update])
  (:require [clojure.tools.logging :as log]
            [clojure.pprint :refer [pprint]]
            [environ.core :refer [env]]
            [hiccup.core :refer :all]
            [hiccup.page :refer :all]
            [ring.util.response :refer :all]
            [ring.util.codec :refer [url-encode]]
            [clj-time.core :as t]
            [clj-money.authorization :refer [authorize
                                             allowed?
                                             tag-resource
                                             apply-scope]]
            [clj-money.util :refer [ensure-local-date]]
            [clj-money.url :refer :all]
            [clj-money.coercion :as coercion]
            [clj-money.validation :as validation]
            [clj-money.pagination :as pagination]
            [clj-money.models.entities :as entities]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.permissions.transactions]
            [clj-money.web.money-shared :refer [grouped-options-for-accounts
                                                budget-monitors]]
            [clj-money.util :refer [format-date]])
  (:use [clj-money.web.shared :refer :all]))

(defmacro with-transactions-layout
  [page-title entity-or-id options & content]
  `(let [entity# (if (integer? ~entity-or-id)
                   (entities/find-by-id (env :db) ~entity-or-id)
                   ~entity-or-id)]
     (with-layout
       ~page-title (assoc ~options :side-bar (budget-monitors (:id entity#))
                          :entity entity#)
       ~@content)))

(defn- transaction-row
  "Renders a row in the transaction table"
  [transaction]
  [:tr
   [:td (format-date (:transaction-date transaction))]
   [:td (:description transaction)]
   [:td
    [:div.btn-group
     (when (allowed? :update transaction)
       (glyph-button :pencil
                     (format "/transactions/%s/edit" (:id transaction))
                     {:level :info
                      :size :extra-small
                      :title "Click here to edit this transaction."}))
     (when (allowed? :delete transaction)
       (let [can-delete? (transactions/can-delete? transaction)]
         (glyph-button :remove
                       (format "/transactions/%s/delete" (:id transaction))
                       {:level :danger
                        :disabled (not can-delete?)
                        :size :extra-small
                        :data-method :post
                        :data-confirm "Are you sure you want to delete this transaction?"
                        :title (if can-delete?
                                 "Click here to remove this transaction."
                                 "This transaction contains reconciled items and cannot be removed")})))]]])

(defn index
  ([req] (index req {}))
  ([{{entity-id :entity-id :as params} :params} options]
   (with-transactions-layout "Transactions" entity-id options
     (let [criteria (apply-scope {:entity-id entity-id} :transaction)
           transactions (transactions/search
                          (env :db)
                          criteria
                          (merge {:limit 100
                                  :sort [[:transaction-date :desc]]} ; TODO Need to get :limit and :per-page in sync
                                 (pagination/prepare-options params)))]
       (html
         [:table.table.table-striped
          [:tr
           [:th.col-sm-2 "Date"]
           [:th.col-sm-8 "Description"]
           [:th.col-sm-2 " "]]
          (map transaction-row transactions)]
         (pagination/nav (assoc params
                                :url (-> (path "/entities" entity-id "transactions"))
                                :total (transactions/record-count (env :db) criteria)))))
     (when (allowed? :create (-> {:entity-id entity-id}
                                 (tag-resource :transaction)))
       [:p
        [:a.btn.btn-primary
         {:href (str"/entities/" entity-id "/transactions/new")
          :title "Click here to enter a new transaction."}
         "Add"]]))))

(defn- item-row
  "Renders an individual row for a transaction item"
  [entity-id index item]
  [:tr
   [:td.col-sm-4
    (html
      (when-let [id (:id item)]
        (hidden-input-element (str "id-" index) id))
      (select-element (str "account-id-" index)
                      (:account-id item)
                      (grouped-options-for-accounts entity-id
                                                    {:include-none? true
                                                     :selected-id (:account-id item)})
                      {:suppress-label? true}))]
   [:td.col-sm-4
    (text-input-element (str "memo-" index) (:memo item) {:suppress-label? true}) ]
   [:td.col-sm-2
    (text-input-element (str "credit-amount-" index) (:credit-amount item) {:suppress-label? true})]
   [:td.col-sm-2
    (text-input-element (str "debit-amount-" index) (:debit-amount item) {:suppress-label? true})]])

(defn- ->form-item
  "Tranforms a transaction item as managed by the system into a
  item that can be used by the form"
  [transaction-item]
  (-> transaction-item
      (assoc :credit-amount (when (= :credit (:action transaction-item))
                              (:amount transaction-item))
             :debit-amount (when (= :debit (:action transaction-item))
                             (:amount transaction-item)))
      (dissoc :amount :action)))

(defn- ->transaction-item
  "Transforms a form item into a transaction item"
  [{:keys [credit-amount debit-amount] :as item}]
  (let [[action amount] (if (seq credit-amount)
                          [:credit (bigdec credit-amount)]
                          [:debit (bigdec debit-amount)])]
    (-> item
        (assoc :action action
               :amount amount)
        (dissoc :credit-amount :debit-amount))))

(defn- items-for-form
  [transaction]
  (map-indexed #(->> %2
                        ->form-item
                        (item-row (:entity-id transaction) %1))
               (concat (:items transaction)
                       (repeat {:action nil
                                :account-id nil
                                :amount nil}))))

(defn- form-fields
  [transaction back-url]
  (html
    [:div.row
     [:div.col-md-6
      (date-input-field transaction :transaction-date)]
     [:div.col-md-6
      (text-input-field transaction :description)]]
    [:div.row
     [:div.col-md-12
      (text-input-field transaction :memo)]]
    [:table.table.table-striped
     [:tr
      [:th "Account"]
      [:th "Memo"]
      [:th "Credit"]
      [:th "Debit"]]
     (take 10 (items-for-form transaction))]
    [:input.btn.btn-primary {:type :submit :value "Save"}]
    " "
    [:a.btn.btn-default
     {:href back-url
      :title "Click here to return to the list of transactions"}
     "Back"]))

(defn- validate-redirect-url
  [url]
  (when (and url (not (re-matches #"\Ahttps?:://" url)))
    url))

(defn- redirect-url
  [entity-id params]
  (or (validate-redirect-url (:redirect params))
      (format "/entities/%s/transactions" entity-id)))

(defn new-transaction
  ([{params :params}]
   (new-transaction params
                    (-> {:entity-id (:entity-id params)
                         :items [{:action :debit}
                                 {:action :credit}]
                         :transaction-date (t/today)}
                        (tag-resource :transaction)
                        (authorize :new))
                    {}))
  ([params transaction options]
   (with-transactions-layout "New Transaction" (:entity-id transaction) options
     (form (cond-> (path "/entities"
                         (:entity-id transaction)
                         "transactions")
             (contains? params :redirect) (query {:redirect (-> params
                                                                :redirect
                                                                url-encode)})
             true format-url) {}
           (form-fields transaction (redirect-url (:entity-id transaction) params))))))

(defn- valid-item?
  [{account-id :account-id :as item}]
  (or (integer? account-id)
      (and (string? account-id)
           (seq account-id))))

(defn- extract-items
  [params]
  (->> (iterate inc 0)
       (map (fn [index]
               (let [attr [:id :account-id :debit-amount :credit-amount :memo]
                     indexed-attr (map #(keyword (str (name %) "-" index)) attr)
                     item (zipmap attr (map #(% params) indexed-attr))]
                 item)))
       (take-while valid-item?)
       (map ->transaction-item)))

(defn create
  [{params :params}]
  (let [transaction (-> params
                        (assoc :items (extract-items params))
                        (select-keys [:entity-id :transaction-date :description :items :memo])
                        (update-in [:items] (partial map #(select-keys % [:account-id :action :amount :memo])))
                        (tag-resource :transaction)
                        (authorize :create))
        result (transactions/create (env :db) transaction)
        redirect-url (redirect-url (:entity-id result) params)]
    (if (validation/has-error? result)
      (new-transaction params result {})
      (redirect redirect-url))))

(defn edit
  ([req] (edit req {}))
  ([{params :params transaction :transaction} options]
   (let [id (:id params)
         transaction (or transaction
                         (authorize (transactions/find-by-id (env :db) id) :update))
         action (cond-> (path "/transactions"
                              (:id transaction))

                  (:redirect params)
                  (query {:redirect (url-encode (:redirect params))})

                  true
                  format-url)]
     (with-transactions-layout "New Transaction" (:entity-id transaction) options
       (form action {}
             (form-fields transaction (redirect-url (:entity-id transaction) params)))))))

(defn update
  [{params :params}]
  (let [transaction (authorize (transactions/find-by-id
                                 (env :db)
                                 (:id params)
                                 (ensure-local-date (:original-transaction-date params)))
                               :update)
        updated (merge transaction
                       (-> params
                           (select-keys [:id
                                         :transaction-date
                                         :original-transaction-date
                                         :description
                                         :memo])
                           (assoc :items (extract-items params))))
        result (transactions/update (env :db) updated)
        redirect-url (redirect-url (:entity-id result) params)]
    (if (validation/has-error? result)
      (edit result {:alerts [{:type :danger :message (str "Unable to save the transaction " (validation/error-messages updated))}]})
      (redirect redirect-url))))

(defn delete
  [{{id :id :as params} :params}]
  (let [transaction (authorize (transactions/find-by-id (env :db) id) :delete)
        redirect-url (redirect-url (:entity-id transaction) params)]
    (transactions/delete (env :db) id)
    (redirect redirect-url)))

refactor for readability

refactor for readability


(ns braid.core.client.ui.styles.thread
  (:require
   [braid.core.client.ui.styles.misc :refer [drag-and-drop]]
   [braid.core.client.ui.styles.mixins :as mixins]
   [braid.core.client.ui.styles.vars :as vars]
   [garden.arithmetic :as m]
   [garden.units :refer [px em rem]]))

(defn head [pad]
  [:>.head
   {:min-height "3.5em"
    :position "relative"
    :width "100%"
    :flex-shrink 0
    :padding [[pad (m/* 2 pad) pad pad]]
    :box-sizing "border-box"}

   [:>.tags
    {:display "inline"}

    [:>.add
     {:position "relative"}

     [:>span.pill
      mixins/pill-button
      {:letter-spacing "normal !important"}]

     [:>.tag-list
      {:position "absolute"
       :left "100%"
       :margin-left (em 0.5)
       :top "-0.5em"
       :background "white"
       :z-index 100
       :max-height (em 12)
       :overflow-x "auto"}
      (mixins/box-shadow)

      [:>.tag-option
       {:cursor "pointer"
        :white-space "nowrap"
        :padding (em 0.25)}

       [:&:hover
        {:background "#eee"}]

       [:>.rect
        {:width (em 1)
         :height (em 2)
         :display "inline-block"
         :vertical-align "middle"
         :border-radius (px 3)}]

       [:>span
        {:margin (rem 0.25)
         :display "inline-block"
         :vertical-align "middle"}]]]]

    [:>.user :>.tag :>.add
     {:display "inline-block"
      :vertical-align "middle"
      :margin-bottom (rem 0.25)
      :margin-right (rem 0.25)}]]

   [:>.controls
    {:position "absolute"
     :padding pad
     :top 0
     :right 0
     :z-index 10}

    [:>.extras
     {:display "none"}]

    [:&:hover>.extras
     {:display "block"}]

    [:>.main>.control
     :>.extras>.control
     {:cursor "pointer"
      :font-family "fontawesome"
      :text-align "center"
      :display "block"
      :text-decoration "none"
      :color "#CCC"
      :margin-bottom (m/* pad 0.5)
      ; needs to accomodate widest icon
      ; otherwise, x button moves
      :width "1.1em"}

     [:&:hover
      {:color "#333"}]]]])

(defn messages [pad]
  [:>.messages
   {:position "relative"
    :overflow-y "auto"
    :overflow-x "hidden"}])

(defn thread [pad]
  [:>.thread
   mixins/flex
   {:margin-right pad
    :min-width vars/card-width
    :width vars/card-width
    :box-sizing "border-box"
    :outline "none"
    :flex-direction "column"
    :height "100%"
    :z-index 101}

   [:&.new
    {:z-index 99}]

   ; switch to ::after to align at top
   [:&::before
    {:content "\"\""
     :flex-grow 1
     ; have 1px so card shadow shows
     :min-height "1px"}]

   ;; XXX: does this class actually apply to anything?
   [:&.archived :&.limbo :&.private
    [:>.head::before
     {:content "\"\""
      :display "block"
      :width "100%"
      :height (px 5)
      :position "absolute"
      :top 0
      :left 0
      :border-radius [[vars/border-radius
                       vars/border-radius 0 0]]}]

    [:&.archived
     [:.head::before
      {:background vars/archived-thread-accent-color}]]

    [:&.private
     [:.head::before
      {:background vars/private-thread-accent-color}]]

    [:&.limbo
     [:.head::before
      {:background vars/limbo-thread-accent-color}]]]

   [:&.focused
    [:>.card
     [:>.border
     (mixins/card-border "5px")]]]

   [:>.card
    mixins/flex
    {:flex-direction "column"
     :box-shadow [[0 (px 1) (px 4) 0 "#c3c3c3"]]
     :max-height "100%"
     :background "white"
     :border-radius [[vars/border-radius
                      vars/border-radius 0 0]]
     :position "relative"}

    (drag-and-drop pad)
    (head pad)
    (messages pad)]])

(defn notice [pad]
  [:>.thread
   [:>.notice
    {:box-shadow [[0 (px 1) (px 2) 0 "#ccc"]]
     :padding pad
     :margin-bottom pad}

    [:&::before
     {:float "left"
      :font-size vars/avatar-size
      :margin-right (rem 0.5)
      :content "\"\""}]]

   [:&.private :&.limbo
    [:>.card
     {; needs to be a better way
      ; which is based on the height of the notice
      :max-height "85%"}]]

   [:&.private
    [:>.notice
     {:background "#D2E7FF"
      :color vars/private-thread-accent-color}

     [:&::before
      (mixins/fontawesome \uf21b)]]]

   [:&.limbo
    [:>.notice
     {:background "#ffe4e4"
      :color vars/limbo-thread-accent-color}

     [:&::before
      (mixins/fontawesome \uf071)]]]])

(defn new-message [pad]
  [:>.message.new
   {:flex-shrink 0
    :padding pad
    :margin 0
    :position "relative"}

   [:>.plus
    {:border-radius vars/border-radius
     :text-align "center"
     :line-height (em 2)
     :position "absolute"
     :top 0
     :bottom 0
     :left 0
     :width vars/avatar-size
     :margin pad
     :cursor "pointer"
     :color "#e6e6e6"
     :box-shadow "0 0 1px 1px #e6e6e6"}

    [:&::after
     {:position "absolute"
      :top "50%"
      :left 0
      :width "100%"
      :margin-top (em -1)}
      (mixins/fontawesome \uf067)]

    [:&:hover
     {:color "#ccc"
      :box-shadow "0 0 1px 1px #ccc"}]

    [:&:active
     {:color "#999"
      :box-shadow "0 0 1px 1px #999"}]

    [:&.uploading::after
     (mixins/fontawesome \uf110)
     mixins/spin]]

   [:>.autocomplete-wrapper

    [:>textarea
     {:width "100%"
      :resize "none"
      :border "none"
      :box-sizing "border-box"
      :min-height (em 3.5)
      :padding-left (rem 2.5)}

     [:&:focus
      {:outline "none"}]]

    [:>.autocomplete
     {:z-index 1000
      :box-shadow [[0 (px 1) (px 4) 0 "#ccc"]]
      :background "white"
      :max-height (em 20)
      :overflow "auto"
      :width vars/card-width
      ; will be an issue when text area expands:
      :position "absolute"
      :bottom (m/* pad 3)}

     [:>.result
      {:padding "0.25em 0.5em"}

      [:>.match
       {:display "flex"}

       [:>.avatar
        :>.color-block
        {:display "block"
         :height "2em"
         :margin "0.25em 0.5em 0.25em 0"}]

       [:>.avatar
        {:width "2em"}]

       [:>.color-block
        {:width "1em"
         :border "3px solid #fff"
         :border-radius "3px"
         :box-sizing "border-box"}]

       [:>.info
        {:margin "0.25em 0"}

        [:>.name
         {:height "1em"
          :white-space "nowrap"}]

        [:>.extra
         {:color "#ccc"
          :overflow-y "hidden"
          :width "100%"
          :max-height "1em"}]]]

      [:&:hover
       {:background "#eee"}]

      [:&.highlight
       [:.name
        {:font-weight "bold"}]]]]]])

(ns braid.core.client.ui.styles.thread
  (:require
   [braid.core.client.ui.styles.misc :refer [drag-and-drop]]
   [braid.core.client.ui.styles.mixins :as mixins]
   [braid.core.client.ui.styles.vars :as vars]
   [garden.arithmetic :as m]
   [garden.units :refer [px em rem]]))

(defn head [pad]
  [:>.head
   {:min-height "3.5em"
    :position "relative"
    :width "100%"
    :flex-shrink 0
    :padding [[pad (m/* 2 pad) pad pad]]
    :box-sizing "border-box"}

   [:>.tags
    {:display "inline"}

    [:>.add
     {:position "relative"}

     [:>span.pill
      mixins/pill-button
      {:letter-spacing "normal !important"}]

     [:>.tag-list
      {:position "absolute"
       :left "100%"
       :margin-left (em 0.5)
       :top "-0.5em"
       :background "white"
       :z-index 100
       :max-height (em 12)
       :overflow-x "auto"}
      (mixins/box-shadow)

      [:>.tag-option
       {:cursor "pointer"
        :white-space "nowrap"
        :padding (em 0.25)}

       [:&:hover
        {:background "#eee"}]

       [:>.rect
        {:width (em 1)
         :height (em 2)
         :display "inline-block"
         :vertical-align "middle"
         :border-radius (px 3)}]

       [:>span
        {:margin (rem 0.25)
         :display "inline-block"
         :vertical-align "middle"}]]]]

    [:>.user :>.tag :>.add
     {:display "inline-block"
      :vertical-align "middle"
      :margin-bottom (rem 0.25)
      :margin-right (rem 0.25)}]]

   [:>.controls
    {:position "absolute"
     :padding pad
     :top 0
     :right 0
     :z-index 10}

    [:>.extras
     {:display "none"}]

    [:&:hover>.extras
     {:display "block"}]

    [:>.main>.control
     :>.extras>.control
     {:cursor "pointer"
      :font-family "fontawesome"
      :text-align "center"
      :display "block"
      :text-decoration "none"
      :color "#CCC"
      :margin-bottom (m/* pad 0.5)
      ; needs to accomodate widest icon
      ; otherwise, x button moves
      :width "1.1em"}

     [:&:hover
      {:color "#333"}]]]])

(defn messages [pad]
  [:>.messages
   {:position "relative"
    :overflow-y "auto"
    :overflow-x "hidden"}])

(defn thread [pad]
  [:>.thread
   mixins/flex
   {:margin-right pad
    :min-width vars/card-width
    :width vars/card-width
    :box-sizing "border-box"
    :outline "none"
    :flex-direction "column"
    :height "100%"
    :z-index 101}

   [:&.new
    {:z-index 99}]

   ; switch to ::after to align at top
   [:&::before
    {:content "\"\""
     :flex-grow 1
     ; have 1px so card shadow shows
     :min-height "1px"}]

   ;; XXX: does this class actually apply to anything?
   [:&.archived :&.limbo :&.private
    [:>.head::before
     {:content "\"\""
      :display "block"
      :width "100%"
      :height (px 5)
      :position "absolute"
      :top 0
      :left 0
      :border-radius [[vars/border-radius
                       vars/border-radius 0 0]]}]

    [:&.archived
     [:.head::before
      {:background vars/archived-thread-accent-color}]]

    [:&.private
     [:.head::before
      {:background vars/private-thread-accent-color}]]

    [:&.limbo
     [:.head::before
      {:background vars/limbo-thread-accent-color}]]]

   [:&.focused
    [:>.card
     [:>.border
      (mixins/card-border "5px")
      {:border-radius [[vars/border-radius 0 0 0]]}]]]

   [:>.card
    mixins/flex
    {:flex-direction "column"
     :box-shadow [[0 (px 1) (px 4) 0 "#c3c3c3"]]
     :max-height "100%"
     :background "white"
     :border-radius [[vars/border-radius
                      vars/border-radius 0 0]]
     :position "relative"}

    (drag-and-drop pad)
    (head pad)
    (messages pad)]])

(defn notice [pad]
  [:>.thread
   [:>.notice
    {:box-shadow [[0 (px 1) (px 2) 0 "#ccc"]]
     :padding pad
     :margin-bottom pad}

    [:&::before
     {:float "left"
      :font-size vars/avatar-size
      :margin-right (rem 0.5)
      :content "\"\""}]]

   [:&.private :&.limbo
    [:>.card
     {; needs to be a better way
      ; which is based on the height of the notice
      :max-height "85%"}]]

   [:&.private
    [:>.notice
     {:background "#D2E7FF"
      :color vars/private-thread-accent-color}

     [:&::before
      (mixins/fontawesome \uf21b)]]]

   [:&.limbo
    [:>.notice
     {:background "#ffe4e4"
      :color vars/limbo-thread-accent-color}

     [:&::before
      (mixins/fontawesome \uf071)]]]])

(defn new-message [pad]
  [:>.message.new
   {:flex-shrink 0
    :padding pad
    :margin 0
    :position "relative"}

   [:>.plus
    {:border-radius vars/border-radius
     :text-align "center"
     :line-height (em 2)
     :position "absolute"
     :top 0
     :bottom 0
     :left 0
     :width vars/avatar-size
     :margin pad
     :cursor "pointer"
     :color "#e6e6e6"
     :box-shadow "0 0 1px 1px #e6e6e6"}

    [:&::after
     {:position "absolute"
      :top "50%"
      :left 0
      :width "100%"
      :margin-top (em -1)}
      (mixins/fontawesome \uf067)]

    [:&:hover
     {:color "#ccc"
      :box-shadow "0 0 1px 1px #ccc"}]

    [:&:active
     {:color "#999"
      :box-shadow "0 0 1px 1px #999"}]

    [:&.uploading::after
     (mixins/fontawesome \uf110)
     mixins/spin]]

   [:>.autocomplete-wrapper

    [:>textarea
     {:width "100%"
      :resize "none"
      :border "none"
      :box-sizing "border-box"
      :min-height (em 3.5)
      :padding-left (rem 2.5)}

     [:&:focus
      {:outline "none"}]]

    [:>.autocomplete
     {:z-index 1000
      :box-shadow [[0 (px 1) (px 4) 0 "#ccc"]]
      :background "white"
      :max-height (em 20)
      :overflow "auto"
      :width vars/card-width
      ; will be an issue when text area expands:
      :position "absolute"
      :bottom (m/* pad 3)}

     [:>.result
      {:padding "0.25em 0.5em"}

      [:>.match
       {:display "flex"}

       [:>.avatar
        :>.color-block
        {:display "block"
         :height "2em"
         :margin "0.25em 0.5em 0.25em 0"}]

       [:>.avatar
        {:width "2em"}]

       [:>.color-block
        {:width "1em"
         :border "3px solid #fff"
         :border-radius "3px"
         :box-sizing "border-box"}]

       [:>.info
        {:margin "0.25em 0"}

        [:>.name
         {:height "1em"
          :white-space "nowrap"}]

        [:>.extra
         {:color "#ccc"
          :overflow-y "hidden"
          :width "100%"
          :max-height "1em"}]]]

      [:&:hover
       {:background "#eee"}]

      [:&.highlight
       [:.name
        {:font-weight "bold"}]]]]]])

Bring back rounded corner for thread border


(ns omlab.db.user-test
  (:require [clojure.test :refer [deftest testing is use-fixtures]]
            [conjure.core :refer [mocking stubbing instrumenting] :as c]
            [datomic.api :refer [q] :as d]
            [omlab.test :as t]
            [omlab.util :refer [has-keys?] :as util]
            [omlab.db.migration]
            [omlab.db.util :as db.util]
            [omlab.db.user :refer :all]))

(use-fixtures :once t/settings-fixture)
(use-fixtures :each (t/refresh-db-fixture "test/dtm/user-test-data.edn"))

(def extra-user-tx
  [{:db/id #db/id[:db.part/user]
    :user/username "extra"
    :user/password "xxx"
    :user/email "extra@omlab.user"
    :user/roles #{:omlab.auth/admin :omlab.auth/user}
    :user/type :user.type/system
    :user/name "Extra User"
    :user/optlock 0}])

(deftest user-lookup
  (testing "lookup missing user"
    (is (= nil (find-entity-id (t/db) "missing-user"))))
  (testing "lookup existing user"
    (let [res (find-entity-id (t/db) "root")]
      (is (not= nil res)))))

(deftest auth-creds
  (testing "no auth"
    (is (= nil (auth-credentials (t/db) "missing-user"))))
  (testing "root access"
    (is (= {:username "root", :password "$2a$10$erb66jCAhUc.5yNHY5XyxeCpLlbliRl3zdj5obVdZSCzaZS0u5Lm2", :roles #{:omlab.auth/admin}, :name "Omlab Administrator"}
           (auth-credentials (t/db) "root"))))
  (testing "multiple roles"
    (is (= nil
           (auth-credentials (:db-before (d/with (t/db) extra-user-tx)) "extra")))
    (is (= {:username "extra", :password "xxx", :roles #{:omlab.auth/admin :omlab.auth/user}, :name "Extra User"}
           (auth-credentials (:db-after (d/with (t/db) extra-user-tx)) "extra")))))

(deftest user-info
  (testing "missing user detail"
    (is (= nil (user-detail (t/db) "missing-user"))))
  (testing "user detail"
    (let [res (user-detail (t/db) "root")]
      (is (map? res))
      (is (has-keys? res :name :roles :username :name :email :type :mod-time))))
  (testing "user listing"
    (let [{:keys [db-before db-after]} (d/with (t/db) extra-user-tx)
          pres (list-users db-before)
          res (list-users db-after)]
      (is (= (inc (count pres)) (count res)))
      (is (every? #(has-keys? % :name :type :roles :email :username) res))
      (is (some #(and (= (:username %) "extra") (= (:roles %) #{:admin :user})) res))
      (is (distinct? (map :username res)))
      (is (= (sort (map :name res)) (map :name res))))))

(deftest user-changes
  (testing "adding user"
    (let [conn (t/conn)
          user {:username "extra"
                :email "extra@omlab.user"
                :name "Extra User"
                :type :system
                :roles #{:admin :user}}
          {:keys [db-before db-after]} (add-user conn {:username "root"} user)]
      (is (= (inc (count (list-users db-before))) (count (list-users db-after))))
      (is (thrown? Exception (add-user conn {:username "root"} user)))))
  (testing "updating user"
    (let [conn (t/conn)
          user {:username "root"
                :email "changed@his.email"
                :name "Rooted!"
                :type :operator
                :roles #{:user}
                :optlock 0}
          {:keys [db-before db-after]} (update-user conn {:username "root"} user)
          pdetail (user-detail db-before "root")
          detail (user-detail db-after "root")]
      (is (= (:username detail) (:username user)))
      (is (= (:email detail) (:email user)))
      (is (= (:name detail) (:name user)))
      (is (= (:type detail) (:type user)))
      (is (= (:roles detail) (:roles user)))
      (is (= (count (list-users db-before)) (count (list-users db-after))))
      (is (= (dissoc detail :mod-time :optlock)
             (dissoc (user-detail (:db-after (update-user conn {:username "root"}
                                                          (update-in user [:optlock] inc)))
                                  "root")
                     :mod-time :optlock))))))

(ns omlab.db.user-test
  (:require [clojure.test :refer [deftest testing is use-fixtures]]
            [conjure.core :refer [mocking stubbing instrumenting] :as c]
            [datomic.api :refer [q] :as d]
            [omlab.test :as t]
            [omlab.util :refer [has-keys?] :as util]
            [omlab.db.migration]
            [omlab.db.util :as db.util]
            [omlab.db.user :refer :all]))

(use-fixtures :once t/settings-fixture)
(use-fixtures :each (t/refresh-db-fixture "test/dtm/user-test-data.edn"))

(def extra-user-tx
  [{:db/id #db/id[:db.part/user]
    :user/username "extra"
    :user/password "xxx"
    :user/email "extra@omlab.user"
    :user/roles #{:omlab.auth/admin :omlab.auth/user}
    :user/type :user.type/system
    :user/name "Extra User"
    :user/optlock 0}])

(deftest user-lookup
  (testing "lookup missing user"
    (is (= nil (find-entity-id (t/db) "missing-user"))))
  (testing "lookup existing user"
    (let [res (find-entity-id (t/db) "root")]
      (is (not= nil res)))))

(deftest auth-creds
  (testing "no auth"
    (is (= nil (auth-credentials (t/db) "missing-user"))))
  (testing "root access"
    (is (= {:username "root", :password  "$2a$10$Hfb7nFYC8s7f7gX5wxsOZ.YvoFe7NVyc4jvOwITNR4ZDLNGOCO8Ci", :roles #{:omlab.auth/admin}, :name "Omlab Administrator"}
           (auth-credentials (t/db) "root"))))
  (testing "multiple roles"
    (is (= nil
           (auth-credentials (:db-before (d/with (t/db) extra-user-tx)) "extra")))
    (is (= {:username "extra", :password "xxx", :roles #{:omlab.auth/admin :omlab.auth/user}, :name "Extra User"}
           (auth-credentials (:db-after (d/with (t/db) extra-user-tx)) "extra")))))

(deftest user-info
  (testing "missing user detail"
    (is (= nil (user-detail (t/db) "missing-user"))))
  (testing "user detail"
    (let [res (user-detail (t/db) "root")]
      (is (map? res))
      (is (has-keys? res :name :roles :username :name :email :type :mod-time))))
  (testing "user listing"
    (let [{:keys [db-before db-after]} (d/with (t/db) extra-user-tx)
          pres (list-users db-before)
          res (list-users db-after)]
      (is (= (inc (count pres)) (count res)))
      (is (every? #(has-keys? % :name :type :roles :email :username) res))
      (is (some #(and (= (:username %) "extra") (= (:roles %) #{:admin :user})) res))
      (is (distinct? (map :username res)))
      (is (= (sort (map :name res)) (map :name res))))))

(deftest user-changes
  (testing "adding user"
    (let [conn (t/conn)
          user {:username "extra"
                :email "extra@omlab.user"
                :name "Extra User"
                :type :system
                :roles #{:admin :user}}
          {:keys [db-before db-after]} (add-user conn {:username "root"} user)]
      (is (= (inc (count (list-users db-before))) (count (list-users db-after))))
      (is (thrown? Exception (add-user conn {:username "root"} user)))))
  (testing "updating user"
    (let [conn (t/conn)
          user {:username "root"
                :email "changed@his.email"
                :name "Rooted!"
                :type :operator
                :roles #{:user}
                :optlock 0}
          {:keys [db-before db-after]} (update-user conn {:username "root"} user)
          pdetail (user-detail db-before "root")
          detail (user-detail db-after "root")]
      (is (= (:username detail) (:username user)))
      (is (= (:email detail) (:email user)))
      (is (= (:name detail) (:name user)))
      (is (= (:type detail) (:type user)))
      (is (= (:roles detail) (:roles user)))
      (is (= (count (list-users db-before)) (count (list-users db-after))))
      (is (= (dissoc detail :mod-time :optlock)
             (dissoc (user-detail (:db-after (update-user conn {:username "root"}
                                                          (update-in user [:optlock] inc)))
                                  "root")
                     :mod-time :optlock))))))

fix test password value

fix test password value


(ns clj.potoo.datomic-test
  (:require [clojure.test :refer :all]
            [potoo.datomic :refer :all]
            [datomic.api :as d]
            [clj-time.core :as t]
            [clj-time.coerce :as c]))

(defn create-test-db []
  (let [uri "datomic:mem://localhost:4334/test"
        _ (d/delete-database uri)
        datomic (new-empty-database uri)]
    (-> (.start datomic) :db-conn)))

(deftest user-tests
  (testing "creating a user"
    (let [conn (create-test-db)
          _    (create-user conn "Morty" "Morty")]
      (is (find-user-id conn "Morty"))
      (is (not (find-user-id conn "Rick"))))))

(deftest db-ops-test
  (testing "creating potoos"
    (let [conn (create-test-db)
          date (c/to-date (t/date-time 1986 10 14 4 3 27 456))
          _    (create-user conn "Morty" "Morty")
          _ (create-potoo conn "Foo Bar" "Morty" date)]
      (is (= #{["Foo Bar" "Morty" #inst "1986-10-14T04:03:27.456-00:00"]}
             (find-potoos conn)))))
  (testing "finding potoos for user"
    (let [conn (create-test-db)
          date (c/to-date (t/date-time 1986 10 14 4 3 27 456))
          _ (create-user conn "Morty" "")
          _ (create-user conn "Rick" "")
          _ (create-potoo conn "Foo" "Rick" date)
          _ (create-potoo conn "Bar" "Rick" date)
          _ (create-potoo conn "Bar" "Morty" date)]
      (is (= #{["Foo" #inst "1986-10-14T04:03:27.456-00:00"]
               ["Bar" #inst "1986-10-14T04:03:27.456-00:00"]}
             (find-potoos-for-user conn "Rick"))))))

(ns clj.potoo.datomic-test
  (:require [clojure.test :refer :all]
            [potoo.datomic :refer :all]
            [datomic.api :as d]
            [clj-time.core :as t]
            [clj-time.coerce :as c]))

(defn create-test-db []
  (let [uri "datomic:mem://localhost:4334/test"
        _ (d/delete-database uri)
        datomic (new-empty-database uri)]
    (-> (.start datomic) :db-conn)))

(deftest user-tests
  (testing "creating a user"
    (let [conn (create-test-db)
          _    (create-user conn "Morty" "Morty")]
      (is (find-user-id conn "Morty"))
      (is (not (find-user-id conn "Rick"))))))

(deftest db-ops-test
  (testing "creating potoos"
    (let [conn (create-test-db)
          date (c/to-date (t/date-time 1986 10 14 4 3 27 456))
          _    (create-user conn "Morty" "Morty")
          _ (create-potoo conn "Foo Bar" "Morty" date)]
      (is (= #{["Foo Bar" "Morty" #inst "1986-10-14T04:03:27.456-00:00"]}
             (find-potoos conn)))))
  (testing "finding potoos for user"
    (let [conn (create-test-db)
          date (c/to-date (t/date-time 1986 10 14 4 3 27 456))
          _ (create-user conn "Morty" "")
          _ (create-user conn "Rick" "")
          _ (create-potoo conn "Foo" "Rick" date)
          _ (create-potoo conn "Bar" "Rick" date)
          _ (create-potoo conn "Baz" "Morty" date)]
      (is (= #{["Foo" #inst "1986-10-14T04:03:27.456-00:00"]
               ["Bar" #inst "1986-10-14T04:03:27.456-00:00"]}
             (find-potoos-for-user conn "Rick"))))))

Make it Baz

Make it Baz


(ns reagent-tutorial.core
  (:require [clojure.string :as string]
            [reagent.core :as r]))

(enable-console-print!)

;; The "database" of your client side UI.
(def app-state
  (r/atom
   {:contacts
    [{:first "Ben" :last "Bitdiddle" :email "benb@mit.edu"}
     {:first "Alyssa" :middle-initial "P" :last "Hacker" :email "aphacker@mit.edu"}
     {:first "Eva" :middle "Lu" :last "Ator" :email "eval@mit.edu"}
     {:first "Louis" :last "Reasoner" :email "prolog@mit.edu"}
     {:first "Cy" :middle-initial "D" :last "Effect" :email "bugs@mit.edu"}
     {:first "Lem" :middle-initial "E" :last "Tweakit" :email "morebugs@mit.edu"}]}))

(defn update-contacts! [f & args]
  (apply swap! app-state update-in [:contacts] f args))

(defn add-contact! [c]
  (update-contacts! conj c))

(defn remove-contact! [c]
  (update-contacts! (fn [cs]
                      (vec (remove #(= % c) cs)))
                    c))

;; The next three fuctions are copy/pasted verbatim from the Om tutorial
(defn middle-name [{:keys [middle middle-initial]}]
  (cond
   middle (str " " middle)
   middle-initial (str " " middle-initial ".")))

(defn display-name [{:keys [first last] :as contact}]
  (str last ", " first (middle-name contact)))

(defn parse-contact [contact-str]
  (let [[first middle last :as parts] (string/split contact-str #"\s+")
        [first last middle] (if (nil? last) [first middle] [first last middle])
        middle (when middle (string/replace middle "." ""))
        c (if middle (count middle) 0)]
    (when (>= (reduce + (map #(if % 1 0) parts)) 2)
      (cond-> {:first first :last last}
        (== c 1) (assoc :middle-initial middle)
        (>= c 2) (assoc :middle middle)))))

;; UI components
(defn contact [c]
  [:li
   [:span (display-name c)]
   [:button {:on-click #(remove-contact! c)}
    "Delete"]])

(defn new-contact []
  (let [val (r/atom "")]
    (fn []
      [:div
       [:input {:type "text"
                :placeholder "Contact Name"
                :value @val
                :on-change #(reset! val (-> % .-target .-value))}]
       [:button {:on-click #(when-let [c (parse-contact @val)]
                              (add-contact! c)
                              (reset! val ""))}
        "Add"]])))

(defn contact-list []
  [:div
   [:h1 "Contact list"]
   [:ul
    (for [c (:contacts @app-state)]
      [contact c])]
   [new-contact]])

;; Render the root component
(defn start []
  (r/render-component
   [contact-list]
   (.getElementById js/document "root")))

(ns reagent-tutorial.core
  (:require [clojure.string :as string]
            [reagent.core :as r]))

(enable-console-print!)

;; The "database" of your client side UI.
(def app-state
  (r/atom
   {:contacts
    [{:first "Ben" :last "Bitdiddle" :email "benb@mit.edu"}
     {:first "Alyssa" :middle-initial "P" :last "Hacker" :email "aphacker@mit.edu"}
     {:first "Eva" :middle "Lu" :last "Ator" :email "eval@mit.edu"}
     {:first "Louis" :last "Reasoner" :email "prolog@mit.edu"}
     {:first "Cy" :middle-initial "D" :last "Effect" :email "bugs@mit.edu"}
     {:first "Lem" :middle-initial "E" :last "Tweakit" :email "morebugs@mit.edu"}]}))

(defn update-contacts! [f & args]
  (apply swap! app-state update-in [:contacts] f args))

(defn add-contact! [c]
  (update-contacts! conj c))

(defn remove-contact! [c]
  (update-contacts! (fn [cs]
                      (vec (remove #(= % c) cs)))
                    c))

;; The next three fuctions are copy/pasted verbatim from the Om tutorial
(defn middle-name [{:keys [middle middle-initial]}]
  (cond
   middle (str " " middle)
   middle-initial (str " " middle-initial ".")))

(defn display-name [{:keys [first last] :as contact}]
  (str last ", " first (middle-name contact)))

(defn parse-contact [contact-str]
  (let [[first middle last :as parts] (string/split contact-str #"\s+")
        [first last middle] (if (nil? last) [first middle] [first last middle])
        middle (when middle (string/replace middle "." ""))
        c (if middle (count middle) 0)]
    (when (>= (reduce + (map #(if % 1 0) parts)) 2)
      (cond-> {:first first :last last}
        (== c 1) (assoc :middle-initial middle)
        (>= c 2) (assoc :middle middle)))))

;; UI components
(defn contact [id c]
  [:li {:key id}
   [:span (display-name c)]
   [:button {:on-click #(remove-contact! c)}
    "Delete"]])

(defn new-contact []
  (let [val (r/atom "")]
    (fn []
      [:div
       [:input {:type "text"
                :placeholder "Contact Name"
                :value @val
                :on-change #(reset! val (-> % .-target .-value))}]
       [:button {:on-click #(when-let [c (parse-contact @val)]
                              (add-contact! c)
                              (reset! val ""))}
        "Add"]])))

(defn contact-list []
  [:div
   [:h1 "Contact list"]
   [:ul
    (map-indexed (fn [id element] (contact id element)) (:contacts @app-state))]
   [new-contact]])

;; Render the root component
(defn start []
  (r/render-component
   [contact-list]
   (.getElementById js/document "root")))

Add key to list

Add key to list