(ns cmr.search.data.query-to-elastic
  "Defines protocols and functions to map from a query model to elastic search query"
  (:require [clojure.string :as str]
            ;; require it so it will be available
            [cmr.search.data.query-order-by-expense]
            [cmr.common.services.errors :as errors]
            [cmr.search.data.keywords-to-elastic :as k2e]
            [clojurewerkz.elastisch.query :as eq]
            [cmr.common-app.services.search.query-model :as q]
            [cmr.common-app.services.search.query-order-by-expense :as query-expense]
            [cmr.common-app.services.search.query-to-elastic :as q2e]
            [cmr.common-app.services.search.complex-to-simple :as c2s]))

(defmethod q2e/concept-type->field-mappings :collection
  [_]
  {:provider :provider-id
   :version :version-id
   :project :project-sn2
   :project-sn :project-sn2
   :updated-since :revision-date2
   :two-d-coordinate-system-name :two-d-coord-name
   :platform :platform-sn
   :instrument :instrument-sn
   :sensor :sensor-sn
   :revision-date :revision-date2
   :mbr-north :mbr-north-doc-values
   :mbr-south :mbr-south-doc-values
   :mbr-east :mbr-east-doc-values
   :mbr-west :mbr-west-doc-values
   :lr-north :lr-north-doc-values
   :lr-south :lr-south-doc-values
   :lr-east :lr-east-doc-values
   :lr-west :lr-west-doc-values})

(defmethod q2e/concept-type->field-mappings :granule
  [_]
  {:granule-ur.lowercase :granule-ur.lowercase2
   :producer-gran-id.lowercase :producer-gran-id.lowercase2
   :provider :provider-id-doc-values
   :provider-id :provider-id-doc-values
   :collection-concept-id :collection-concept-id-doc-values
   :collection-concept-seq-id :collection-concept-seq-id-doc-values
   :concept-seq-id :concept-seq-id-doc-values
   :size :size-doc-values
   :start-date :start-date-doc-values
   :end-date :end-date-doc-values
   :revision-date :revision-date-doc-values
   :updated-since :revision-date-doc-values
   :producer-granule-id :producer-gran-id
   :platform :platform-sn
   :instrument :instrument-sn
   :sensor :sensor-sn
   :project :project-refs
   :day-night :day-night-doc-values
   :cloud-cover :cloud-cover-doc-values
   :mbr-north :mbr-north-doc-values
   :mbr-south :mbr-south-doc-values
   :mbr-east :mbr-east-doc-values
   :mbr-west :mbr-west-doc-values
   :lr-north :lr-north-doc-values
   :lr-south :lr-south-doc-values
   :lr-east :lr-east-doc-values
   :lr-west :lr-west-doc-values
   :orbit-start-clat :orbit-start-clat-doc-values
   :orbit-end-clat :orbit-end-clat-doc-values
   :orbit-asc-crossing-lon :orbit-asc-crossing-lon-doc-values
   :access-value :access-value-doc-values
   :start-coordinate-1 :start-coordinate-1-doc-values
   :end-coordinate-1 :end-coordinate-1-doc-values
   :start-coordinate-2 :start-coordinate-2-doc-values
   :end-coordinate-2 :end-coordinate-2-doc-values})

(defmethod q2e/elastic-field->query-field-mappings :collection
  [_]
  {:project-sn2 :project-sn
   :two-d-coord-name :two-d-coordinate-system-name
   :platform-sn :platform
   :instrument-sn :instrument
   :sensor-sn :sensor
   :revision-date2 :revision-date})

(defmethod q2e/elastic-field->query-field-mappings :granule
  [_]
  {:provider-id-doc-values :provider-id
   :collection-concept-id-doc-values :collection-concept-id
   :collection-concept-seq-id-doc-values :collection-concept-seq-id
   :concept-seq-id-doc-values :concept-seq-id
   :size-doc-values :size
   :start-date-doc-values :start-date
   :end-date-doc-values :end-date
   :revision-date-doc-values :revision-date
   :platform-sn :platform
   :instrument-sn :instrument
   :sensor-sn :sensor
   :project-refs :project
   :day-night-doc-values :day-night
   :cloud-cover-doc-values :cloud-cover
   :orbit-start-clat-doc-values :orbit-start-clat
   :orbit-end-clat-doc-values :orbit-end-clat
   :orbit-asc-crossing-lon-doc-values :orbit-asc-crossing-lon
   :access-value-doc-values :access-value
   :start-coordinate-1-doc-values :start-coordinate-1
   :end-coordinate-1-doc-values :end-coordinate-1
   :start-coordinate-2-doc-values :start-coordinate-2
   :end-coordinate-2-doc-values :end-coordinate-2})

(defmethod q2e/field->lowercase-field-mappings :collection
  [_]
  {:provider "provider-id.lowercase"
   :version "version-id.lowercase"
   :project "project-sn2.lowercase"
   :two-d-coordinate-system-name "two-d-coord-name.lowercase"
   :platform "platform-sn.lowercase"
   :instrument "instrument-sn.lowercase"
   :sensor "sensor-sn.lowercase"})

(defmethod q2e/field->lowercase-field-mappings :granule
  [_]
  {:provider "provider-id.lowercase-doc-values"
   :provider-id "provider-id.lowercase-doc-values"
   :granule-ur "granule-ur.lowercase2"
   :producer-gran-id "producer-gran-id.lowercase2"
   :producer-granule-id "producer-gran-id.lowercase2"
   :platform "platform-sn.lowercase-doc-values"
   :instrument "instrument-sn.lowercase-doc-values"
   :sensor "sensor-sn.lowercase-doc-values"
   :project "project-refs.lowercase-doc-values"})

(defn- keywords-in-condition
  "Returns a list of keywords if the condition contains a keyword condition or nil if not."
  [condition]
  (when (not= (type condition) cmr.common_app.services.search.query_model.NegatedCondition)
    (or (when (= :keyword (:field condition))
          (str/split (str/lower-case (:query-str condition)) #" "))
        ;; Call this function recursively on nested conditions, e.g., AND or OR conditions.
        (when-let [conds (:conditions condition)]
          (some #(keywords-in-condition %1) conds))
        ;; Call this function recursively for a single nested condition.
        (when-let [con (:condition condition)] (keywords-in-condition con)))))

(defn- keywords-in-query
  "Returns a list of keywords if the query contains a keyword condition or nil if not.
  Used to set sort and use function score for keyword queries."
  [query]
  (keywords-in-condition (:condition query)))

(defmethod q2e/query->elastic :collection
  [query]
  (let [boosts (:boosts query)
        {:keys [concept-type condition keywords]} (query-expense/order-conditions query)
        core-query (q2e/condition->elastic condition concept-type)]
    (if-let [keywords (keywords-in-query query)]
      ;; function_score query allows us to compute a custom relevance score for each document
      ;; matched by the primary query. The final document relevance is given by multiplying
      ;; a boosting term for each matching filter in a set of filters.
      {:function_score {:score_mode :multiply
                        :functions (k2e/keywords->boosted-elastic-filters keywords boosts)
                        :query {:filtered {:query (eq/match-all)
                                           :filter core-query}}}}
      (if boosts
        (errors/throw-service-errors :bad-request ["Relevance boosting is only supported for keyword queries"])
        {:filtered {:query (eq/match-all)
                    :filter core-query}}))))

(defmethod q2e/concept-type->sort-key-map :collection
  [_]
  {:entry-title :entry-title.lowercase
   :entry-id :entry-id.lowercase
   :provider :provider-id.lowercase
   :platform :platform-sn.lowercase
   :instrument :instrument-sn.lowercase
   :sensor :sensor-sn.lowercase
   :score :_score
   :revision-date :revision-date2})

(defmethod q2e/concept-type->sort-key-map :tag
  [_]
  {:namespace :namespace.lowercase
   :value :value.lowercase})

(defmethod q2e/concept-type->sort-key-map :granule
  [_]
  {:provider :provider-id.lowercase-doc-values
   :entry-title :entry-title.lowercase
   :short-name :short-name.lowercase
   :version :version-id.lowercase
   :granule-ur :granule-ur.lowercase2
   :producer-granule-id :producer-gran-id.lowercase2
   :readable-granule-name :readable-granule-name-sort2
   :data-size :size-doc-values
   :platform :platform-sn.lowercase-doc-values
   :instrument :instrument-sn.lowercase-doc-values
   :sensor :sensor-sn.lowercase-doc-values
   :project :project-refs.lowercase-doc-values})

(defmethod q2e/concept-type->sub-sort-fields :collection
  [_]
  [{(q2e/query-field->elastic-field :concept-seq-id :collection) {:order "asc"}}
   {(q2e/query-field->elastic-field :revision-id :collection) {:order "desc"}}])

(defmethod q2e/concept-type->sub-sort-fields :granule
  [_]
  [{(q2e/query-field->elastic-field :concept-seq-id :granule) {:order "asc"}}])

;; Collections will default to the keyword sort if they have no sort specified and search by keywords
(defmethod q2e/query->sort-params :collection
  [query]
  (let [{:keys [concept-type sort-keys]} query
        ;; If the sort keys are given as parameters then keyword-sort will not be used.
        keyword-sort (when (keywords-in-query query)
                       [{:_score {:order :desc}}])
        specified-sort (q2e/sort-keys->elastic-sort concept-type sort-keys)
        default-sort (q2e/sort-keys->elastic-sort concept-type (q/default-sort-keys concept-type))]
    (concat (or specified-sort keyword-sort default-sort) (q2e/concept-type->sub-sort-fields concept-type))))

(extend-protocol c2s/ComplexQueryToSimple
  cmr.search.models.query.CollectionQueryCondition
  (reduce-query-condition
    [condition context]
    (update-in condition [:condition] c2s/reduce-query-condition context)))

(ns cmr.search.data.query-to-elastic
  "Defines protocols and functions to map from a query model to elastic search query"
  (:require [clojure.string :as str]
            ;; require it so it will be available
            [cmr.search.data.query-order-by-expense]
            [cmr.common.services.errors :as errors]
            [cmr.search.data.keywords-to-elastic :as k2e]
            [clojurewerkz.elastisch.query :as eq]
            [cmr.common-app.services.search.query-model :as q]
            [cmr.common-app.services.search.query-order-by-expense :as query-expense]
            [cmr.common-app.services.search.query-to-elastic :as q2e]
            [cmr.common-app.services.search.complex-to-simple :as c2s]
            [cmr.common.config :refer [defconfig]]))

(defconfig use-doc-values-fields
  "Indicates whether search fields should use the doc-values fields or not. If false the field data
  cache fields will be used."
  {:type Boolean
   :default true})

(defmethod q2e/concept-type->field-mappings :collection
  [_]
  (let [default-mappings {:provider :provider-id
                          :version :version-id
                          :project :project-sn2
                          :project-sn :project-sn2
                          :updated-since :revision-date2
                          :two-d-coordinate-system-name :two-d-coord-name
                          :platform :platform-sn
                          :instrument :instrument-sn
                          :sensor :sensor-sn
                          :revision-date :revision-date2}]
    (if (use-doc-values-fields)
      (merge default-mappings
             {:mbr-north :mbr-north-doc-values
              :mbr-south :mbr-south-doc-values
              :mbr-east :mbr-east-doc-values
              :mbr-west :mbr-west-doc-values
              :lr-north :lr-north-doc-values
              :lr-south :lr-south-doc-values
              :lr-east :lr-east-doc-values
              :lr-west :lr-west-doc-values})
      default-mappings)))

(defmethod q2e/concept-type->field-mappings :granule
  [_]
  (let [default-mappings {:granule-ur.lowercase :granule-ur.lowercase2
                          :producer-gran-id.lowercase :producer-gran-id.lowercase2
                          :provider :provider-id
                          :updated-since :revision-date
                          :producer-granule-id :producer-gran-id
                          :platform :platform-sn
                          :instrument :instrument-sn
                          :sensor :sensor-sn
                          :project :project-refs}]
        (if (use-doc-values-fields)
          (merge default-mappings
                 {:provider :provider-id-doc-values
                  :provider-id :provider-id-doc-values
                  :concept-seq-id :concept-seq-id-doc-values
                  :collection-concept-id :collection-concept-id-doc-values
                  :collection-concept-seq-id :collection-concept-seq-id-doc-values
                  :size :size-doc-values
                  :start-date :start-date-doc-values
                  :end-date :end-date-doc-values
                  :revision-date :revision-date-doc-values
                  :updated-since :revision-date-doc-values
                  :day-night :day-night-doc-values
                  :cloud-cover :cloud-cover-doc-values
                  :mbr-north :mbr-north-doc-values
                  :mbr-south :mbr-south-doc-values
                  :mbr-east :mbr-east-doc-values
                  :mbr-west :mbr-west-doc-values
                  :lr-north :lr-north-doc-values
                  :lr-south :lr-south-doc-values
                  :lr-east :lr-east-doc-values
                  :lr-west :lr-west-doc-values
                  :orbit-start-clat :orbit-start-clat-doc-values
                  :orbit-end-clat :orbit-end-clat-doc-values
                  :orbit-asc-crossing-lon :orbit-asc-crossing-lon-doc-values
                  :access-value :access-value-doc-values
                  :start-coordinate-1 :start-coordinate-1-doc-values
                  :end-coordinate-1 :end-coordinate-1-doc-values
                  :start-coordinate-2 :start-coordinate-2-doc-values
                  :end-coordinate-2 :end-coordinate-2-doc-values})
          default-mappings)))

(defmethod q2e/elastic-field->query-field-mappings :collection
  [_]
  {:project-sn2 :project-sn
   :two-d-coord-name :two-d-coordinate-system-name
   :platform-sn :platform
   :instrument-sn :instrument
   :sensor-sn :sensor
   :revision-date2 :revision-date})

(defmethod q2e/elastic-field->query-field-mappings :granule
  [_]
  {:provider-id-doc-values :provider-id
   :collection-concept-id-doc-values :collection-concept-id
   :collection-concept-seq-id-doc-values :collection-concept-seq-id
   :concept-seq-id-doc-values :concept-seq-id
   :size-doc-values :size
   :start-date-doc-values :start-date
   :end-date-doc-values :end-date
   :revision-date-doc-values :revision-date
   :platform-sn :platform
   :instrument-sn :instrument
   :sensor-sn :sensor
   :project-refs :project
   :day-night-doc-values :day-night
   :cloud-cover-doc-values :cloud-cover
   :orbit-start-clat-doc-values :orbit-start-clat
   :orbit-end-clat-doc-values :orbit-end-clat
   :orbit-asc-crossing-lon-doc-values :orbit-asc-crossing-lon
   :access-value-doc-values :access-value
   :start-coordinate-1-doc-values :start-coordinate-1
   :end-coordinate-1-doc-values :end-coordinate-1
   :start-coordinate-2-doc-values :start-coordinate-2
   :end-coordinate-2-doc-values :end-coordinate-2})

(defmethod q2e/field->lowercase-field-mappings :collection
  [_]
  {:provider "provider-id.lowercase"
   :version "version-id.lowercase"
   :project "project-sn2.lowercase"
   :two-d-coordinate-system-name "two-d-coord-name.lowercase"
   :platform "platform-sn.lowercase"
   :instrument "instrument-sn.lowercase"
   :sensor "sensor-sn.lowercase"})

(defmethod q2e/field->lowercase-field-mappings :granule
  [_]
  (let [default-mappings
        {:granule-ur "granule-ur.lowercase2"
         :producer-gran-id "producer-gran-id.lowercase2"
         :producer-granule-id "producer-gran-id.lowercase2"}]
    (if (use-doc-values-fields)
      (merge default-mappings {:provider "provider-id.lowercase-doc-values"
                               :provider-id "provider-id.lowercase-doc-values"
                               :platform "platform-sn.lowercase-doc-values"
                               :instrument "instrument-sn.lowercase-doc-values"
                               :sensor "sensor-sn.lowercase-doc-values"
                               :project "project-refs.lowercase-doc-values"})
      default-mappings)))

(defn- keywords-in-condition
  "Returns a list of keywords if the condition contains a keyword condition or nil if not."
  [condition]
  (when (not= (type condition) cmr.common_app.services.search.query_model.NegatedCondition)
    (or (when (= :keyword (:field condition))
          (str/split (str/lower-case (:query-str condition)) #" "))
        ;; Call this function recursively on nested conditions, e.g., AND or OR conditions.
        (when-let [conds (:conditions condition)]
          (some #(keywords-in-condition %1) conds))
        ;; Call this function recursively for a single nested condition.
        (when-let [con (:condition condition)] (keywords-in-condition con)))))

(defn- keywords-in-query
  "Returns a list of keywords if the query contains a keyword condition or nil if not.
  Used to set sort and use function score for keyword queries."
  [query]
  (keywords-in-condition (:condition query)))

(defmethod q2e/query->elastic :collection
  [query]
  (let [boosts (:boosts query)
        {:keys [concept-type condition keywords]} (query-expense/order-conditions query)
        core-query (q2e/condition->elastic condition concept-type)]
    (if-let [keywords (keywords-in-query query)]
      ;; function_score query allows us to compute a custom relevance score for each document
      ;; matched by the primary query. The final document relevance is given by multiplying
      ;; a boosting term for each matching filter in a set of filters.
      {:function_score {:score_mode :multiply
                        :functions (k2e/keywords->boosted-elastic-filters keywords boosts)
                        :query {:filtered {:query (eq/match-all)
                                           :filter core-query}}}}
      (if boosts
        (errors/throw-service-errors :bad-request ["Relevance boosting is only supported for keyword queries"])
        {:filtered {:query (eq/match-all)
                    :filter core-query}}))))

(defmethod q2e/concept-type->sort-key-map :collection
  [_]
  {:entry-title :entry-title.lowercase
   :entry-id :entry-id.lowercase
   :provider :provider-id.lowercase
   :platform :platform-sn.lowercase
   :instrument :instrument-sn.lowercase
   :sensor :sensor-sn.lowercase
   :score :_score
   :revision-date :revision-date2})

(defmethod q2e/concept-type->sort-key-map :tag
  [_]
  {:namespace :namespace.lowercase
   :value :value.lowercase})

(defmethod q2e/concept-type->sort-key-map :granule
  [_]
  {:provider :provider-id.lowercase-doc-values
   :entry-title :entry-title.lowercase
   :short-name :short-name.lowercase
   :version :version-id.lowercase
   :granule-ur :granule-ur.lowercase2
   :producer-granule-id :producer-gran-id.lowercase2
   :readable-granule-name :readable-granule-name-sort2
   :data-size :size-doc-values
   :platform :platform-sn.lowercase-doc-values
   :instrument :instrument-sn.lowercase-doc-values
   :sensor :sensor-sn.lowercase-doc-values
   :project :project-refs.lowercase-doc-values})

(defmethod q2e/concept-type->sub-sort-fields :collection
  [_]
  [{(q2e/query-field->elastic-field :concept-seq-id :collection) {:order "asc"}}
   {(q2e/query-field->elastic-field :revision-id :collection) {:order "desc"}}])

(defmethod q2e/concept-type->sub-sort-fields :granule
  [_]
  [{(q2e/query-field->elastic-field :concept-seq-id :granule) {:order "asc"}}])

;; Collections will default to the keyword sort if they have no sort specified and search by keywords
(defmethod q2e/query->sort-params :collection
  [query]
  (let [{:keys [concept-type sort-keys]} query
        ;; If the sort keys are given as parameters then keyword-sort will not be used.
        keyword-sort (when (keywords-in-query query)
                       [{:_score {:order :desc}}])
        specified-sort (q2e/sort-keys->elastic-sort concept-type sort-keys)
        default-sort (q2e/sort-keys->elastic-sort concept-type (q/default-sort-keys concept-type))]
    (concat (or specified-sort keyword-sort default-sort) (q2e/concept-type->sub-sort-fields concept-type))))

(extend-protocol c2s/ComplexQueryToSimple
  cmr.search.models.query.CollectionQueryCondition
  (reduce-query-condition
    [condition context]
    (update-in condition [:condition] c2s/reduce-query-condition context)))

CMR-2397: Add configuration for using doc-values or not.


(ns degasolv.resolver.string-to-req-test
  (:require [clojure.test :refer :all]
            [degasolv.resolver :refer :all]))

(deftest ^:unit-tests test-string-to-requirement-basic-cases
  (testing "Basic case"
    (is (= [(present "a")]
           (string-to-requirement "a"))))
  (testing "Empty case"
    (is (= []
           (string-to-requirement ""))))
  (testing "Comparative cases"
    (is (= [(present "a"
                     [[(->VersionPredicate :less-than
                                           "1.0.0")]])]
           (string-to-requirement "a<1.0.0")))
    (is (= [(present "a"
                     [[(->VersionPredicate :less-equal
                                           "whatever")]])]
           (string-to-requirement "a<=whatever")))
    (is (= [(present "a"
                     [[(->VersionPredicate :not-equal
                                           "notvalidated")]])]
           (string-to-requirement "a!=notvalidated")))
    (is (= [(absent "z"
                    [[(->VersionPredicate :not-equal
                                          "0000")]])]
           (string-to-requirement
            "!z!=0000")))
    (is (= [(absent "z"
                    [[(->VersionPredicate :equal-to
                                          "alakazam")]])]
           (string-to-requirement
            "!z==alakazam")))
    (is (= [(absent
             "z"
             [[(->VersionPredicate :greater-equal
                                   "barbar")]])]
           (string-to-requirement "!z>=barbar")))
    (is (= [(present
             "x"
             [[(->VersionPredicate :greater-than
                                   "2.3.3")]])]
           (string-to-requirement "x>2.3.3"))))
  (testing "Matches cases"
    (is (= [(present
             "a"
             [[(->VersionPredicate :matches
                                   "f[ea]{2}ture")]])]
           (string-to-requirement "a<>f[ea]{2}ture"))))
  (testing "Range cases"
    (is (= [(present
             "a"
             [[(->VersionPredicate :in-range
                                   "3")]])]
           (string-to-requirement "a=>3")))))

(deftest ^:unit-tests test-string-to-requirement-illustrations
  (testing "Illustrative example"
    (is (= [(present "a"
                     [[(->VersionPredicate :greater-equal "3.0.0")
                       (->VersionPredicate :less-than "4.0.0")]
                      [(->VersionPredicate :greater-equal "2.0.0")
                       (->VersionPredicate :less-than "2.5.1")]])
            (present "b"
                     [[(->VersionPredicate :greater-equal
                                           "1.0.0")
                       (->VersionPredicate :not-equal
                                           "1.5.0")]])]
           (string-to-requirement
            "a>=3.0.0,<4.0.0;>=2.0.0,<2.5.1|b>=1.0.0,!=1.5.0"))))
  (testing "Managed dependencies"
    (is (= [(absent "a")
            (present "a"
                     [[(->VersionPredicate :greater-than "1.0.0")
                       (->VersionPredicate :less-equal "4.0.0")]
                      [(->VersionPredicate :greater-equal "6.0.0")
                       (->VersionPredicate :less-than "7.0.0")]])]
           (string-to-requirement
            "!a|a>1.0.0,<=4.0.0;>=6.0.0,<7.0.0")))))

(ns degasolv.resolver.string-to-req-test
  (:require [clojure.test :refer :all]
            [degasolv.resolver :refer :all]))

(deftest ^:unit-tests test-string-to-requirement-basic-cases
  (testing "Basic case"
    (is (= [(present "a")]
           (string-to-requirement "a"))))
  (testing "Empty case"
    (is (= []
           (string-to-requirement ""))))
  (testing "Comparative cases"
    (is (= [(present "a"
                     [[(->VersionPredicate :less-than
                                           "1.0.0")]])]
           (string-to-requirement "a<1.0.0")))
    (is (= [(present "a"
                     [[(->VersionPredicate :less-equal
                                           "whatever")]])]
           (string-to-requirement "a<=whatever")))
    (is (= [(present "a"
                     [[(->VersionPredicate :not-equal
                                           "notvalidated")]])]
           (string-to-requirement "a!=notvalidated")))
    (is (= [(absent "z"
                    [[(->VersionPredicate :not-equal
                                          "0000")]])]
           (string-to-requirement
            "!z!=0000")))
    (is (= [(absent "z"
                    [[(->VersionPredicate :equal-to
                                          "alakazam")]])]
           (string-to-requirement
            "!z==alakazam")))
    (is (= [(absent
             "z"
             [[(->VersionPredicate :greater-equal
                                   "barbar")]])]
           (string-to-requirement "!z>=barbar")))
    (is (= [(present
             "x"
             [[(->VersionPredicate :greater-than
                                   "2.3.3")]])]
           (string-to-requirement "x>2.3.3"))))
  (testing "Matches cases"
    (is (= [(present
             "a"
             [[(->VersionPredicate :matches
                                   "f[ea]{2}ture")]])]
           (string-to-requirement "a<>f[ea]{2}ture"))))
  (testing "Matching prints"
    (is (= "a<>f[ea]{2}ture"
           (str
            (present
             "a"
             [[(->VersionPredicate :matches
                                   "f[ea]{2}ture")]])))))
  (testing "Range cases"
    (is (= [(present
             "a"
             [[(->VersionPredicate :in-range
                                   "3")]])]
           (string-to-requirement "a=>3"))))
  (testing "Range prints"
    (is (= "a=>3"
           (str
            (present
             "a"
             [[(->VersionPredicate :in-range
                                   "3")]]))))))

(deftest ^:unit-tests test-string-to-requirement-illustrations
  (testing "Illustrative example"
    (is (= [(present "a"
                     [[(->VersionPredicate :greater-equal "3.0.0")
                       (->VersionPredicate :less-than "4.0.0")]
                      [(->VersionPredicate :greater-equal "2.0.0")
                       (->VersionPredicate :less-than "2.5.1")]])
            (present "b"
                     [[(->VersionPredicate :greater-equal
                                           "1.0.0")
                       (->VersionPredicate :not-equal
                                           "1.5.0")]])]
           (string-to-requirement
            "a>=3.0.0,<4.0.0;>=2.0.0,<2.5.1|b>=1.0.0,!=1.5.0"))))
  (testing "Managed dependencies"
    (is (= [(absent "a")
            (present "a"
                     [[(->VersionPredicate :greater-than "1.0.0")
                       (->VersionPredicate :less-equal "4.0.0")]
                      [(->VersionPredicate :greater-equal "6.0.0")
                       (->VersionPredicate :less-than "7.0.0")]])]
           (string-to-requirement
            "!a|a>1.0.0,<=4.0.0;>=6.0.0,<7.0.0")))))

Add tests to make sure printing worked

Add tests to make sure printing worked


(defn mix
  "Mix down (sum) a set of input channels into a single channel."
  [& inputs]
  (reduce overtone.ugen-collide/+ inputs))

(defn square
  "a square wave generator."
  [freq]
  (pulse freq 0.5))

(defn- splay-pan
  "Given n channels and a center point, returns a position in a stereo field
  for each channel, evenly distributed from the center +- spread."
  [n center spread]
  (for [i (range n)]
    (+ center
       (* spread
          (- (* i
                (/ 2 (dec n)))
             1)))))

(defn splay
  "Spread input channels across a stereo field, with control over the center point
  and spread width of the target field, and level compensation that lowers the volume
  for each additional input channel."
  [in-array & {:as options}]
  (with-ugens
    (let [options (merge {:spread 1 :level 1 :center 0 :level-comp true} options)
          {:keys [spread level center level-comp]} options
           n (count in-array)
          level (if level-comp
                  (* level (Math/sqrt (/ 1 (dec n))))
                  level)
          positions (splay-pan n center spread)
          pans (pan2 in-array positions level)]
      (map + (parallel-seqs pans)))))

(defn mix
  "Mix down (sum) a list of input channels into a single channel."
  [ins]
  (apply overtone.ugen-collide/+ ins))

(defn square
  "a square wave generator."
  [freq]
  (pulse freq 0.5))

(defn- splay-pan
  "Given n channels and a center point, returns a position in a stereo field
  for each channel, evenly distributed from the center +- spread."
  [n center spread]
  (for [i (range n)]
    (+ center
       (* spread
          (- (* i
                (/ 2 (dec n)))
             1)))))

(defn splay
  "Spread input channels across a stereo field, with control over the center point
  and spread width of the target field, and level compensation that lowers the volume
  for each additional input channel."
  [in-array & {:as options}]
  (with-ugens
    (let [options (merge {:spread 1 :level 1 :center 0 :level-comp true} options)
          {:keys [spread level center level-comp]} options
           n (count in-array)
          level (if level-comp
                  (* level (Math/sqrt (/ 1 (dec n))))
                  level)
          positions (splay-pan n center spread)
          pans (pan2 in-array positions level)]
      (map + (parallel-seqs pans)))))

change mix to apply + to a list of ins rather than the old impl which was equivalent to plain +


(ns com.farmlogs.conduit.subscription.ack-process-test
  (:require [clojure.test :refer :all]
            [com.farmlogs.conduit.subscription.ack-process :refer :all]
            [com.farmlogs.conduit.protocols :as p]
            [clojure.core.async :as a]))

(defn result
  [output result]
  (reify p/WorkerResult
    (-respond! [_ _ msg]
      (a/put! output [result msg]))))

(defn broken-result
  []
  (reify p/WorkerResult
    (-respond! [_ _ msg]
      (throw (ex-info "broken!"
                      {:msg msg})))))

(defn take-with-timeout
  [chan timeout-ms]
  (a/alt!!
    chan ([v] v)
    (a/timeout timeout-ms) ([v] ::timeout)))

(deftest test-ack-process
  (testing "Happy Path"
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan (a/chan 1)]

      (a/>!! input [result-chan :foo])
      (a/>!! result-chan (send-result :ack))
      (a/close! input)
      (is (= [:ack :foo] (take-with-timeout output 10)))
      (is (closed? ack-process))))

  (testing "All messages get ack'd even if ack input closes before worker result."
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan (a/chan 1)]

      (a/>!! input [result-chan :foo])
      (a/close! input)
      (is (not (closed? ack-process)))
      (a/>!! result-chan (send-result :ack))
      (is (= [:ack :foo] (take-with-timeout output 10)))
      (is (closed? ack-process))))

  (testing "Ack process keeps working if there's an exception in WorkerResult."
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan1 (a/chan 1)
          result-chan2 (a/chan 1)]

      (a/>!! input [result-chan1 :foo])
      (a/>!! input [result-chan2 :bar])
      (a/close! input)
      (is (not (closed? ack-process)))
      (a/>!! result-chan2 (broken-result))
      (a/>!! result-chan1 (send-result :ack))
      (is (= [:ack :foo] (take-with-timeout output 10)))
      (is (closed? ack-process)))))

(ns com.farmlogs.conduit.subscription.ack-process-test
  (:require [clojure.test :refer :all]
            [com.farmlogs.conduit.subscription.ack-process :refer :all]
            [com.farmlogs.conduit.protocols :as p]
            [clojure.core.async :as a]))

(defn result
  [output result]
  (reify p/WorkerResult
    (-respond! [_ _ msg]
      (a/put! output [result msg]))))

(defn broken-result
  []
  (reify p/WorkerResult
    (-respond! [_ _ msg]
      (throw (ex-info "broken!"
                      {:msg msg})))))

(defn take-with-timeout
  [chan timeout-ms]
  (a/alt!!
    chan ([v] v)
    (a/timeout timeout-ms) ([v] ::timeout)))

(deftest test-ack-process
  (testing "Happy Path"
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan (a/chan 1)]

      (a/>!! input [result-chan :foo])
      (a/>!! result-chan (send-result :ack))
      (a/close! input)
      (is (= [:ack :foo] (take-with-timeout output 10)))
      (is (nil? (a/<!! ack-process)))))

  (testing "Messages get the correct acknowledgement."
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan1 (a/chan 1)
          result-chan2 (a/chan 1)]

      (a/>!! input [result-chan1 :foo])
      (a/>!! input [result-chan2 :bar])
      (a/>!! result-chan1 (send-result :ack))
      (a/>!! result-chan2 (send-result :nack))
      (a/close! input)
      (is (nil? (a/<!! ack-process)))
      (a/close! output)
      (is (= #{[:ack :foo] [:nack :bar]}
             (a/<!! (a/into #{} output))))))

  (testing "All messages get ack'd even if ack input closes before worker result."
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan (a/chan 1)]

      (a/>!! input [result-chan :foo])
      (a/close! input)
      (is (= ::timeout (take-with-timeout ack-process 10)))
      (a/>!! result-chan (send-result :ack))
      (is (= [:ack :foo] (take-with-timeout output 10)))
      (is (nil? (a/<!! ack-process)))))

  (testing "Ack process keeps working if there's an exception in WorkerResult."
    (let [input (a/chan 1)
          ack-process (ack-process input nil)
          output (a/chan 1)
          send-result (partial result output)
          result-chan1 (a/chan 1)
          result-chan2 (a/chan 1)]

      (a/>!! input [result-chan1 :foo])
      (a/>!! input [result-chan2 :bar])
      (a/close! input)
      (is (= ::timeout (take-with-timeout ack-process 10)))
      (a/>!! result-chan2 (broken-result))
      (a/>!! result-chan1 (send-result :ack))
      (is (= [:ack :foo] (take-with-timeout output 10)))
      (is (nil? (a/<!! ack-process))))))

Make ack-process tests more reliable

Make ack-process tests more reliable

- There were intermittent false failures when using timeouts
- Add a test to help ensure that messages get the proper acknowledgment


;;   Copyright (c) Nicola Mometto, Rich Hickey & contributors.
;;   The use and distribution terms for this software are covered by the
;;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;;   which can be found in the file epl-v10.html at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be bound by
;;   the terms of this license.
;;   You must not remove this notice, or any other, from this software.

(ns ^{:doc "Protocols and default Reader types implementation"
      :author "Bronsa"}
  clojure.tools.reader.reader-types
  (:refer-clojure :exclude [char read-line])
  (:use clojure.tools.reader.impl.utils)
  (:import clojure.lang.LineNumberingPushbackReader
           (java.io InputStream BufferedReader)))

(defmacro ^:private update! [what f]
  (list 'set! what (list f what)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reader protocols
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol Reader
  (read-char [reader]
    "Returns the next char from the Reader, nil if the end of stream has been reached")
  (peek-char [reader]
    "Returns the next char from the Reader without removing it from the reader stream"))

(defprotocol IPushbackReader
  (unread [reader ch]
    "Pushes back a single character on to the stream"))

(defprotocol IndexingReader
  (get-line-number [reader]
    "Returns the line number of the next character to be read from the stream")
  (get-column-number [reader]
    "Returns the line number of the next character to be read from the stream")
  (get-file-name [reader]
    "Returns the file name the reader is reading from, or nil"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reader deftypes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deftype StringReader
    [^String s s-len ^:unsynchronized-mutable s-pos]
  Reader
  (read-char [reader]
    (when (> s-len s-pos)
      (let [r (nth s s-pos)]
        (update! s-pos inc)
        r)))
  (peek-char [reader]
    (when (> s-len s-pos)
      (nth s s-pos))))

(deftype InputStreamReader [^InputStream is ^:unsynchronized-mutable ^"[B" buf]
  Reader
  (read-char [reader]
    (if buf
      (let [c (aget buf 0)]
        (set! buf nil)
        (char c))
      (let [c (.read is)]
        (when (>= c 0)
          (char c)))))
  (peek-char [reader]
    (when-not buf
      (set! buf (byte-array 1))
      (when (== -1 (.read is buf))
        (set! buf nil)))
    (when buf
      (char (aget buf 0)))))

(deftype PushbackReader
    [rdr ^"[Ljava.lang.Object;" buf buf-len ^:unsynchronized-mutable buf-pos]
  Reader
  (read-char [reader]
    (char
     (if (< buf-pos buf-len)
       (let [r (aget buf buf-pos)]
         (update! buf-pos inc)
         r)
       (read-char rdr))))
  (peek-char [reader]
    (char
     (if (< buf-pos buf-len)
       (aget buf buf-pos)
       (peek-char rdr))))
  IPushbackReader
  (unread [reader ch]
    (when ch
      (if (zero? buf-pos) (throw (RuntimeException. "Pushback buffer is full")))
      (update! buf-pos dec)
      (aset buf buf-pos ch))))

(defn- normalize-newline [rdr ch]
  (if (identical? \return ch)
    (let [c (peek-char rdr)]
      (when (or (identical? \formfeed c)
                (identical? \newline c))
        (read-char rdr))
      \newline)
    ch))

(deftype IndexingPushbackReader
    [rdr ^:unsynchronized-mutable line ^:unsynchronized-mutable column
     ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev
     ^:unsynchronized-mutable prev-column file-name]
  Reader
  (read-char [reader]
    (when-let [ch (read-char rdr)]
      (let [ch (normalize-newline rdr ch)]
        (set! prev line-start?)
        (set! line-start? (newline? ch))
        (when line-start?
          (set! prev-column column)
          (set! column 0)
          (update! line inc))
        (update! column inc)
        ch)))

  (peek-char [reader]
    (peek-char rdr))

  IPushbackReader
  (unread [reader ch]
    (if line-start?
      (do (update! line dec)
          (set! column prev-column))
      (update! column dec))
    (set! line-start? prev)
    (unread rdr ch))

  IndexingReader
  (get-line-number [reader] (int line))
  (get-column-number [reader] (int column))
  (get-file-name [reader] file-name))

(extend-type java.io.PushbackReader
  Reader
  (read-char [rdr]
    (let [c (.read ^java.io.PushbackReader rdr)]
      (when (>= c 0)
        (normalize-newline rdr (char c)))))

  (peek-char [rdr]
    (when-let [c (read-char rdr)]
      (unread rdr c)
      c))

  IPushbackReader
  (unread [rdr c]
    (when c
      (.unread ^java.io.PushbackReader rdr (int c)))))

(extend LineNumberingPushbackReader
  IndexingReader
  {:get-line-number (fn [rdr] (.getLineNumber ^LineNumberingPushbackReader rdr))
   :get-column-number (compile-if >=clojure-1-5-alpha*?
                        (fn [rdr]
                          (.getColumnNumber ^LineNumberingPushbackReader rdr))
                        (fn [rdr] 0))
   :get-file-name (constantly nil)})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Source Logging support
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn merge-meta
  "Returns an object of the same type and value as `obj`, with its
metadata merged over `m`."
  [obj m]
  (let [orig-meta (meta obj)]
    (with-meta obj (merge m (dissoc orig-meta :source)))))

(defn- peek-source-log
  "Returns a string containing the contents of the top most source
logging frame."
  [source-log-frames]
  (let [current-frame @source-log-frames]
    (.substring ^StringBuilder (:buffer current-frame) (:offset current-frame))))

(defn- log-source-char
  "Logs `char` to all currently active source logging frames."
  [source-log-frames char]
  (when-let [^StringBuilder buffer (:buffer @source-log-frames)]
    (.append buffer char)))

(defn- drop-last-logged-char
  "Removes the last logged character from all currently active source
logging frames. Called when pushing a character back."
  [source-log-frames]
  (when-let [^StringBuilder buffer (:buffer @source-log-frames)]
    (.deleteCharAt buffer (dec (.length buffer)))))

(deftype SourceLoggingPushbackReader
    [rdr ^:unsynchronized-mutable line ^:unsynchronized-mutable column
     ^:unsynchronized-mutable line-start? ^:unsynchronized-mutable prev
     ^:unsynchronized-mutable prev-column file-name source-log-frames]
  Reader
  (read-char [reader]
    (when-let [ch (read-char rdr)]
      (let [ch (normalize-newline rdr ch)]
        (set! prev line-start?)
        (set! line-start? (newline? ch))
        (when line-start?
          (set! prev-column column)
          (set! column 0)
          (update! line inc))
        (update! column inc)
        (log-source-char source-log-frames ch)
        ch)))

  (peek-char [reader]
    (peek-char rdr))

  IPushbackReader
  (unread [reader ch]
    (if line-start?
      (do (update! line dec)
          (set! column prev-column))
      (update! column dec))
    (set! line-start? prev)
    (when ch
      (drop-last-logged-char source-log-frames))
    (unread rdr ch))

  IndexingReader
  (get-line-number [reader] (int line))
  (get-column-number [reader] (int column))
  (get-file-name [reader] file-name))

(defn log-source*
  [reader f unread?]
  (let [frame (.source-log-frames ^SourceLoggingPushbackReader reader)
        ^StringBuilder buffer (:buffer @frame)
        new-frame (assoc-in @frame [:offset] (+ (.length buffer) (if unread? -1 0)))]
    (with-bindings {frame new-frame}
      (let [ret (f)]
        (if (instance? clojure.lang.IMeta ret)
          (merge-meta ret {:source (peek-source-log frame)})
          ret)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; fast check for provided implementations
(defn indexing-reader?
  "Returns true if the reader satisfies IndexingReader"
  [rdr]
  (or (instance? clojure.tools.reader.reader_types.IndexingReader rdr)
      (instance? LineNumberingPushbackReader rdr)
      (and (not (instance? clojure.tools.reader.reader_types.PushbackReader rdr))
           (not (instance? clojure.tools.reader.reader_types.StringReader rdr))
           (not (instance? clojure.tools.reader.reader_types.InputStreamReader rdr))
           (get (:impls IndexingReader) (class rdr)))))

(defn string-reader
  "Creates a StringReader from a given string"
  ([^String s]
     (StringReader. s (count s) 0)))

(defn string-push-back-reader
  "Creates a PushbackReader from a given string"
  ([s]
     (string-push-back-reader s 1))
  ([^String s buf-len]
     (PushbackReader. (string-reader s) (object-array buf-len) buf-len buf-len)))

(defn input-stream-reader
  "Creates an InputStreamReader from an InputStream"
  [is]
  (InputStreamReader. is nil))

(defn input-stream-push-back-reader
  "Creates a PushbackReader from a given InputStream"
  ([is]
     (input-stream-push-back-reader is 1))
  ([^InputStream is buf-len]
     (PushbackReader. (input-stream-reader is) (object-array buf-len) buf-len buf-len)))

(defn indexing-push-back-reader
  "Creates an IndexingPushbackReader from a given string or PushbackReader"
  ([s-or-rdr]
     (indexing-push-back-reader s-or-rdr 1))
  ([s-or-rdr buf-len]
     (indexing-push-back-reader s-or-rdr buf-len nil))
  ([s-or-rdr buf-len file-name]
     (IndexingPushbackReader.
      (if (string? s-or-rdr) (string-push-back-reader s-or-rdr buf-len) s-or-rdr) 1 1 true nil 0 file-name)))

(defn source-logging-push-back-reader
  "Creates a SourceLoggingPushbackReader from a given string or PushbackReader"
  ([s-or-rdr]
     (source-logging-push-back-reader s-or-rdr 1))
  ([s-or-rdr buf-len]
     (source-logging-push-back-reader s-or-rdr buf-len nil))
  ([s-or-rdr buf-len file-name]
     (SourceLoggingPushbackReader.
      (if (string? s-or-rdr) (string-push-back-reader s-or-rdr buf-len) s-or-rdr)
      1
      1
      true
      nil
      0
      file-name
      (doto (make-var)
        (alter-var-root (constantly {:buffer (StringBuilder.)
                                     :offset 0}))))))

(defn read-line
  "Reads a line from the reader or from *in* if no reader is specified"
  ([] (read-line *in*))
  ([rdr]
     (if (or (instance? LineNumberingPushbackReader rdr)
             (instance? BufferedReader rdr))
       (binding [*in* rdr]
         (clojure.core/read-line))
       (loop [c (read-char rdr) s (StringBuilder.)]
         (if (newline? c)
           (str s)
           (recur (read-char rdr) (.append s c)))))))

(defn reader-error
  "Throws an ExceptionInfo with the given message.
   If rdr is an IndexingReader, additional information about column and line number is provided"
  [rdr & msg]
  (throw (ex-info (apply str msg)
                  (merge {:type :reader-exception}
                         (when (indexing-reader? rdr)
                           (merge
                            {:line (get-line-number rdr)
                             :column (get-column-number rdr)}
                            (when-let [file-name (get-file-name rdr)]
                              {:file file-name})))))))

(defn source-logging-reader?
  [rdr]
  (instance? SourceLoggingPushbackReader rdr))

(defmacro log-source
  "If reader is a SourceLoggingPushbackReader, execute body in a source
  logging context. Otherwise, execute body, returning the result."
  [reader & body]
  `(if (and (source-logging-reader? ~reader)
            (not (whitespace? (peek-char ~reader))))
     (log-source* ~reader (^{:once true} fn* [] ~@body) false)
     (do ~@body)))

(defmacro log-source-unread
  "If reader is a SourceLoggingPushbackReader, execute body in a source
  logging context. Otherwise, execute body, returning the result."
  [reader & body]
  `(if (and (source-logging-reader? ~reader)
            (not (whitespace? (peek-char ~reader))))
     (log-source* ~reader (^{:once true} fn* [] ~@body) true)
     (do ~@body)))

(defn line-start?
  "Returns true if rdr is an IndexingReader and the current char starts a new line"
  [rdr]
  (when (indexing-reader? rdr)
    (zero? (get-column-number rdr))))

add line-start?

add line-start?


(ns ring.middleware.incise
  (:require [clojure.java.io :refer [file]]
            [incise.parsers.core :refer [parse]])
  (:import [java.io File]))

(defn- gitignore-file? [^File file]
  (= (.getName file) ".gitignore"))

(defn- delete-recursively
  "Delete a directory tree."
  [^File root]
  (when (.isDirectory root)
    (doseq [file (remove gitignore-file? (.listFiles root))]
      (delete-recursively file)))
  (.delete root))

(def ^:private file-modification-times (atom {}))

(defn- modified?
  "If file is not in atom or it's modification date has advanced."
  [^File a-file]
  (let [previous-modification-time (@file-modification-times a-file)
        last-modification-time (.lastModified a-file)]
    (swap! file-modification-times assoc a-file (.lastModified a-file))
    (or (nil? previous-modification-time)
        (< previous-modification-time last-modification-time))))

(defn wrap-incise
  "Call parse on each modified file in the given dir with each request."
  [handler & {:keys [in out]}]
  (let [orig-out *out*
        orig-err *err*]
    (delete-recursively (file out))
    (fn [request]
      (binding [*out* orig-out
                *err* orig-err]
        (->> in
             (file)
             (file-seq)
             (filter modified?)
             (map parse)
             (dorun)))
      (handler request))))

(ns ring.middleware.incise
  (:require [clojure.java.io :refer [file]]
            [ns-tracker.core :refer [ns-tracker]]
            [incise.parsers.core :refer [parse]])
  (:import [java.io File]))

(defn- gitignore-file? [^File file]
  (= (.getName file) ".gitignore"))

(defn- delete-recursively
  "Delete a directory tree."
  [^File root]
  (when (.isDirectory root)
    (doseq [file (remove gitignore-file? (.listFiles root))]
      (delete-recursively file)))
  (.delete root))

(def ^:private file-modification-times (atom {}))

(defn- modified?
  "If file is not in atom or it's modification date has advanced."
  [^File a-file]
  (let [previous-modification-time (@file-modification-times a-file)
        last-modification-time (.lastModified a-file)]
    (swap! file-modification-times assoc a-file (.lastModified a-file))
    (or (nil? previous-modification-time)
        (< previous-modification-time last-modification-time))))

(defn wrap-incise-parse
  "Call parse on each modified file in the given dir with each request."
  [handler & {:keys [in out]}]
  (let [orig-out *out*
        orig-err *err*]
    (delete-recursively (file out))
    (fn [request]
      (binding [*out* orig-out
                *err* orig-err]
        (->> in
             (file)
             (file-seq)
             (filter modified?)
             (map parse)
             (dorun)))
      (handler request))))

(defn wrap-reset-modified-files-with-source-change
  "An almost copy of wrap-reload, but instead of reloading modified files this
   ensurs that the next time parse is called all content files are reparsed.

   Takes the following options:
     :dirs - A list of directories that contain the source files.
             Defaults to [\"src\"]."
  [handler & [options]]
  (let [source-dirs (:dirs options ["src"])
        modified-namespaces (ns-tracker source-dirs)]
    (fn [request]
      (when-not (empty? (modified-namespaces))
        (reset! file-modification-times {}))
      (handler request))))

(defn wrap-incise
  [handler & args]
  (-> (apply wrap-incise-parse handler args)
      (wrap-reset-modified-files-with-source-change)))

Add wrap-reset-modified-files-with-source-change middleware.


(defproject {{name}} "0.1.0-SNAPSHOT"
  :description "FIXME: HTTP API gateway for ..."
  :url "https://github.com/democracyworks/{{name}}"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [org.clojure/tools.logging "0.3.1"]
                 [turbovote.resource-config "0.2.0"]
                 [com.novemberain/langohr "3.3.0"]
                 [prismatic/schema "0.4.3"]
                 [ch.qos.logback/logback-classic "1.1.3"]

                 [io.pedestal/pedestal.service "0.4.0"]
                 [io.pedestal/pedestal.service-tools "0.4.0"]
                 [democracyworks/pedestal-toolbox "0.6.1"]

                 ;; this has to go before pedestal.immutant
                 ;; until this is fixed:
                 ;; https://github.com/pedestal/pedestal/issues/33
                 [org.immutant/web "2.0.2"]
                 [io.pedestal/pedestal.immutant "0.4.0"]
                 [org.immutant/core "2.0.2"]

                 [democracyworks/kehaar "0.5.0"]]
  :plugins [[lein-immutant "2.0.0"]]
  :main ^:skip-aot {{name}}.server
  :target-path "target/%s"
  :repositories {"my.datomic.com" {:url "https://my.datomic.com/repo"
                                   :username [:gpg :env]
                                   :password [:gpg :env]}}
  :uberjar-name "{{name}}.jar"
  :profiles {:uberjar {:aot :all}
             :dev-common {:resource-paths ["dev-resources"]}
             :dev-overrides {}
             :dev [:dev-common :dev-overrides]})

(defproject {{name}} "0.1.0-SNAPSHOT"
  :description "FIXME: HTTP API gateway for ..."
  :url "https://github.com/democracyworks/{{name}}"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [org.clojure/tools.logging "0.3.1"]
                 [turbovote.resource-config "0.2.0"]
                 [com.novemberain/langohr "3.3.0"]
                 [prismatic/schema "0.4.3"]
                 [ch.qos.logback/logback-classic "1.1.3"]

                 [io.pedestal/pedestal.service "0.4.0"]
                 [io.pedestal/pedestal.service-tools "0.4.0"]
                 [democracyworks/pedestal-toolbox "0.6.1"]

                 ;; this has to go before pedestal.immutant
                 ;; until this is fixed:
                 ;; https://github.com/pedestal/pedestal/issues/33
                 [org.immutant/web "2.0.2"]
                 [io.pedestal/pedestal.immutant "0.4.0"]
                 [org.immutant/core "2.0.2"]

                 [democracyworks/kehaar "0.5.0"]]
  :plugins [[lein-immutant "2.0.0"]]
  :main ^:skip-aot {{name}}.server
  :target-path "target/%s"
  :repositories {"my.datomic.com" {:url "https://my.datomic.com/repo"
                                   :username [:gpg :env]
                                   :password [:gpg :env]}}
  :uberjar-name "{{name}}.jar"
  :profiles {:uberjar {:aot :all}
             :dev {:resource-paths ["dev-resources"]}
             :test {:dependencies [[clj-http "2.0.0"]]
                    :jvm-opts ["-Dlog-level=INFO"]}})

update lein profiles

[WM] update lein profiles


(ns figwheel-sidecar.build-middleware.javascript-reloading
  (:require
   [clojure.java.io :as io]
   [cljs.build.api :as bapi]
   [figwheel-sidecar.utils :as utils]
   [clojure.pprint :as pp]))

;; live javascript reloading

;; extremely tenuous relationship, this could break easily
;; file-path is a string and it is an absolute path
(defn cljs-target-file-from-foreign [output-dir file-path]
  (first (filter #(.exists %)
                 ;; try the projected location
                 [(io/file output-dir (utils/relativize-local file-path))
                  (io/file output-dir (.getName (io/file file-path)))])))

(defn closure-lib-target-file-for-ns [output-dir namesp]
  (let [path (cljs.closure/lib-rel-path {:provides [namesp]})]
    (io/file output-dir path)))

(defn safe-js->ns [foreign-libs file-path]
  (:provides
   ;; first check if a foreign-lib addresses this file
   (or (some->> foreign-libs
                (filter #(.endsWith file-path (:file %)))
                first)
       (try (bapi/parse-js-ns file-path)
            (catch Throwable e
              ;; couldn't parse js for namespace
              {})))))

(defn best-try-js-ns [state foreign-libs js-file-path]
  (let [provs (and (.exists (io/file js-file-path))
                   (safe-js->ns foreign-libs js-file-path))]
    (if-not (empty? provs)
      provs
      (if-let [out-file (cljs-target-file-from-foreign (:output-dir state) js-file-path)]
        (and (.exists out-file)
             (safe-js->ns foreign-libs out-file))))))

(defn js-file->namespaces [{:keys [foreign-libs output-dir] :as state} js-file-path]
  (best-try-js-ns state foreign-libs js-file-path))

(defn hook [build-fn]
  (fn [{:keys [figwheel-server build-config changed-files] :as build-state}]
    (if-let [changed-js-files (filter #(.endsWith % ".js") changed-files)]
      (let [build-options (or (:build-options build-config) (:compiler build-config))
            additional-changed-ns ;; add in js namespaces
            (mapcat (partial js-file->namespaces build-options)
                    changed-js-files)]
        (build-fn (update-in
                   build-state [:additional-changed-ns] concat additional-changed-ns)))
      (build-fn build-state))))

(ns figwheel-sidecar.build-middleware.javascript-reloading
  (:require
   [clojure.java.io :as io]
   [cljs.build.api :as bapi]
   [figwheel-sidecar.utils :as utils]
   [clojure.pprint :as pp]))

;; live javascript reloading

;; extremely tenuous relationship, this could break easily
;; file-path is a string and it is an absolute path
(defn cljs-target-file-from-foreign [output-dir file-path]
  (first (filter #(.exists %)
                 ;; try the projected location
                 [(io/file output-dir (utils/relativize-local file-path))
                  (io/file output-dir (.getName (io/file file-path)))])))

(defn closure-lib-target-file-for-ns [output-dir namesp]
  (let [path (cljs.closure/lib-rel-path {:provides [namesp]})]
    (io/file output-dir path)))

(defn foreign-libs-provides [foreign-libs file-path]
  (some->> foreign-libs
           (filter #(.endsWith file-path (:file %)))
           first
           :provides
           not-empty))

(defn safe-js->ns [file-path]
  (try (some-> (bapi/parse-js-ns file-path)
               :provides
               not-empty)
       (catch Throwable e
         ;; couldn't parse js for namespace
         nil)))

(defn best-try-js-ns [state foreign-libs js-file-path]
  (letfn [(get-provides [js-path]
            (and (.exists (io/file js-path))
                 (or
                  (safe-js->ns js-path)
                  (foreign-libs-provides foreign-libs js-path))))]
    (if-let [provs (get-provides js-file-path)]
      provs
      (if-let [out-file (cljs-target-file-from-foreign (:output-dir state) js-file-path)]
        (get-provides out-file)))))

(defn js-file->namespaces [{:keys [foreign-libs output-dir] :as state} js-file-path]
  (best-try-js-ns state foreign-libs js-file-path))

(defn hook [build-fn]
  (fn [{:keys [figwheel-server build-config changed-files] :as build-state}]
    (if-let [changed-js-files (filter #(.endsWith % ".js") changed-files)]
      (let [build-options (or (:build-options build-config) (:compiler build-config))
            additional-changed-ns ;; add in js namespaces
            (mapcat (partial js-file->namespaces build-options)
                    changed-js-files)]
        (build-fn (update-in
                   build-state [:additional-changed-ns] concat additional-changed-ns)))
      (build-fn build-state))))

fix up foreign-libs javascript reloading a bit


(ns salava.profile.ui.block
  (:require [salava.core.ui.helper :refer [base-path path-for plugin-fun hyperlink]]
            [reagent.core :refer [atom]]
            [salava.core.ui.ajax-utils :as ajax]
            [reagent.session :as session]
            [salava.core.i18n :as i18n :refer [t]]
            [salava.user.schemas :refer [contact-fields]]
            [clojure.string :refer [blank?]]))

(defn init-user-profile [user-id state]
  (ajax/GET
    (path-for (str "/obpv1/profile/" user-id) true)
    {:handler (fn [data] (reset! state data))}
    ))

(defn profile-picture [path]
  (let [picture-fn (first (plugin-fun (session/get :plugins) "helper" "profile_picture"))]
    (when picture-fn (picture-fn path) )))

(defn ^:export userprofileinfo []
  (let [state (atom {})
        id (session/get-in [:user :id])]
    (init-user-profile id state)
    (fn []
      (let [{:keys [user profile]} @state
            {:keys [role first_name last_name about profile_picture]} user]
        [:div {:id "profile"}
         [:div.row
          [:div {:class "col-md-3 col-sm-3 col-xs-12"}
           [:div.profile-picture-wrapper
            [:img.profile-picture {:src (profile-picture profile_picture)}]]
           ]
          [:div.col-md-9
           [:div.col-xs-12
            [:div.row
              [:div {:style {:margin "10px 0"}}
               [:label (t :admin/Name)]
               [:div (str first_name " " last_name)]
               ]
             (when-not (blank? about)
               [:div.col-xs-12
                [:label (t :user/Aboutme)]
                [:div about]])
             (when profile
               (if (not-empty profile)
                 [:div.row
                  [:div.col-xs-12 [:b (t :profile/Additionalinformation)]]
                  [:div.col-xs-12
                   [:table.table
                    (into [:tbody]
                          (for [profile-field (sort-by :order profile)
                                :let [{:keys [field value]} profile-field
                                      key (->> contact-fields
                                               (filter #(= (:type %) field))
                                               first
                                               :key)]]
                            (when-not (blank? value)
                              [:tr
                               [:td.profile-field (t key) ":"]
                               [:td (cond
                                      (or (re-find #"www." (str value)) (re-find #"^https?://" (str value)) (re-find #"^http?://" (str value))) (hyperlink value)
                                      (and (re-find #"@" (str value)) (= "twitter" field)) [:a {:href (str "https://twitter.com/" value) :target "_blank" } (t value)]
                                      (and (re-find #"@" (str value)) (= "email" field)) [:a {:href (str "mailto:" value)} (t value)]
                                      (and  (empty? (re-find #" " (str value))) (= "facebook" field)) [:a {:href (str "https://www.facebook.com/" value) :target "_blank" } (t value)]
                                      (= "twitter" field) [:a {:href (str "https://twitter.com/" value) :target "_blank" } (t value)]
                                      (and  (empty? (re-find #" " (str value))) (= "pinterest" field)) [:a {:href (str "https://www.pinterest.com/" value) :target "_blank" } (t value)]
                                      (and  (empty? (re-find #" " (str value))) (= "instagram" field)) [:a {:href (str "https://www.instagram.com/" value) :target "_blank" } (t value)]
                                      (= "blog" field) (hyperlink value)
                                      :else (t value))]])))]]]))]]]]]))))

(ns salava.profile.ui.block
  (:require [salava.core.ui.helper :refer [base-path path-for plugin-fun hyperlink]]
            [reagent.core :refer [atom]]
            [salava.core.ui.ajax-utils :as ajax]
            [reagent.session :as session]
            [salava.core.i18n :as i18n :refer [t]]
            [salava.user.schemas :refer [contact-fields]]
            [clojure.string :refer [blank?]]))

(defn init-user-profile [user-id state]
  (ajax/GET
    (path-for (str "/obpv1/profile/" user-id) true)
    {:handler (fn [data] (reset! state data))}
    ))

(defn profile-picture [path]
  (let [picture-fn (first (plugin-fun (session/get :plugins) "helper" "profile_picture"))]
    (when picture-fn (picture-fn path) )))

(defn ^:export userprofileinfo []
  (let [state (atom {})
        id (session/get-in [:user :id])]
    (init-user-profile id state)
    (fn []
      (let [{:keys [user profile]} @state
            {:keys [role first_name last_name about profile_picture]} user]
        [:div {:id "profile" :style {:margin "10px auto"}}
         [:div.row
          [:div {:class "col-md-3 col-sm-3 col-xs-12"}
           [:div.profile-picture-wrapper
            [:img.profile-picture {:src (profile-picture profile_picture)}]]
           ]
          [:div.col-md-9
           [:div.col-xs-12
            [:div.row
              [:div {:style {:margin "10px 0"}}
               [:label (t :admin/Name)]
               [:div (str first_name " " last_name)]
               ]
             (when-not (blank? about)
               [:div.col-xs-12
                [:label (t :user/Aboutme)]
                [:div about]])
             (when profile
               (if (not-empty profile)
                 [:div.row
                  [:div.col-xs-12 [:b (t :profile/Additionalinformation)]]
                  [:div.col-xs-12
                   [:table.table
                    (into [:tbody]
                          (for [profile-field (sort-by :order profile)
                                :let [{:keys [field value]} profile-field
                                      key (->> contact-fields
                                               (filter #(= (:type %) field))
                                               first
                                               :key)]]
                            (when-not (blank? value)
                              [:tr
                               [:td.profile-field (t key) ":"]
                               [:td (cond
                                      (or (re-find #"www." (str value)) (re-find #"^https?://" (str value)) (re-find #"^http?://" (str value))) (hyperlink value)
                                      (and (re-find #"@" (str value)) (= "twitter" field)) [:a {:href (str "https://twitter.com/" value) :target "_blank" } (t value)]
                                      (and (re-find #"@" (str value)) (= "email" field)) [:a {:href (str "mailto:" value)} (t value)]
                                      (and  (empty? (re-find #" " (str value))) (= "facebook" field)) [:a {:href (str "https://www.facebook.com/" value) :target "_blank" } (t value)]
                                      (= "twitter" field) [:a {:href (str "https://twitter.com/" value) :target "_blank" } (t value)]
                                      (and  (empty? (re-find #" " (str value))) (= "pinterest" field)) [:a {:href (str "https://www.pinterest.com/" value) :target "_blank" } (t value)]
                                      (and  (empty? (re-find #" " (str value))) (= "instagram" field)) [:a {:href (str "https://www.instagram.com/" value) :target "_blank" } (t value)]
                                      (= "blog" field) (hyperlink value)
                                      :else (t value))]])))]]]))]]]]]))))

add margin to exported profile block

add margin to exported profile block


;; Copyright (c) 2014, Andrey Antukh
;; Copyright (c) 2014, Alejandro Gómez
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns cats.monad.continuation
  "The Continuation Monad."
  (:require [cats.protocols :as proto])
  #+clj
  (:require [cats.core :refer [with-context]])
  #+cljs
  (:require-macros [cats.core :refer (with-context)]))

(declare continuation-monad)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Type constructors and functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deftype Continuation [mfn]
  proto/Context
  (get-context [_]
    continuation-monad)

  #+clj   clojure.lang.IFn
  #+cljs  cljs.core/IFn
  (#+clj invoke #+cljs -invoke [self f]
    (mfn f)))

(defn continuation
  "Default constructor for continuation."
  [mfn]
  (Continuation. mfn))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Monad definition
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def continuation-monad
  (reify
    proto/Monad
    (mreturn [_ v]
      (Continuation. (fn [c] (c v))))

    (mbind [_ self mf]
      (Continuation. (fn [c]
                       (self (fn [v]
                               ((mf v) c))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Continuation monad functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn run-cont
  "Given a Continuation instance, execute the
  wrapped computation and return its value."
  [cont]
  (with-context continuation-monad
    (cont identity)))

(defn call-cc
  [f]
  (continuation
    (fn [cc]
      (let [k (fn [a]
                (continuation (fn [_] (cc a))))]
        ((f k) cc)))))

;; Copyright (c) 2014, Andrey Antukh
;; Copyright (c) 2014, Alejandro Gómez
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns cats.monad.continuation
  "The Continuation Monad."
  (:require [cats.protocols :as proto])
  #+clj
  (:require [cats.core :refer [with-context]])
  #+cljs
  (:require-macros [cats.core :refer (with-context)]))

(declare continuation-monad)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Type constructors and functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deftype Continuation [mfn]
  proto/Context
  (get-context [_] continuation-monad)
  (get-value [_] mfn)

  #+clj  clojure.lang.IFn
  #+cljs cljs.core/IFn
  (#+clj invoke #+cljs -invoke [self seed]
    (mfn seed)))

(defn continuation
  "Default constructor for continuation."
  [mfn]
  (Continuation. mfn))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Monad definition
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def continuation-monad
  (reify
    proto/Monad
    (mreturn [_ v]
      (Continuation. (fn [c] (c v))))

    (mbind [_ self mf]
      (Continuation. (fn [c]
                       (self (fn [v]
                               ((mf v) c))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Continuation monad functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn run-cont
  "Given a Continuation instance, execute the
  wrapped computation and return its value."
  [cont]
  (with-context continuation-monad
    (cont identity)))

(defn call-cc
  [f]
  (continuation
    (fn [cc]
      (let [k (fn [a]
                (continuation (fn [_] (cc a))))]
        ((f k) cc)))))

Implement new function of Context protocol for continuation monad.


(ns chat.test.server.tags
  (:require [clojure.test :refer :all]
            [chat.server.db :as db]))

(use-fixtures :each
              (fn [t]
                (binding [db/*uri* "datomic:mem://chat-test"]
                  (db/init!)
                  (db/with-conn (t))
                  (datomic.api/delete-database db/*uri*))))

(deftest tags
  (testing "can create tag"
    (let [group (db/create-group! {:id (db/uuid)
                                   :name "Lean Pixel"})
          tag-data {:id (db/uuid)
                    :name "acme"
                    :group-id (group :id)}]
      (testing "create-tag!"
        (let [tag (db/create-tag! tag-data)]
          (testing "returns tag"
            (is (= tag (assoc tag-data :group-name "Lean Pixel")))))))))

(deftest user-can-subscribe-to-tags
  (let [user (db/create-user! {:id (db/uuid)
                               :email "foo@bar.com"
                               :password "foobar"
                               :avatar ""})
        group (db/create-group! {:id (db/uuid)
                                 :name "Lean Pixel"})
        tag-1 (db/create-tag! {:id (db/uuid) :name "acme1" :group-id (group :id)})
        tag-2 (db/create-tag! {:id (db/uuid) :name "acme2" :group-id (group :id)})]
    (db/user-add-to-group! (user :id) (group :id))
    (testing "user can subscribe to tags"
      (testing "user-subscribe-to-tag!"
        (db/user-subscribe-to-tag! (user :id) (tag-1 :id))
        (db/user-subscribe-to-tag! (user :id) (tag-2 :id)))
      (testing "get-user-subscribed-tags"
        (let [tags (db/get-user-subscribed-tag-ids (user :id))]
          (testing "returns subscribed tags"
            (is (= (set tags) #{(tag-1 :id) (tag-2 :id)}))))))
    (testing "user can unsubscribe from tags"
      (testing "user-unsubscribe-from-tag!"
        (db/user-unsubscribe-from-tag! (user :id) (tag-1 :id))
        (db/user-unsubscribe-from-tag! (user :id) (tag-2 :id)))
      (testing "is unsubscribed"
        (let [tags (db/get-user-subscribed-tag-ids (user :id))]
          (is (= (set tags) #{})))))))

(deftest user-can-only-see-tags-in-group
  (let [user-1 (db/create-user! {:id (db/uuid)
                                 :email "foo@bar.com"
                                 :password "foobar"
                                 :avatar ""})
        user-2 (db/create-user! {:id (db/uuid)
                                 :email "quux@bar.com"
                                 :password "foobar"
                                 :avatar ""})
        user-3 (db/create-user! {:id (db/uuid)
                                 :email "qaax@bar.com"
                                 :password "foobar"
                                 :avatar ""})
        group-1 (db/create-group! {:id (db/uuid)
                                   :name "Lean Pixel"})
        group-2 (db/create-group! {:id (db/uuid)
                                   :name "Penyo Pal"})
        tag-1 (db/create-tag! {:id (db/uuid) :name "acme1" :group-id (group-1 :id)})
        tag-2 (db/create-tag! {:id (db/uuid) :name "acme2" :group-id (group-2 :id)})
        tag-3 (db/create-tag! {:id (db/uuid) :name "acme3" :group-id (group-2 :id)})]
    (db/user-add-to-group! (user-1 :id) (group-1 :id))
    (db/user-add-to-group! (user-2 :id) (group-1 :id))
    (db/user-add-to-group! (user-2 :id) (group-2 :id))
    (db/user-add-to-group! (user-3 :id) (group-2 :id))
    (testing "user can only see tags in their group(s)"
      (is (= #{tag-1} (db/fetch-tags-for-user (user-1 :id))))
      (is (= #{tag-1 tag-2 tag-3} (db/fetch-tags-for-user (user-2 :id))))
      (is (= #{tag-2 tag-3} (db/fetch-tags-for-user (user-3 :id)))))))

(deftest user-can-only-subscribe-to-tags-in-group
  (let [user (db/create-user! {:id (db/uuid)
                               :email "foo@bar.com"
                               :password "foobar"
                               :avatar ""})
        group-1 (db/create-group! {:id (db/uuid)
                                   :name "Lean Pixel"})
        group-2 (db/create-group! {:id (db/uuid)
                                   :name "Penyo Pal"})
        tag-1 (db/create-tag! {:id (db/uuid) :name "acme1" :group-id (group-1 :id)})
        tag-2 (db/create-tag! {:id (db/uuid) :name "acme2" :group-id (group-2 :id)})]
    (db/user-add-to-group! (user :id) (group-1 :id))
    (testing "user can subscribe to tags"
      (testing "user-subscribe-to-tag!"
        (db/user-subscribe-to-tag! (user :id) (tag-1 :id))
        (db/user-subscribe-to-tag! (user :id) (tag-2 :id)))
      (testing "get-user-subscribed-tags"
        (let [tags (db/get-user-subscribed-tag-ids (user :id))]
          (testing "returns subscribed tags"
            (is (= (set tags) #{(tag-1 :id)}))))))))

(ns chat.test.server.tags
  (:require [clojure.test :refer :all]
            [chat.server.db :as db]))

(use-fixtures :each
              (fn [t]
                (binding [db/*uri* "datomic:mem://chat-test"]
                  (db/init!)
                  (db/with-conn (t))
                  (datomic.api/delete-database db/*uri*))))

(deftest tags
  (testing "can create tag"
    (let [group (db/create-group! {:id (db/uuid)
                                   :name "Lean Pixel"})
          tag-data {:id (db/uuid)
                    :name "acme"
                    :group-id (group :id)}]
      (testing "create-tag!"
        (let [tag (db/create-tag! tag-data)]
          (testing "returns tag"
            (is (= tag (assoc tag-data :group-name "Lean Pixel"
                         :threads-count 0 :subscribers-count 0)))))))))

(deftest user-can-subscribe-to-tags
  (let [user (db/create-user! {:id (db/uuid)
                               :email "foo@bar.com"
                               :password "foobar"
                               :avatar ""})
        group (db/create-group! {:id (db/uuid)
                                 :name "Lean Pixel"})
        tag-1 (db/create-tag! {:id (db/uuid) :name "acme1" :group-id (group :id)})
        tag-2 (db/create-tag! {:id (db/uuid) :name "acme2" :group-id (group :id)})]
    (db/user-add-to-group! (user :id) (group :id))
    (testing "user can subscribe to tags"
      (testing "user-subscribe-to-tag!"
        (db/user-subscribe-to-tag! (user :id) (tag-1 :id))
        (db/user-subscribe-to-tag! (user :id) (tag-2 :id)))
      (testing "get-user-subscribed-tags"
        (let [tags (db/get-user-subscribed-tag-ids (user :id))]
          (testing "returns subscribed tags"
            (is (= (set tags) #{(tag-1 :id) (tag-2 :id)}))))))
    (testing "user can unsubscribe from tags"
      (testing "user-unsubscribe-from-tag!"
        (db/user-unsubscribe-from-tag! (user :id) (tag-1 :id))
        (db/user-unsubscribe-from-tag! (user :id) (tag-2 :id)))
      (testing "is unsubscribed"
        (let [tags (db/get-user-subscribed-tag-ids (user :id))]
          (is (= (set tags) #{})))))))

(deftest user-can-only-see-tags-in-group
  (let [user-1 (db/create-user! {:id (db/uuid)
                                 :email "foo@bar.com"
                                 :password "foobar"
                                 :avatar ""})
        user-2 (db/create-user! {:id (db/uuid)
                                 :email "quux@bar.com"
                                 :password "foobar"
                                 :avatar ""})
        user-3 (db/create-user! {:id (db/uuid)
                                 :email "qaax@bar.com"
                                 :password "foobar"
                                 :avatar ""})
        group-1 (db/create-group! {:id (db/uuid)
                                   :name "Lean Pixel"})
        group-2 (db/create-group! {:id (db/uuid)
                                   :name "Penyo Pal"})
        tag-1 (db/create-tag! {:id (db/uuid) :name "acme1" :group-id (group-1 :id)})
        tag-2 (db/create-tag! {:id (db/uuid) :name "acme2" :group-id (group-2 :id)})
        tag-3 (db/create-tag! {:id (db/uuid) :name "acme3" :group-id (group-2 :id)})]
    (db/user-add-to-group! (user-1 :id) (group-1 :id))
    (db/user-add-to-group! (user-2 :id) (group-1 :id))
    (db/user-add-to-group! (user-2 :id) (group-2 :id))
    (db/user-add-to-group! (user-3 :id) (group-2 :id))
    (testing "user can only see tags in their group(s)"
      (is (= #{tag-1} (db/fetch-tags-for-user (user-1 :id))))
      (is (= #{tag-1 tag-2 tag-3} (db/fetch-tags-for-user (user-2 :id))))
      (is (= #{tag-2 tag-3} (db/fetch-tags-for-user (user-3 :id)))))))

(deftest user-can-only-subscribe-to-tags-in-group
  (let [user (db/create-user! {:id (db/uuid)
                               :email "foo@bar.com"
                               :password "foobar"
                               :avatar ""})
        group-1 (db/create-group! {:id (db/uuid)
                                   :name "Lean Pixel"})
        group-2 (db/create-group! {:id (db/uuid)
                                   :name "Penyo Pal"})
        tag-1 (db/create-tag! {:id (db/uuid) :name "acme1" :group-id (group-1 :id)})
        tag-2 (db/create-tag! {:id (db/uuid) :name "acme2" :group-id (group-2 :id)})]
    (db/user-add-to-group! (user :id) (group-1 :id))
    (testing "user can subscribe to tags"
      (testing "user-subscribe-to-tag!"
        (db/user-subscribe-to-tag! (user :id) (tag-1 :id))
        (db/user-subscribe-to-tag! (user :id) (tag-2 :id)))
      (testing "get-user-subscribed-tags"
        (let [tags (db/get-user-subscribed-tag-ids (user :id))]
          (testing "returns subscribed tags"
            (is (= (set tags) #{(tag-1 :id)}))))))))

make tests pass

make tests pass


(ns clj-money.import-test
  (:refer-clojure :exclude [update])
  (:require [clojure.test :refer :all]
            [clojure.data :refer [diff]]
            [clojure.java.io :as io]
            [clojure.pprint :refer [pprint]]
            [clj-time.core :as t]
            [environ.core :refer [env]]
            [clj-factory.core :refer [factory]]
            [clj-money.serialization :as serialization]
            [clj-money.factories.user-factory]
            [clj-money.test-helpers :refer [reset-db]]
            [clj-money.models.entities :as entities]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.budgets :as budgets]
            [clj-money.reports :as reports]
            [clj-money.import :refer [import-data]]
            [clj-money.import.gnucash :as gnucash]))

(def storage-spec (env :db))

(use-fixtures :each (partial reset-db storage-spec))

(def import-context
  {:users [(factory :user, {:email "john@doe.com"})] })

(def gnucash-sample
  (io/input-stream "resources/fixtures/sample.gnucash"))

(deftest import-a-simple-file
  (let [context (serialization/realize storage-spec import-context)
        user (-> context :users first)
        result (import-data storage-spec
                            user
                            "Personal"
                            gnucash-sample
                            :gnucash)
        entity (-> storage-spec (entities/select (:id user)) first)
        expected-inc-stmt [{:caption "Income"
                            :value 2000M
                            :style :header}
                           {:caption "Salary"
                            :value 2000M
                            :style :data
                            :depth 0}
                           {:caption "Expense"
                            :value 290M
                            :style :header}
                           {:caption "Groceries"
                            :value 290M
                            :style :data
                            :depth 0}
                           {:caption "Net"
                            :value 1710M
                            :style :summary}]
        actual-inc-stmt (reports/income-statement storage-spec
                                                  (:id entity)
                                                  (t/local-date 1999 1 1)
                                                  (t/local-date 9999 12 31))
        expected-bal-sheet [{:caption "Asset"
                             :value 1810.00M
                             :style :header}
                            {:caption "Checking"
                             :value 1810.00M
                             :style :data
                             :depth 0}
                            {:caption "Liability"
                             :value 100.00M
                             :style :header}
                            {:caption "Credit Card"
                             :value 100.00M
                             :style :data
                             :depth 0}
                            {:caption "Equity"
                             :value 1710.00M
                             :style :header}
                            {:caption "Retained Earnings"
                             :value 1710.00M
                             :style :data
                             :depth 0}
                            {:caption "Unrealized Gains"
                             :value 0M
                             :style :data
                             :depth 0}
                            {:caption "Liabilities + Equity"
                             :value 1810.00M
                             :style :summary}]
        actual-bal-sheet (reports/balance-sheet storage-spec
                                                (:id entity)
                                                (t/local-date 9999 12 31))]
    (is (= expected-inc-stmt actual-inc-stmt)
        "The income statement is correct after import")
    (is (= expected-bal-sheet actual-bal-sheet)
        "The balance sheet is correct after import")))

(def gnucash-budget-sample
  (io/input-stream "resources/fixtures/budget_sample.gnucash"))

(deftest import-a-budget
  (let [context (serialization/realize storage-spec import-context)
        user (-> context :users first)
        result (import-data storage-spec
                            user
                            "Personal"
                            gnucash-budget-sample
                            :gnucash)
        entity (entities/select storage-spec (:id user))
        [salary groceries] (->> (:id entity)
                                (accounts/select-by-entity-id storage-spec)
                                (sort #(compare (:name %2) (:name %1))))
        actual (budgets/select-by-entity-id storage-spec (:id entity))

        expected [{:name "2017"
                   :period :month
                   :period-count 12
                   :start-date (t/local-date 2017 1 1)
                   :end-date (t/local-date 2017 12 31)
                   :items [{:account-id (:id salary)
                            :periods (map (fn [index]
                                            {:index index
                                             :amount 1000M})
                                          (range 10))}
                           {:account-id (:id groceries)
                            :periods [{:index 0
                                       :amount 200M}
                                      {:index 1
                                       :amount 200M}
                                      {:index 2
                                       :amount 250M}
                                      {:index 3
                                       :amount 250M}
                                      {:index 4
                                       :amount 275M}
                                      {:index 5
                                       :amount 275M}
                                      {:index 6
                                       :amount 200M}
                                      {:index 7
                                       :amount 200M}
                                      {:index 8
                                       :amount 250M}
                                      {:index 9
                                       :amount 250M}
                                      {:index 10
                                       :amount 275M}
                                      {:index 11
                                       :amount 275M}]}]}]]
    (is (= expected actual) "The budget exists after import with correct values")))

(ns clj-money.import-test
  (:refer-clojure :exclude [update])
  (:require [clojure.test :refer :all]
            [clojure.data :refer [diff]]
            [clojure.java.io :as io]
            [clojure.pprint :refer [pprint]]
            [clj-time.core :as t]
            [environ.core :refer [env]]
            [clj-factory.core :refer [factory]]
            [clj-money.serialization :as serialization]
            [clj-money.factories.user-factory]
            [clj-money.test-helpers :refer [reset-db]]
            [clj-money.models.entities :as entities]
            [clj-money.models.accounts :as accounts]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.budgets :as budgets]
            [clj-money.reports :as reports]
            [clj-money.import :refer [import-data]]
            [clj-money.import.gnucash :as gnucash]))

(def storage-spec (env :db))

(use-fixtures :each (partial reset-db storage-spec))

(def import-context
  {:users [(factory :user, {:email "john@doe.com"})] })

(def gnucash-sample
  (io/input-stream "resources/fixtures/sample.gnucash"))

(deftest import-a-simple-file
  (let [context (serialization/realize storage-spec import-context)
        user (-> context :users first)
        result (import-data storage-spec
                            user
                            "Personal"
                            gnucash-sample
                            :gnucash)
        entity (-> storage-spec (entities/select (:id user)) first)
        expected-inc-stmt [{:caption "Income"
                            :value 2000M
                            :style :header}
                           {:caption "Salary"
                            :value 2000M
                            :style :data
                            :depth 0}
                           {:caption "Expense"
                            :value 290M
                            :style :header}
                           {:caption "Groceries"
                            :value 290M
                            :style :data
                            :depth 0}
                           {:caption "Net"
                            :value 1710M
                            :style :summary}]
        actual-inc-stmt (reports/income-statement storage-spec
                                                  (:id entity)
                                                  (t/local-date 1999 1 1)
                                                  (t/local-date 9999 12 31))
        expected-bal-sheet [{:caption "Asset"
                             :value 1810.00M
                             :style :header}
                            {:caption "Checking"
                             :value 1810.00M
                             :style :data
                             :depth 0}
                            {:caption "Liability"
                             :value 100.00M
                             :style :header}
                            {:caption "Credit Card"
                             :value 100.00M
                             :style :data
                             :depth 0}
                            {:caption "Equity"
                             :value 1710.00M
                             :style :header}
                            {:caption "Retained Earnings"
                             :value 1710.00M
                             :style :data
                             :depth 0}
                            {:caption "Unrealized Gains"
                             :value 0M
                             :style :data
                             :depth 0}
                            {:caption "Liabilities + Equity"
                             :value 1810.00M
                             :style :summary}]
        actual-bal-sheet (reports/balance-sheet storage-spec
                                                (:id entity)
                                                (t/local-date 9999 12 31))]
    (is (= expected-inc-stmt actual-inc-stmt)
        "The income statement is correct after import")
    (is (= expected-bal-sheet actual-bal-sheet)
        "The balance sheet is correct after import")))

(def gnucash-budget-sample
  (io/input-stream "resources/fixtures/budget_sample.gnucash"))

(deftest import-a-budget
  (let [context (serialization/realize storage-spec import-context)
        user (-> context :users first)
        result (import-data storage-spec
                            user
                            "Personal"
                            gnucash-budget-sample
                            :gnucash)
        entity (first (entities/select storage-spec (:id user)))
        [salary groceries] (->> (:id entity)
                                (accounts/select-by-entity-id storage-spec)
                                (sort #(compare (:name %2) (:name %1))))
        actual (->> (:id entity)
                    (budgets/select-by-entity-id storage-spec)
                    (map #(dissoc % :id :updated-at :created-at)))
        expected [{:name "2017"
                   :entity-id (:id entity)
                   :period :month
                   :period-count 12
                   :start-date (t/local-date 2017 1 1)
                   :end-date (t/local-date 2017 12 31)
                   :items [{:account-id (:id salary)
                            :periods (map (fn [index]
                                            {:index index
                                             :amount 1000M})
                                          (range 10))}
                           {:account-id (:id groceries)
                            :periods [{:index 0
                                       :amount 200M}
                                      {:index 1
                                       :amount 200M}
                                      {:index 2
                                       :amount 250M}
                                      {:index 3
                                       :amount 250M}
                                      {:index 4
                                       :amount 275M}
                                      {:index 5
                                       :amount 275M}
                                      {:index 6
                                       :amount 200M}
                                      {:index 7
                                       :amount 200M}
                                      {:index 8
                                       :amount 250M}
                                      {:index 9
                                       :amount 250M}
                                      {:index 10
                                       :amount 275M}
                                      {:index 11
                                       :amount 275M}]}]}]]

    (pprint {:expected expected
             :actual actual
             :diff (diff expected actual)})

    (is (= expected actual) "The budget exists after import with correct values")))

fix test errors

fix test errors


(ns obb-demo.views.layout.footer)

(defn render
  []
  [:footer
   [:div.row
    [:div.col-lg-12
     [:ul.list-unstyled
      [:li.pull-right [:a {:href "https://github.com/orionsbelt-battlegrounds/obb-rules"} "Source Code"]]
      [:li [:a {:href "#"} "Home"]]]
     [:p "Orion's Belt: chess-like battle system with a powerful twist!"]
     [:p "Design: " [:a {:href "http://bootswatch.com/slate/"} "Slate"] "'s theme."]]]])

(ns obb-demo.views.layout.footer)

(defn render
  []
  [:footer
   [:div.row
    [:div.col-lg-12
     [:ul.list-unstyled
      [:li.pull-right [:a {:href "https://github.com/orionsbelt-battlegrounds/obb-rules"} "Source Code"]]
      [:li [:a {:href "#"} "Home"]]]
     [:p "Orion's Belt: chess-like battle system with a powerful twist!"]
     [:p [:a {:href "https://twitter.com/orionsbelt"} "Twitter: @orionsbelt"]]
     [:p "Design: " [:a {:href "http://bootswatch.com/slate/"} "Slate"] "'s theme."]]]])

Add twitter link

Add twitter link