(ns open-company.integration.section.section-revision
  (:require [midje.sweet :refer :all]
            [cheshire.core :as json]
            [open-company.lib.check :as check]
            [open-company.lib.rest-api-mock :as mock]
            [open-company.lib.resources :as r]
            [open-company.lib.db :as db]
            [open-company.api.common :as common]
            [open-company.resources.company :as c]
            [open-company.resources.section :as s]
            [open-company.representations.section :as section-rep]))

;; ----- Startup -----

(db/test-startup)

;; ----- Test Cases -----

;; OPTIONS

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no matching company slug - 404 Not Found
;; fail - no matching section slug - 404 Not Found

;; success - no JWToken - 204 No Content
;; success - organization doesn't match companies - 204 No Content
;; success - matching JWToken - 204 No Content

;; PUT/PATCH a section with the REST API.

;; The system should support PATCHing a section, and handle the following scenarios:

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no org-id in JWToken - 401 Unauthorized
;; fail - organization doesn't match companies - 403 Forbidden

;; fail - no matching company slug - 404 Not Found
;; fail - no matching section slug - 404 Not Found

;; PUT/PATCH
;; success - update existing revision title
;; success - update existing revision body
;; success - update existing revision note
;; success - update existing revision title, body, and note

;; TODO
;; PUT/PATCH
;; success - create new revision with an updated title
;; success - create new revision with an updated body
;; success - create new revision with a new note
;; success - create new revision with an updated note
;; success - create new revision with a removed note
;; success - create new revision with an updated title, body, and note

;; TODO
;; no accept
;; no content type
;; no charset
;; wrong accept
;; wrong content type
;; wrong charset

;; ----- Tests -----

(def limited-options "OPTIONS, GET")
(def full-options "OPTIONS, GET, PUT, PATCH")

(with-state-changes [(before :facts (do (c/delete-company r/slug)
                                        (c/create-company r/open r/coyote)))
                     (after :facts (c/delete-company r/slug))]

  (with-state-changes [(before :facts (s/put-section r/slug :update r/text-section-1 r/coyote))]

    (facts "about available options for new section revisions"

      (fact "with a bad JWToken"
        (let [response (mock/api-request :options (section-rep/url r/slug :update) {:auth mock/jwtoken-bad})]
          (:status response) => 401
          (:body response) => common/unauthorized))

      (fact "with no company matching the company slug"
        (let [response (mock/api-request :options (section-rep/url "foo" :update))]
          (:status response) => 404
          (:body response) => ""))

      (fact "with no section matching the section name"
        (let [response (mock/api-request :options (section-rep/url r/slug :diversity))]
          (:status response) => 404
          (:body response) => ""))

      (fact "with no JWToken"
        (let [response (mock/api-request :options (section-rep/url r/slug :update) {:skip-auth true})]
          (:status response) => 204
          (:body response) => ""
          ((:headers response) "Allow") => limited-options))

      (fact "with an organization that doesn't match the company"
        (let [response (mock/api-request :options (section-rep/url r/slug :update) {:auth mock/jwtoken-sartre})]
          (:status response) => 204
          (:body response) => ""
          ((:headers response) "Allow") => limited-options))

      (fact "with an organization that matches the company"
        (let [response (mock/api-request :options (section-rep/url r/slug :update))]
          (:status response) => 204
          (:body response) => ""
          ((:headers response) "Allow") => full-options)))

    (facts "about failing to update a section"

      (doseq [method [:put :patch]]

        (fact "with an invalid JWToken"
          (let [response (mock/api-request method (section-rep/url r/slug :update) {:body r/text-section-2
                                                                                :auth mock/jwtoken-bad})]
            (:status response) => 401
            (:body response) => common/unauthorized)
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with no JWToken"
          (let [response (mock/api-request method (section-rep/url r/slug :update) {:body r/text-section-2
                                                                                :skip-auth true})]
            (:status response) => 401
            (:body response) => common/unauthorized)
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with an organization that doesn't match the company"
          (let [response (mock/api-request method (section-rep/url r/slug :update) {:body r/text-section-2
                                                                                :auth mock/jwtoken-sartre})]
            (:status response) => 403
            (:body response) => common/forbidden)
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with no company matching the company slug"
          (let [response (mock/api-request method (section-rep/url "foo" :update) {:body r/text-section-2})]
            (:status response) => 404
            (:body response) => "")
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with no section matching the section name"
          (let [response (mock/api-request method (section-rep/url r/slug :finances) {:body r/text-section-2})]
            (:status response) => 404
            (:body response) => "")
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1))))

  (facts "about updating an existing section revision"

    (facts "with PUT"

      (with-state-changes [(before :facts (s/put-section r/slug :update r/text-section-1 r/coyote))]

        (fact "update existing revision title"
          (let [updated (assoc r/text-section-1 :title "New Title")
                response (mock/api-request :put (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision body"
          (let [updated (assoc r/text-section-1 :body "New Body")
                response (mock/api-request :put (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1))) ; but there is still just 1 revision

      (with-state-changes [(before :facts (s/put-section r/slug :finances r/finances-section-1 r/coyote))]

        (fact "update existing revision note"
          (let [updated (assoc r/text-section-1 :note "New Note")
                response (mock/api-request :put (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision title, body and note"
          (let [updated {:body "New Body" :title "New Title" :note "New Note"}
                response (mock/api-request :put (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)))) ; but there is still just 1 revision

    (facts "with PATCH"

      (with-state-changes [(before :facts (s/put-section r/slug :update r/text-section-1 r/coyote))]

        (fact "update existing revision title"
          (let [updated {:title "New Title"}
                response (mock/api-request :patch (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)
                updated-section (merge r/text-section-1 updated)]
            (:status response) => 200
            body => (contains updated-section)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated-section)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision body"
          (let [updated {:body "New Body"}
                response (mock/api-request :patch (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)
                updated-section (merge r/text-section-1 updated)]
            (:status response) => 200
            body => (contains updated-section)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated-section)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1))) ; but there is still just 1 revision

      (with-state-changes [(before :facts (s/put-section r/slug :finances r/finances-section-1 r/coyote))]

        (fact "update existing revision note"
          (let [updated {:note "New Note"}
                response (mock/api-request :patch (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)
                updated-section (merge r/finances-section-1 updated)]
            (:status response) => 200
            body => (contains updated-section)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated-section)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision title, body and note"
          (let [updated {:body "New Body" :title "New Title" :note "New Note"}
                response (mock/api-request :patch (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)))) ; but there is still just 1 revision

  (future-facts "about creating a new section revision"

    (future-facts "with PUT")

    (future-facts "with PATCH"))))

(ns open-company.integration.section.section-revision
  (:require [midje.sweet :refer :all]
            [cheshire.core :as json]
            [open-company.lib.check :as check]
            [open-company.lib.rest-api-mock :as mock]
            [open-company.lib.resources :as r]
            [open-company.lib.db :as db]
            [open-company.api.common :as common]
            [open-company.resources.company :as c]
            [open-company.resources.section :as s]
            [open-company.representations.section :as section-rep]))

;; ----- Startup -----

(db/test-startup)

;; ----- Test Cases -----

;; OPTIONS

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no matching company slug - 404 Not Found
;; fail - no matching section slug - 404 Not Found

;; success - no JWToken - 204 No Content
;; success - organization doesn't match companies - 204 No Content
;; success - matching JWToken - 204 No Content

;; PUT/PATCH a section with the REST API.

;; The system should support PATCHing a section, and handle the following scenarios:

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no org-id in JWToken - 401 Unauthorized
;; fail - organization doesn't match companies - 403 Forbidden

;; fail - no matching company slug - 404 Not Found
;; fail - no matching section slug - 404 Not Found

;; PUT/PATCH
;; success - update existing revision title
;; success - update existing revision body
;; success - update existing revision note
;; success - update existing revision title, body, and note

;; TODO
;; PUT/PATCH
;; success - create new revision with an updated title
;; success - create new revision with an updated body
;; success - create new revision with a new note
;; success - create new revision with an updated note
;; success - create new revision with a removed note
;; success - create new revision with an updated title, body, and note

;; TODO
;; no accept
;; no content type
;; no charset
;; wrong accept
;; wrong content type
;; wrong charset

;; ----- Tests -----

(def limited-options "OPTIONS, GET")
(def full-options "OPTIONS, GET, PUT, PATCH")

(with-state-changes [(around :facts (schema.core/with-fn-validation ?form))
                     (before :facts (do (c/delete-company r/slug)
                                        (c/create-company r/open r/coyote)))
                     (after :facts (c/delete-company r/slug))]

  (with-state-changes [(before :facts (s/put-section r/slug :update r/text-section-1 r/coyote))]

    (facts "about available options for new section revisions"

      (fact "with a bad JWToken"
        (let [response (mock/api-request :options (section-rep/url r/slug :update) {:auth mock/jwtoken-bad})]
          (:status response) => 401
          (:body response) => common/unauthorized))

      (fact "with no company matching the company slug"
        (let [response (mock/api-request :options (section-rep/url "foo" :update))]
          (:status response) => 404
          (:body response) => ""))

      (fact "with no section matching the section name"
        (let [response (mock/api-request :options (section-rep/url r/slug :diversity))]
          (:status response) => 404
          (:body response) => ""))

      (fact "with no JWToken"
        (let [response (mock/api-request :options (section-rep/url r/slug :update) {:skip-auth true})]
          (:status response) => 204
          (:body response) => ""
          ((:headers response) "Allow") => limited-options))

      (fact "with an organization that doesn't match the company"
        (let [response (mock/api-request :options (section-rep/url r/slug :update) {:auth mock/jwtoken-sartre})]
          (:status response) => 204
          (:body response) => ""
          ((:headers response) "Allow") => limited-options))

      (fact "with an organization that matches the company"
        (let [response (mock/api-request :options (section-rep/url r/slug :update))]
          (:status response) => 204
          (:body response) => ""
          ((:headers response) "Allow") => full-options)))

    (facts "about failing to update a section"

      (doseq [method [:put :patch]]

        (fact "with an invalid JWToken"
          (let [response (mock/api-request method (section-rep/url r/slug :update) {:body r/text-section-2
                                                                                :auth mock/jwtoken-bad})]
            (:status response) => 401
            (:body response) => common/unauthorized)
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with no JWToken"
          (let [response (mock/api-request method (section-rep/url r/slug :update) {:body r/text-section-2
                                                                                :skip-auth true})]
            (:status response) => 401
            (:body response) => common/unauthorized)
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with an organization that doesn't match the company"
          (let [response (mock/api-request method (section-rep/url r/slug :update) {:body r/text-section-2
                                                                                :auth mock/jwtoken-sartre})]
            (:status response) => 403
            (:body response) => common/forbidden)
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with no company matching the company slug"
          (let [response (mock/api-request method (section-rep/url "foo" :update) {:body r/text-section-2})]
            (:status response) => 404
            (:body response) => "")
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1)

        (fact "with no section matching the section name"
          (let [response (mock/api-request method (section-rep/url r/slug :finances) {:body r/text-section-2})]
            (:status response) => 404
            (:body response) => "")
          ;; verify the initial section is unchanged
          (s/get-section r/slug :update) => (contains r/text-section-1)
          (count (s/get-revisions r/slug :update)) => 1))))

  (facts "about updating an existing section revision"

    (facts "with PUT"

      (with-state-changes [(before :facts (s/put-section r/slug :update r/text-section-1 r/coyote))]

        (fact "update existing revision title"
          (let [updated (assoc r/text-section-1 :title "New Title")
                response (mock/api-request :put (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision body"
          (let [updated (assoc r/text-section-1 :body "New Body")
                response (mock/api-request :put (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1))) ; but there is still just 1 revision

      (with-state-changes [(before :facts (s/put-section r/slug :finances r/finances-section-1 r/coyote))]

        (fact "update existing revision note"
          (let [updated (assoc r/text-section-1 :note "New Note")
                response (mock/api-request :put (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision title, body and note"
          (let [updated {:body "New Body" :title "New Title" :note "New Note"}
                response (mock/api-request :put (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)))) ; but there is still just 1 revision

    (facts "with PATCH"

      (with-state-changes [(before :facts (s/put-section r/slug :update r/text-section-1 r/coyote))]

        (fact "update existing revision title"
          (let [updated {:title "New Title"}
                response (mock/api-request :patch (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)
                updated-section (merge r/text-section-1 updated)]
            (:status response) => 200
            body => (contains updated-section)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated-section)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision body"
          (let [updated {:body "New Body"}
                response (mock/api-request :patch (section-rep/url r/slug :update) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)
                updated-section (merge r/text-section-1 updated)]
            (:status response) => 200
            body => (contains updated-section)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :update)]
              updated-section => (contains updated-section)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :update)) => 1))) ; but there is still just 1 revision

      (with-state-changes [(before :facts (s/put-section r/slug :finances r/finances-section-1 r/coyote))]

        (fact "update existing revision note"
          (let [updated {:note "New Note"}
                response (mock/api-request :patch (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)
                updated-section (merge r/finances-section-1 updated)]
            (:status response) => 200
            body => (contains updated-section)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated-section)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)) ; but there is still just 1 revision

        (fact "update existing revision title, body and note"
          (let [updated {:body "New Body" :title "New Title" :note "New Note"}
                response (mock/api-request :patch (section-rep/url r/slug :finances) {:body updated})
                body (mock/body-from-response response)
                updated-at (:updated-at body)]
            (:status response) => 200
            body => (contains updated)
            ;; verify the initial revision is changed
            (let [updated-section (s/get-section r/slug :finances)]
              updated-section => (contains updated)
              (check/timestamp? updated-at) => true
              (check/about-now? updated-at) => true
              (check/before? (:created-at updated-section) updated-at) => true)
            (count (s/get-revisions r/slug :finances)) => 1)))) ; but there is still just 1 revision

  (facts "about updating a placeholder section"

    (facts "with PUT"
      (with-state-changes [(before :facts (c/create-company! (c/->company r/buffer r/coyote)))
                           (after :facts (c/delete-company (:slug r/buffer)))]
        (fact "update existing revision title"
          (let [updated  (assoc r/text-section-1 :title "New Title")
                response (mock/api-request :put (section-rep/url (:slug r/buffer) :update) {:body updated})
                body     (mock/body-from-response response)
                company  (c/get-company (:slug r/buffer))]
            (:status response) => 200
            (-> company :update :placeholder) => falsey
            body => (contains updated)
            (:placeholder body) => falsey))))

    (facts "with PATCH"
      (with-state-changes [(before :facts (c/create-company! (c/->company r/buffer r/coyote)))
                           (after :facts (c/delete-company (:slug r/buffer)))]
        (fact "update existing revision title"
          (let [updated  {:title "New Title"}
                response (mock/api-request :patch (section-rep/url (:slug r/buffer) :update) {:body updated})
                body     (mock/body-from-response response)
                company  (c/get-company (:slug r/buffer))]
            (:status response) => 200
            (-> company :update :placeholder) => falsey
            (:title body) => (:title updated)
            (:placeholder body) => falsey))))

    (future-facts "with DELETE"
      #_(with-state-changes [(before :facts (c/create-company! (c/->company r/buffer r/coyote)))
                           (after :facts (c/delete-company (:slug r/buffer)))]
        (fact "update existing revision title"
          (let [response (mock/api-request :delete (section-rep/url (:slug r/buffer) :update))
                body     (mock/body-from-response response)
                company  (c/get-company (:slug r/buffer))]
            (:status response) => 200
            (-> company :update) => nil)))))

  (future-facts "about creating a new section revision"

    (future-facts "with PUT")

    (future-facts "with PATCH"))))

test updating of placeholder sections

test updating of placeholder sections


(ns clj-simple-chart.ssb.diagrams.registrerte-koyretoy
  (:require [clj-simple-chart.ssb.data.elbil :as datasource]
            [clojure.string :as str]
            [clj-simple-chart.translate :refer [translate translate-y]]
            [clj-simple-chart.rect :refer [bars]]
            [clj-simple-chart.chart :as chart]
            [clj-simple-chart.axis.core :as axis]
            [clj-simple-chart.core :as core]
            [clj-simple-chart.colors :refer :all]
            [clojure.string :as string]
            [clj-simple-chart.opentype :as opentype]))

(def data datasource/data)

(def marg 10)
(def two-marg (* 2 marg))
(def svg-width 900)
(def svg-height 500)
(def available-width (- svg-width (* 2 marg)))

(def xx {:type          :ordinal
         :orientation   :bottom
         :tick-values   (filter #(str/ends-with? % "-12") (map :dato data))
         :tick-format   (fn [x] (str/replace x "-12" ""))
         :domain        (map :dato data)
         :padding-inner 0.4
         :padding-outer 0.4})

(def yy {:type               :linear
         :orientation        :right
         :grid               true
         :axis-text-style-fn (fn [x] {:font "Roboto Bold"})
         :domain             [0 (->> (map :sum data)
                                     (apply max))]})

(def header (opentype/stack
              {:width available-width}
              [{:margin-bottom 20 :text "Registrerte køyretøy etter drivstofftype" :font "Roboto Bold" :font-size 30}
               {:margin-bottom 3 :text "Antall køyretøy, '000" :font "Roboto Bold" :font-size 16 :valign :bottom :align :right}]))

(def footer (opentype/stack
              {:width available-width}
              [{:margin-top 6 :text "Kjelde: SSB tabell 07849" :font "Roboto Regular" :font-size 14}
               {:text "Diagram: refsdal.ivar@gmail.com" :font "Roboto Regular" :font-size 14 :valign :bottom :align :right}]))

(def available-height (- svg-height (+ (+ 3 marg)
                                       (:height (meta header))
                                       (:height (meta footer)))))

(def c (chart/chart {:width  available-width
                     :height available-height
                     :x      xx
                     :y      yy}))

(def prop->color
  [[:bensin brown "Bensin"]
   [:diesel red "Diesel"]
   [:annet orange "Annet"]
   [:elektrisk green "Elektrisk"]])

(defn diagram []
  [:svg {:xmlns "http://www.w3.org/2000/svg" :width svg-width :height svg-height}
   [:g {:transform (translate marg marg)}
    header
    [:g {:transform (translate (:margin-left c) (+ (:height (meta header)) (:margin-top c)))}
     (axis/render-axis (:x c))
     (axis/render-axis (:y c))
     (bars c {:p :dato :h prop->color} data)
     (opentype/stack {:fill         "whitesmoke"
                      :fill-opacity 0.95
                      :margin       8
                      :y            (:plot-height c)
                      :x            15
                      :grow-upwards 15}
                     (into [{:text "Drivstofftype" :font "Roboto Bold" :font-size 18}]
                           (for [[_ col txt] (reverse prop->color)]
                             {:rect {:fill col} :text txt :font "Roboto Regular" :font-size 18})))]
    [:g {:transform (translate-y (+ (:height (meta header)) available-height))} footer]]])

(defn render-self []
  (core/render "img/ssb-svg/registrerte-koyretoy.svg" "img/ssb-png/registrerte-koyretoy.png" (diagram)))

(ns clj-simple-chart.ssb.diagrams.registrerte-koyretoy
  (:require [clj-simple-chart.ssb.data.elbil :as datasource]
            [clojure.string :as str]
            [clj-simple-chart.translate :refer [translate translate-y]]
            [clj-simple-chart.rect :refer [bars]]
            [clj-simple-chart.chart :as chart]
            [clj-simple-chart.axis.core :as axis]
            [clj-simple-chart.core :as core]
            [clj-simple-chart.colors :refer :all]
            [clojure.string :as string]
            [clj-simple-chart.opentype :as opentype]))

(def data datasource/data)

(def marg 10)
(def two-marg (* 2 marg))
(def svg-width 900)
(def svg-height 500)
(def available-width (- svg-width (* 2 marg)))

(def xx {:type          :ordinal
         :orientation   :bottom
         :tick-values   (filter #(str/ends-with? % "-12") (map :dato data))
         :tick-format   (fn [x] (str/replace x "-12" ""))
         :domain        (map :dato data)
         :padding-inner 0.4
         :padding-outer 0.4})

(def yy {:type               :linear
         :orientation        :right
         :grid               true
         :axis-text-style-fn (fn [x] {:font "Roboto Bold"})
         :domain             [0 (->> (map :sum data)
                                     (apply max))]})

(def header (opentype/stack
              {:width available-width}
              [{:margin-bottom 20 :text "Registrerte personbilar etter drivstofftype" :font "Roboto Bold" :font-size 30}
               {:margin-bottom 3 :text "Antall køyretøy, '000" :font "Roboto Bold" :font-size 16 :valign :bottom :align :right}]))

(def footer (opentype/stack
              {:width available-width}
              [{:margin-top 6 :text "Kjelde: SSB tabell 07849" :font "Roboto Regular" :font-size 14}
               {:text "Diagram: refsdal.ivar@gmail.com" :font "Roboto Regular" :font-size 14 :valign :bottom :align :right}]))

(def available-height (- svg-height (+ (+ 3 marg)
                                       (:height (meta header))
                                       (:height (meta footer)))))

(def c (chart/chart {:width  available-width
                     :height available-height
                     :x      xx
                     :y      yy}))

(def prop->color
  [[:bensin brown "Bensin"]
   [:diesel red "Diesel"]
   [:annet orange "Andre"]
   [:elektrisk green "Elektrisk"]])

(defn diagram []
  [:svg {:xmlns "http://www.w3.org/2000/svg" :width svg-width :height svg-height}
   [:g {:transform (translate marg marg)}
    header
    [:g {:transform (translate (:margin-left c) (+ (:height (meta header)) (:margin-top c)))}
     (axis/render-axis (:x c))
     (axis/render-axis (:y c))
     (bars c {:p :dato :h prop->color} data)
     (opentype/stack {:fill         "whitesmoke"
                      :fill-opacity 0.95
                      :margin       8
                      :y            (:plot-height c)
                      :x            15
                      :grow-upwards 15}
                     (into [{:text "Drivstofftype" :font "Roboto Bold" :font-size 18}]
                           (for [[_ col txt] (reverse prop->color)]
                             {:rect {:fill col} :text txt :font "Roboto Regular" :font-size 18})))]
    [:g {:transform (translate-y (+ (:height (meta header)) available-height))} footer]]])

(defn render-self []
  (core/render "img/ssb-svg/registrerte-koyretoy.svg" "img/ssb-png/registrerte-koyretoy.png" (diagram)))

Add registrerte køyretøy diagram

Add registrerte køyretøy diagram


(ns comic-reader.resources
  (:require [clojure.java.io :as io]
            [clojure.tools.reader :as r]
            [clojure.string :as str])
  (:import (java.io PushbackReader)
           (java.nio.charset StandardCharsets)
           (java.nio.file Files
                          FileSystem
                          FileSystems
                          FileSystemNotFoundException
                          LinkOption)
           (java.util Collections)))

(defn get-filesystem [uri]
  (try
    (FileSystems/getFileSystem uri)
    (catch FileSystemNotFoundException _
      (FileSystems/newFileSystem uri (Collections/emptyMap)))))

(defn resource-file [name]
  (some-> name io/resource io/as-file))

(defn resource-path [name]
  (some-> name resource-file .toPath))

(defn resource-uri [name]
  (some-> name io/resource .toURI))

(defn is-directory? [path]
  (Files/isDirectory path (into-array LinkOption [])))

(defn path-seq [path]
  (with-open [s (Files/newDirectoryStream path)]
    (let [paths (transient [])
          itr (.iterator s)]
      (while (.hasNext itr)
        (conj! paths (.next itr)))
      (persistent! paths))))

(defn jar-uri-seq [resource]
  (when-let [uri (resource-uri resource)]
    (with-open [fs (get-filesystem uri)]
      (let [root (.getPath fs resource (into-array String []))]
        (doall
         (->> (tree-seq
               (fn [^java.nio.file.Path p] (is-directory? p))
               (fn [^java.nio.file.Path d] (path-seq d))
               root)
              (remove is-directory?)
              (map (memfn toUri))))))))

(defn- file-relative-to [root-file f]
  (let [root-path (.toPath root-file)
        p (.toPath f)]
    (.toFile (.relativize root-path p))))

(defn resource-seq [resource-prefix]
  (when-let [uri (resource-uri resource-prefix)]
    (if (= "jar" (.getScheme uri))
      (->> (jar-uri-seq resource-prefix)
           (map (memfn getSchemeSpecificPart))
           (map #(second (str/split % #"!/" 2))))
      (let [file-prefix (resource-file resource-prefix)]
        (->> file-prefix
             file-seq
             (remove (memfn isDirectory))
             (map #(file-relative-to file-prefix %))
             (map (memfn getPath)))))))

(defn- resource->stream [resource]
  (->> (str resource)
       (.getResourceAsStream (clojure.lang.RT/baseLoader))))

(defn read-resource [resource]
  (when-let [r1 (some-> resource
                        resource->stream
                        io/reader
                        PushbackReader.)]
    (with-open [r r1]
      (r/read r))))

(defn try-read-resource [resource]
  (when (io/resource resource)
    (try
      (read-resource resource)
      (catch clojure.lang.ExceptionInfo e
        nil))))

(ns comic-reader.resources
  (:require [clojure.java.io :as io]
            [clojure.tools.reader :as r]
            [clojure.string :as str])
  (:import (java.io PushbackReader)
           (java.nio.charset StandardCharsets)
           (java.nio.file Files
                          FileSystem
                          FileSystems
                          FileSystemNotFoundException
                          LinkOption)
           (java.util Collections)))

(defn get-filesystem [uri]
  (try
    (FileSystems/getFileSystem uri)
    (catch FileSystemNotFoundException _
      (FileSystems/newFileSystem uri (Collections/emptyMap)))))

(defn resource-file [name]
  (some-> name io/resource io/as-file))

(defn resource-path [name]
  (some-> name resource-file .toPath))

(defn resource-uri [name]
  (some-> name io/resource .toURI))

(defn is-directory? [path]
  (Files/isDirectory path (into-array LinkOption [])))

(defn path-seq [path]
  (with-open [s (Files/newDirectoryStream path)]
    (let [paths (transient [])
          itr (.iterator s)]
      (while (.hasNext itr)
        (conj! paths (.next itr)))
      (persistent! paths))))

(defn jar-uri-seq [resource]
  (when-let [uri (resource-uri resource)]
    (with-open [fs (get-filesystem uri)]
      (let [root (.getPath fs resource (into-array String []))]
        (doall
         (->> (tree-seq
               (fn [^java.nio.file.Path p] (is-directory? p))
               (fn [^java.nio.file.Path d] (path-seq d))
               root)
              (remove is-directory?)
              (map (memfn toUri))))))))

(defn- file-relative-to [resource-root root-file f]
  (let [root-path (.toPath root-file)
        p (.toPath f)]
    (io/file resource-root (.toFile (.relativize root-path p)))))

(defn resource-seq [resource-prefix]
  (when-let [uri (resource-uri resource-prefix)]
    (if (= "jar" (.getScheme uri))
      (->> (jar-uri-seq resource-prefix)
           (map (memfn getSchemeSpecificPart))
           (map #(second (str/split % #"!/" 2))))
      (let [file-prefix (resource-file resource-prefix)]
        (->> file-prefix
             file-seq
             (remove (memfn isDirectory))
             (map #(file-relative-to resource-prefix file-prefix %))
             (map (memfn getPath)))))))

(defn- resource->stream [resource]
  (->> (str resource)
       (.getResourceAsStream (clojure.lang.RT/baseLoader))))

(defn read-resource [resource]
  (when-let [r1 (some-> resource
                        resource->stream
                        io/reader
                        PushbackReader.)]
    (with-open [r r1]
      (r/read r))))

(defn try-read-resource [resource]
  (when (io/resource resource)
    (try
      (read-resource resource)
      (catch clojure.lang.ExceptionInfo e
        nil))))

Fix resource-seq to produce io/resource-able names


(ns palimpsest.smoothing
  (:require [palimpsest.types :refer [Coord Stroke Bezier]]))

; |a|
(defn v2-mag [a]
  (Math/sqrt (+ (* (:x a) (:x a))
                (* (:y a) (:y a)))))

; returns the unit vector corresponding to vector a
(defn v2-normalize [a]
  (let [mag (v2-mag a)]
    (Coord. (/ (:x a) mag)
            (/ (:y a) mag))))

(defn v2-sub [a b]
  (Coord. (- (:x a) (:x b))
          (- (:y a) (:y b))))

(defn v2-add [a b]
  (Coord. (+ (:x a) (:x b))
          (+ (:y a) (:y b))))

; computes the normalized tangent vector btw two points
; the vector will point "towards" point a
(defn v2-tangent [a b]
  (v2-normalize (v2-sub a b)))

; computes the tangent of the center point b
; the direction is in the "rightwards" direction
(defn v2-center-tangent [a b c]
  (let [left-tan (v2-sub b a)
        right-tan (v2-sub c b)
        avg-tan (v2-add left-tan right-tan)]
    (v2-normalize avg-tan)))

(defn v2-dist [a b]
  (v2-mag (v2-sub a b)))

(defn v2-scale [s v]
  (Coord. (* s (:x v)) (* s (:y v))))

(defn v2-reverse [v]
  (v2-scale -1.0 v))

(defn v2-dot [a b]
  (+ (* (:x a) (:x b))
     (* (:y a) (:y b))))

(defn parameter-normalize [params]
  (let [last-t (last params)]
    (vec (map #(/ % last-t) params))))

(defn calc-distances [coords]
  (let [npts (count coords)]
    (for [i (range 1 npts)]
      (v2-dist (nth coords i)
                  (nth coords (dec i))))))

(defn vec-scan [values]
  (reduce (fn [result v] (conj result (+ (last result) v)))
          [0.0] values))

(defn chord-parameterize [coords]
  (let [npts (count coords)]
    (-> (calc-distances coords) vec-scan parameter-normalize)))

(defn B0 [t]
  (let [tmp (- 1.0 t)]
    (* tmp tmp tmp)))

(defn B1 [t]
  (let [tmp (- 1.0 t)]
    (* 3 t tmp tmp)))

(defn B2 [t]
  (let [tmp (- 1.0 t)]
    (* 3 t t tmp)))

(defn B3 [t]
  (* t t t))

(defn calcVecX [coords params A]
  (let [V0 (first coords)
        V3 (last coords)]
    (->>
      (map (fn [d u]
             (v2-sub d (v2-add
                         (v2-scale (+ (B0 u) (B1 u)) V0)
                         (v2-scale (+ (B2 u) (B3 u)) V3))))
           coords params)
      (map (fn [[a0 a1] tmp] [(v2-dot a0 tmp) (v2-dot a1 tmp)]) A)
      (reduce (fn [[x0 x1] [t0 t1]] [(+ x0 t0) (+ x1 t1)]) [0.0 0.0]))))

(def smallest-alpha 1.0e-6)

(defn coord->str [coord]
  (str "(" (:x coord) ", " (:y coord) ")"))

(defn bezier->str [bezier]
  (str
    "V0: " (coord->str (:v0 bezier)) ", "
    "V1: " (coord->str (:v1 bezier)) ", "
    "V2: " (coord->str (:v2 bezier)) ", "
    "V3: " (coord->str (:v3 bezier))))

(defn bezier3-calc [bezier t]
  (v2-add
    (v2-add (v2-scale (B0 t) (:v0 bezier))
            (v2-scale (B1 t) (:v1 bezier)))
    (v2-add (v2-scale (B2 t) (:v2 bezier))
            (v2-scale (B3 t) (:v3 bezier)))))

(defn wu-barsky-heuristic [bez0 bez3 tan1 tan2]
  (let [dist (/ (v2-dist bez0 bez3) 3.0)]
    (Bezier. bez0
             (v2-add bez0 (v2-scale dist tan1))
             (v2-add bez3 (v2-scale dist tan2))
             bez3)))

(defn gen-bezier [coords params tan1 tan2]
  (let [npts (count coords)
        A (for [u params] [(v2-scale (B1 u) tan1) (v2-scale (B2 u) tan2)])
        C00 (apply + (for [[a0 _] A] (v2-dot a0 a0)))
        C01 (apply + (for [[a0 a1] A] (v2-dot a0 a1)))
        C10 C01
        C11 (apply + (for [[_ a1] A] (v2-dot a1 a1)))
        [X0 X1] (calcVecX coords params A)
        det_C0_C1 (- (* C00 C11) (* C10 C01))
        det_C0_X  (- (* C00 X1) (* C01 X0))
        det_X_C1 (- (* X0 C11) (* X1 C01))
        alpha1 (/ det_X_C1 det_C0_C1)
        alpha2 (/ det_C0_X det_C0_C1)
        bez0 (first coords)
        bez3 (last coords)]
    (if (or (< alpha1 smallest-alpha) (< alpha2 smallest-alpha))
      ; if alpha is too small, we must use the heuristic
      (wu-barsky-heuristic bez0 bez3 tan1 tan2)
      (Bezier. bez0
               (v2-add bez0 (v2-scale alpha1 tan1))
               (v2-add bez3 (v2-scale alpha2 tan2))
               bez3))))

(def fit-error 2.0)

(defn compute-max-error [coords bezier params]
  (->>
    ; calc distances and join with index
    (map (fn [d u i]
           [i (v2-dist d (bezier3-calc bezier u))])
         coords params (range (count coords)))
    ; collect max and split-point
    (reduce (fn [[max-dist split-point :as res-pair] [i dist]]
              (if [>= dist max-dist] [dist i] res-pair))
            [0.0 (/ (count coords) 2)])))

(defn fit-cubic
  ([coords]
    (fit-cubic coords
               (v2-tangent
                 (second coords)
                 (first coords))
               (v2-tangent
                 (nth coords (- (count coords) 2))
                 (last coords))))
  ([coords tan1 tan2]
    (if (= (count coords) 2)
      ; use the heuristic if there are no intermediate points
      (wu-barsky-heuristic (first coords) (last coords) tan1 tan2)
      (let [iter-error (* fit-error fit-error)
            params (chord-parameterize coords)
            bezier (gen-bezier coords params tan1 tan2)
            [max-error split-point] (compute-max-error coords bezier params)]
        (if (< max-error iter-error)
          [bezier]
          (let [center-tan (v2-center-tangent
                             (nth coords (dec split-point))
                             (nth coords split-point)
                             (nth coords (inc split-point)))]
            (vec (concat
                   (fit-cubic
                     (subvec coords 0 split-point) tan1
                     (v2-reverse center-tan))
                   (fit-cubic
                      (subvec coords split-point) center-tan tan2)))))))))

(defn path-length [coords]
  (first (reduce
           (fn [[seg-len last-coord] next-coord]
             [(+ seg-len (v2-dist last-coord next-coord)) next-coord])
           [0.0 (first coords)] (rest coords))))

(defn bezier3-pw-calc [beziers t]
  (let [i (int t)]
    (bezier3-calc (nth beziers i) (- t i))))

(defn interpolate-points [coords desired-seg-len]
  (let [path-len (path-length coords)]
    (if (< path-len desired-seg-len)
      coords
      (let [npts (/ path-len desired-seg-len)
            beziers (fit-cubic coords)
            step (/ (count beziers) npts)]
        (->
          ; returns a lazy sequence containing the middle points
          (map #(bezier3-pw-calc beziers %) (range step (count beziers) step))
          ; add first point to the front, convert to a vector,
          ; then add last point to end
          (conj (first coords)) vec (conj (last coords)))))))

(defn smooth-stroke [stroke]
  (Stroke.
    (interpolate-points (:coords stroke) 10.0)
    (:thickness stroke)))

(ns palimpsest.smoothing
  (:require [palimpsest.types :refer [Coord Stroke Bezier]]))

; |a|
(defn v2-mag [a]
  (Math/sqrt (+ (* (:x a) (:x a))
                (* (:y a) (:y a)))))

; returns the unit vector corresponding to vector a
(defn v2-normalize [a]
  (when (and (= 0 (:x a)) (= 0 (:y a)))
    (.log js/console "Warning! Can't normalize zero vector"))
  (let [mag (v2-mag a)]
    (Coord. (/ (:x a) mag)
            (/ (:y a) mag))))

(defn v2-sub [a b]
  (Coord. (- (:x a) (:x b))
          (- (:y a) (:y b))))

(defn v2-add [a b]
  (Coord. (+ (:x a) (:x b))
          (+ (:y a) (:y b))))

; computes the normalized tangent vector btw two points
; the vector will point "towards" point a
(defn v2-tangent [a b]
  (v2-normalize (v2-sub a b)))

; computes the tangent of the center point b
; the direction is in the "rightwards" direction
(defn v2-center-tangent [a b c]
  (let [left-tan (v2-sub b a)
        right-tan (v2-sub c b)
        avg-tan (v2-add left-tan right-tan)]
    (v2-normalize avg-tan)))

(defn v2-dist [a b]
  (v2-mag (v2-sub a b)))

(defn v2-scale [s v]
  (Coord. (* s (:x v)) (* s (:y v))))

(defn v2-reverse [v]
  (v2-scale -1.0 v))

(defn v2-dot [a b]
  (+ (* (:x a) (:x b))
     (* (:y a) (:y b))))

(defn parameter-normalize [params]
  (let [last-t (last params)]
    (vec (map #(/ % last-t) params))))

(defn calc-distances [coords]
  (let [npts (count coords)]
    (for [i (range 1 npts)]
      (v2-dist (nth coords i)
                  (nth coords (dec i))))))

(defn vec-scan [values]
  (reduce (fn [result v] (conj result (+ (last result) v)))
          [0.0] values))

(defn chord-parameterize [coords]
  (let [npts (count coords)]
    (-> (calc-distances coords) vec-scan parameter-normalize)))

(defn B0 [t]
  (let [tmp (- 1.0 t)]
    (* tmp tmp tmp)))

(defn B1 [t]
  (let [tmp (- 1.0 t)]
    (* 3 t tmp tmp)))

(defn B2 [t]
  (let [tmp (- 1.0 t)]
    (* 3 t t tmp)))

(defn B3 [t]
  (* t t t))

(defn calcVecX [coords params A]
  (let [V0 (first coords)
        V3 (last coords)]
    (->>
      (map (fn [d u]
             (v2-sub d (v2-add
                         (v2-scale (+ (B0 u) (B1 u)) V0)
                         (v2-scale (+ (B2 u) (B3 u)) V3))))
           coords params)
      (map (fn [[a0 a1] tmp] [(v2-dot a0 tmp) (v2-dot a1 tmp)]) A)
      (reduce (fn [[x0 x1] [t0 t1]] [(+ x0 t0) (+ x1 t1)]) [0.0 0.0]))))

(def smallest-alpha 1.0e-6)

(defn coord->str [coord]
  (str "(" (:x coord) ", " (:y coord) ")"))

(defn bezier->str [bezier]
  (str
    "V0: " (coord->str (:v0 bezier)) ", "
    "V1: " (coord->str (:v1 bezier)) ", "
    "V2: " (coord->str (:v2 bezier)) ", "
    "V3: " (coord->str (:v3 bezier))))

(defn bezier3-calc [bezier t]
  (v2-add
    (v2-add (v2-scale (B0 t) (:v0 bezier))
            (v2-scale (B1 t) (:v1 bezier)))
    (v2-add (v2-scale (B2 t) (:v2 bezier))
            (v2-scale (B3 t) (:v3 bezier)))))

(defn wu-barsky-heuristic [bez0 bez3 tan1 tan2]
  (let [dist (/ (v2-dist bez0 bez3) 3.0)]
    (Bezier. bez0
             (v2-add bez0 (v2-scale dist tan1))
             (v2-add bez3 (v2-scale dist tan2))
             bez3)))

(defn gen-bezier [coords params tan1 tan2]
  (let [npts (count coords)
        A (for [u params] [(v2-scale (B1 u) tan1) (v2-scale (B2 u) tan2)])
        C00 (apply + (for [[a0 _] A] (v2-dot a0 a0)))
        C01 (apply + (for [[a0 a1] A] (v2-dot a0 a1)))
        C10 C01
        C11 (apply + (for [[_ a1] A] (v2-dot a1 a1)))
        [X0 X1] (calcVecX coords params A)
        det_C0_C1 (- (* C00 C11) (* C10 C01))
        det_C0_X  (- (* C00 X1) (* C01 X0))
        det_X_C1 (- (* X0 C11) (* X1 C01))
        alpha1 (/ det_X_C1 det_C0_C1)
        alpha2 (/ det_C0_X det_C0_C1)
        bez0 (first coords)
        bez3 (last coords)]
    (if (or (< alpha1 smallest-alpha) (< alpha2 smallest-alpha))
      ; if alpha is too small, we must use the heuristic
      (wu-barsky-heuristic bez0 bez3 tan1 tan2)
      (Bezier. bez0
               (v2-add bez0 (v2-scale alpha1 tan1))
               (v2-add bez3 (v2-scale alpha2 tan2))
               bez3))))

(def fit-error 2.0)

(defn compute-max-error [coords bezier params]
  (->>
    ; calc distances and join with index
    (map (fn [d u i]
           [i (v2-dist d (bezier3-calc bezier u))])
         coords params (range (count coords)))
    ; collect max and split-point
    (reduce (fn [[max-dist split-point :as res-pair] [i dist]]
              (if (>= dist max-dist) [dist i] res-pair))
            [0.0 (/ (count coords) 2)])))

(defn fit-cubic
  ([coords]
    (fit-cubic coords
               (v2-tangent
                 (second coords)
                 (first coords))
               (v2-tangent
                 (nth coords (- (count coords) 2))
                 (last coords))))
  ([coords tan1 tan2]
    (if (= (count coords) 2)
      ; use the heuristic if there are no intermediate points
      [(wu-barsky-heuristic (first coords) (last coords) tan1 tan2)]
      (let [iter-error (* fit-error fit-error)
            params (chord-parameterize coords)
            bezier (gen-bezier coords params tan1 tan2)
            [max-error split-point] (compute-max-error coords bezier params)]
        (if (< max-error iter-error)
          [bezier]
          (let [center-tan (v2-center-tangent
                             (nth coords (dec split-point))
                             (nth coords split-point)
                             (nth coords (inc split-point)))]
            (vec (concat
                   (fit-cubic
                     (subvec coords 0 (inc split-point)) tan1
                     (v2-reverse center-tan))
                   (fit-cubic
                      (subvec coords split-point) center-tan tan2)))))))))

(defn path-length [coords]
  (first (reduce
           (fn [[seg-len last-coord] next-coord]
             [(+ seg-len (v2-dist last-coord next-coord)) next-coord])
           [0.0 (first coords)] (rest coords))))

(defn bezier3-pw-calc [beziers t]
  (let [i (int t)]
    (bezier3-calc (nth beziers i) (- t i))))

; having duplicate adjacent points screws up the distance
; calculations, so we need to remove them before doing the fitting
(defn dedup-points [coords]
  (reduce (fn [result c]
            (if (= 0 (v2-dist (last result) c))
              result
              (conj result c)))
          [] coords))

(defn interpolate-points [coords desired-seg-len]
  (let [path-len (path-length coords)]
    (if (< path-len desired-seg-len)
      coords
      (let [npts (/ path-len desired-seg-len)
            beziers (fit-cubic coords)
            step (/ (count beziers) npts)]
        (->
          ; returns a lazy sequence containing the middle points
          (map #(bezier3-pw-calc beziers %) (range step (count beziers) step))
          ; add first point to the front, convert to a vector,
          ; then add last point to end
          (conj (first coords)) vec (conj (last coords)))))))

(defn smooth-stroke [stroke]
  (let [old-coords (dedup-points (:coords stroke))]
    (if (= (count old-coords) 2)
      stroke
      (Stroke.
        (interpolate-points old-coords 10.0)
        (:thickness stroke)))))

fix some bugs in smoothing implementation


(ns ^{:doc "Command line entry point."
      :author "Paul Landes"}
    zensols.cisql.core
  (:require [clojure.string :as s])
  (:require [zensols.actioncli.log4j2 :as lu]
            [zensols.actioncli.parse :as parse])
  (:require [zensols.cisql.conf :as conf]
            [zensols.cisql.spec :as spec])
  (:require [cisql.version])
  (:gen-class :main true))

(defn- print-help [summary]
  (with-out-str
    (println (conf/format-intro))
    (println)
    (println summary)
    (println "Database subprotocols include:"
             (s/join ", " (spec/registered-names)))))

(def version-info-command
  {:description "Get the version of the application."
   :options [["-g" "--gitref"]]
   :app (fn [{refp :gitref} & args]
          (println cisql.version/version)
          (if refp (println cisql.version/gitref)))})

(defn- create-action-context []
  (parse/multi-action-context
   '((:interactive zensols.cisql interactive interactive-command)
     (:describe zensols.cisql spec driver-describe-command)
     (:add zensols.cisql spec driver-add-command)
     (:purge zensols.cisql spec driver-user-registry-purge-command))
   :action-print-order [:interactive :describe :add :purge :version]
   :version-option version-info-command
   :print-help-fn print-help))

(defn -main [& args]
  (lu/configure "cisql-log4j2.xml")
  (parse/set-program-name "cisql")
  (-> (create-action-context)
      (parse/process-arguments args)))

(ns ^{:doc "Command line entry point."
      :author "Paul Landes"}
    zensols.cisql.core
  (:require [clojure.string :as s])
  (:require [zensols.actioncli.log4j2 :as lu]
            [zensols.actioncli.parse :as parse])
  (:require [zensols.cisql.conf :as conf]
            [zensols.cisql.spec :as spec])
  (:require [cisql.version])
  (:gen-class :main true))

(defn- print-help [summary]
  (with-out-str
    (println (conf/format-intro))
    (println)
    (println summary)
    (println "Database subprotocols include:"
             (s/join ", " (spec/registered-names)))))

(defn- version-info []
  (println (format "%s (%s)" cisql.version/version cisql.version/gitref)))

(defn- create-action-context []
  (parse/multi-action-context
   '((:interactive zensols.cisql.interactive interactive-command)
     (:describe zensols.cisql.spec driver-describe-command)
     (:add zensols.cisql.spec driver-add-command)
     (:purge zensols.cisql.spec driver-user-registry-purge-command))
   :action-print-order [:interactive :describe :add :purge]
   :version-option (parse/version-option version-info)
   :print-help-fn print-help))

(defn -main [& args]
  (lu/configure "cisql-log4j2.xml")
  (parse/set-program-name "cisql")
  (-> (create-action-context)
      (parse/process-arguments args)))

fix version option

fix version option


(ns uxbox.ui.workspace.shortcuts
  (:require-macros [uxbox.util.syntax :refer [define-once]])
  (:require [goog.events :as events]
            [beicon.core :as rx]
            [uxbox.rstore :as rs]
            [uxbox.data.workspace :as dw])
  (:import goog.events.EventType
           goog.events.KeyCodes
           goog.ui.KeyboardShortcutHandler
           goog.ui.KeyboardShortcutHandler))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard Shortcuts Handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defonce ^:static +shortcuts+
  {:ctrl+g #(rs/emit! (dw/toggle-tool :grid))
   :ctrl+shift+f #(rs/emit! (dw/toggle-toolbox :draw))
   :ctrl+shift+i #(rs/emit! (dw/toggle-toolbox :icons))
   :ctrl+shift+l #(rs/emit! (dw/toggle-toolbox :layers))
   :esc #(rs/emit! (dw/deselect-all))
   :backspace #(rs/emit! (dw/remove-selected))
   :up #(rs/emit! (dw/move-selected :up))
   :down #(rs/emit! (dw/move-selected :down))
   :right #(rs/emit! (dw/move-selected :right))
   :left #(rs/emit! (dw/move-selected :left))})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard Shortcuts Watcher
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defonce ^:static ^:private +bus+
  (rx/bus))

(defonce ^:static +stream+
  (rx/to-observable +bus+))

(defn- init-handler
  []
  (let [handler (KeyboardShortcutHandler. js/document)]
    ;; Register shortcuts.
    (doseq [item (keys +shortcuts+)]
      (let [identifier (name item)]
        (.registerShortcut handler identifier identifier)))

    ;; Initialize shortcut listener.
    (let [event KeyboardShortcutHandler.EventType.SHORTCUT_TRIGGERED
          callback #(rx/push! +bus+ (keyword (.-identifier %)))
          key (events/listen handler event callback)]
      (fn []
        (events/unlistenByKey key)
        (.clearKeyListener handler)))))

(define-once :subscriptions
  (rx/on-value +stream+ #(println "[debug]: shortcut:" %))
  (rx/on-value +stream+ (fn [event]
                          (when-let [handler (get +shortcuts+ event)]
                            (handler)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard Shortcuts Mixin
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn -will-mount
  [own]
  (let [sub (init-handler)]
    (assoc own ::subscription sub)))

(defn -will-unmount
  [own]
  (let [sub (::subscription own)]
    (sub)
    (dissoc own ::subscription)))

(defn -transfer-state
  [old-own own]
  (assoc own ::subscription (::subscription old-own)))

(def mixin
  {:will-mount -will-mount
   :will-unmount -will-unmount
   :transfer-state -transfer-state})

(ns uxbox.ui.workspace.shortcuts
  (:require-macros [uxbox.util.syntax :refer [define-once]])
  (:require [goog.events :as events]
            [beicon.core :as rx]
            [uxbox.rstore :as rs]
            [uxbox.data.workspace :as dw])
  (:import goog.events.EventType
           goog.events.KeyCodes
           goog.ui.KeyboardShortcutHandler
           goog.ui.KeyboardShortcutHandler))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard Shortcuts Handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defonce ^:static +shortcuts+
  {:ctrl+g #(rs/emit! (dw/toggle-tool :grid))
   :ctrl+shift+f #(rs/emit! (dw/toggle-toolbox :draw))
   :ctrl+shift+i #(rs/emit! (dw/toggle-toolbox :icons))
   :ctrl+shift+l #(rs/emit! (dw/toggle-toolbox :layers))
   :esc #(rs/emit! (dw/deselect-all))
   :backspace #(rs/emit! (dw/remove-selected))
   :delete #(rs/emit! (dw/remove-selected))
   :up #(rs/emit! (dw/move-selected :up))
   :down #(rs/emit! (dw/move-selected :down))
   :right #(rs/emit! (dw/move-selected :right))
   :left #(rs/emit! (dw/move-selected :left))})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard Shortcuts Watcher
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defonce ^:static ^:private +bus+
  (rx/bus))

(defonce ^:static +stream+
  (rx/to-observable +bus+))

(defn- init-handler
  []
  (let [handler (KeyboardShortcutHandler. js/document)]
    ;; Register shortcuts.
    (doseq [item (keys +shortcuts+)]
      (let [identifier (name item)]
        (.registerShortcut handler identifier identifier)))

    ;; Initialize shortcut listener.
    (let [event KeyboardShortcutHandler.EventType.SHORTCUT_TRIGGERED
          callback #(rx/push! +bus+ (keyword (.-identifier %)))
          key (events/listen handler event callback)]
      (fn []
        (events/unlistenByKey key)
        (.clearKeyListener handler)))))

(define-once :subscriptions
  (rx/on-value +stream+ #(println "[debug]: shortcut:" %))
  (rx/on-value +stream+ (fn [event]
                          (when-let [handler (get +shortcuts+ event)]
                            (handler)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keyboard Shortcuts Mixin
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn -will-mount
  [own]
  (let [sub (init-handler)]
    (assoc own ::subscription sub)))

(defn -will-unmount
  [own]
  (let [sub (::subscription own)]
    (sub)
    (dissoc own ::subscription)))

(defn -transfer-state
  [old-own own]
  (assoc own ::subscription (::subscription old-own)))

(def mixin
  {:will-mount -will-mount
   :will-unmount -will-unmount
   :transfer-state -transfer-state})

Add handler for supr/delete key button.

Add handler for supr/delete key button.


(ns lein-pallet-release.plugin
  (:require
   [clojure.string :refer [join split]]
   [leiningen.core.project :refer [add-profiles]]
   [leiningen.pallet-release.git :as git]
   [leiningen.pallet-release.github :as github]))

(defn src-uri
  [project]
  (let [origin (git/origin)
        branch (git/current-branch)
        {:keys [login name]} (github/url->repo origin)]
    (format "https://github.com/%s/%s/blob/%s"
            login name branch)))

(defn doc-version
  [project]
  (join "." (take 2 (split (:version project) #"\."))))

(defn profiles
  [project]
  (let [doc-v (doc-version project)]
    {:no-checkouts {:checkout-deps-shares ^:replace []}
     :release {:set-version
               {:updates [{:path "README.md" :no-snapshot true}]}}
     :doc {:dependencies '[[com.palletops/pallet-codox "0.1.0"]]
           :plugins '[[codox/codox.leiningen "0.6.4"]
                      [lein-marginalia "0.7.1"]]
           :codox {:writer 'codox-md.writer/write-docs
                   :output-dir (format "doc/%s/api" doc-v)
                   :src-dir-uri (src-uri project)
                   :src-linenum-anchor-prefix "L"}
           :aliases {"marginalia" ["marg"
                                   "-d" (format "doc/%s/annotated" doc-v)]
                     "codox" ["doc"]
                     "doc" ["do" "codox," "marginalia"]}}}))

(defn middleware
  "Middleware to add profiles."
  [project]
  (-> project
      (add-profiles (profiles project))))

(ns lein-pallet-release.plugin
  (:require
   [clojure.string :refer [join split]]
   [leiningen.core.project :refer [add-profiles]]
   [leiningen.pallet-release.git :as git]
   [leiningen.pallet-release.github :as github]))

(defn src-uri
  [project]
  (let [origin (git/origin)
        branch (git/current-branch)
        {:keys [login name]} (github/url->repo origin)]
    (format "https://github.com/%s/%s/blob/%s"
            login name branch)))

(defn doc-version
  [project]
  (join "." (take 2 (split (:version project) #"\."))))

(defn profiles
  [project]
  (let [doc-v (doc-version project)]
    {:no-checkouts {:checkout-deps-shares ^:replace []}
     :release {:set-version
               {:updates [{:path "README.md" :no-snapshot true}]}}
     :doc-base {:dependencies '[[com.palletops/pallet-codox "0.1.0"]]
                :plugins '[[codox/codox.leiningen "0.6.4"]
                           [lein-marginalia "0.7.1"]]
                :codox {:writer 'codox-md.writer/write-docs
                        :output-dir (format "doc/%s/api" doc-v)
                        :src-dir-uri (src-uri project)
                        :src-linenum-anchor-prefix "L"}
                :aliases {"marginalia" ["marg"
                                        "-d" (format "doc/%s/annotated" doc-v)]
                          "codox" ["doc"]
                          "doc" ["do" "codox," "marginalia"]}}
     :doc [:no-checkouts :doc-base]}))

(defn middleware
  "Middleware to add profiles."
  [project]
  (-> project
      (add-profiles (profiles project))))

Add :doc-base profile

Add :doc-base profile

Closes #12


(ns vip.data-processor.validation.v5.retention-contest
  (:require [korma.core :as korma]
            [vip.data-processor.db.postgres :as postgres]
            [vip.data-processor.validation.v5.util :as util]))

(def validate-no-missing-candidate-ids
  (util/build-xml-tree-value-query-validator
   :errors :retention-contests :missing :missing-candidate-id
   "SELECT xtv.path
    FROM (SELECT DISTINCT subltree(path, 0, 4) || 'CandidateId' AS path
          FROM xml_tree_values WHERE results_id = ?
          AND subltree(path, 0, 4) ~ 'VipObject.0.RetentionContest.*{1}') xtv
    LEFT JOIN (SELECT path FROM xml_tree_values WHERE results_id = ?) xtv2
    ON xtv.path = subltree(xtv2.path, 0, 5)
    WHERE xtv2.path IS NULL"
   util/two-import-ids))

(ns vip.data-processor.validation.v5.retention-contest
  (:require [vip.data-processor.validation.v5.util :as util]))

(def validate-no-missing-candidate-ids
  (util/build-xml-tree-value-query-validator
   :errors :retention-contests :missing :missing-candidate-id
   "SELECT xtv.path
    FROM (SELECT DISTINCT subltree(path, 0, 4) || 'CandidateId' AS path
          FROM xml_tree_values WHERE results_id = ?
          AND subltree(path, 0, 4) ~ 'VipObject.0.RetentionContest.*{1}') xtv
    LEFT JOIN (SELECT path FROM xml_tree_values WHERE results_id = ?) xtv2
    ON xtv.path = subltree(xtv2.path, 0, 5)
    WHERE xtv2.path IS NULL"
   util/two-import-ids))

Remove unneeded requires in RetentionContest validator


(ns salava.badge.routes
  (:require [clojure.pprint :refer [pprint]]
            [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer :all]
            [ring.util.io :as io]
            [ring.swagger.upload :as upload]
            [schema.core :as s]
            [salava.badge.schemas :as schemas] ;cljc
            [salava.badge.main :as b]
            [salava.badge.importer :as i]
            [salava.factory.db :as f]
            [salava.core.layout :as layout]
            [salava.core.access :as access]
            [salava.badge.pdf :as pdf]
            [salava.core.helper :refer [dump]]
            [salava.badge.verify :as v]
            salava.core.restructure))

(defn route-def [ctx]
  (routes
    (context "/badge" []
             (layout/main ctx "/")
             (layout/main ctx "/mybadges")
             (layout/main-meta ctx "/info/:id" :badge)
             (layout/main-meta ctx "/info/:id/embed" :badge)
             (layout/main-meta ctx "/info/:id/pic/embed" :badge)
             (layout/main ctx "/import")
             (layout/main ctx "/export")
             (layout/main ctx "/upload")
             (layout/main ctx "/receive/:id")
             (layout/main ctx "/stats"))

    (context "/obpv1/badge" []
             :tags  ["badge"]
             (GET "/" []
                  :return [schemas/UserBadgeContent]
                  :summary "Get the badges of a current user"
                  :auth-rules access/signed
                  :current-user current-user
                  (do
                    ;(f/save-pending-assertions ctx (:id current-user))
                    (ok (b/user-badges-all ctx (:id current-user)))))

             (GET "/info/:badgeid" []
                  ;:return schemas/UserBadgeContent
                  :path-params [badgeid :- Long]
                  :summary "Get badge"
                  :current-user current-user
                  (let [user-id (:id current-user)
                        badge (b/get-badge ctx badgeid user-id)
                        badge-owner-id (:owner badge)
                        visibility (:visibility badge)
                        owner? (= user-id badge-owner-id)]
                    (if (or (and user-id badge-owner-id owner?)
                            (= visibility "public")
                            (and user-id
                                 (= visibility "internal")))
                      (do
                        (if (and badge (not owner?))
                          (b/badge-viewed ctx badgeid user-id))
                        (ok (assoc badge :owner? owner?
                                         :user-logged-in? (boolean user-id))))
                      (if (and (not user-id) (= visibility "internal"))
                        (unauthorized)
                        (not-found)))))

             (GET "/verify/:badgeid" []
                  :path-params [badgeid :- Long]
                  :summary "verify badge"
                  :current-user current-user
                  (ok (v/verify-badge ctx badgeid (:id current-user)))
                  )

             (GET "/pending/:badgeid" req
                  :path-params [badgeid :- Long]
                  :summary "Get pending badge content"
                  (if (= badgeid (get-in req [:session :pending :user-badge-id]))
                    (ok (->> badgeid
                             (b/fetch-badge ctx)
                             (b/badge-issued-and-verified-by-obf ctx)))
                      (not-found)))

             (GET "/issuer/:issuerid" []
                  :return schemas/IssuerContent
                  :path-params [issuerid :- String]
                  :summary "Get issuer details"
                  :current-user current-user
                  (ok (b/get-issuer-endorsements ctx issuerid)))

             (GET "/endorsement/:badgeid" []
                  :return [schemas/Endorsement]
                  :path-params [badgeid :- String]
                  :summary "Get badge endorsements"
                  :current-user current-user
                  (ok (b/get-endorsements ctx badgeid)))

             (GET "/info-embed/:badgeid" []
                  ;:return schemas/UserBadgeContent
                  :path-params [badgeid :- Long]
                  :summary "Get badge for embed view"
                  (let [user-id nil
                        badge (b/get-badge ctx badgeid user-id)
                        badge-owner-id (:owner badge)
                        visibility (:visibility badge)
                        owner? (= user-id badge-owner-id)]
                    (if (= visibility "public")
                      (do
                        (if badge
                          (b/badge-viewed ctx badgeid user-id))
                        (ok (assoc badge :owner? owner?
                                   :user-logged-in? (boolean user-id))))
                      (not-found))))

             (POST "/set_visibility/:badgeid" []
                   :path-params [badgeid :- Long]
                   :body-params [visibility :- (s/enum "private" "public")]
                   :summary "Set badge visibility"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (if (:private current-user)
                     (forbidden)
                     (ok (str (b/set-visibility! ctx badgeid visibility (:id current-user))))))

             (POST "/set_status/:user-badge-id" []
                   :path-params [user-badge-id :- Long]
                   :body-params [status :- (s/enum "accepted" "declined")]
                   :summary "Set badge status"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (str (b/set-status! ctx user-badge-id status (:id current-user)))))

             (POST "/toggle_recipient_name/:badgeid" []
                   :path-params [badgeid :- Long]
                   :body-params [show_recipient_name :- (s/enum false true)]
                   :summary "Set recipient name visibility"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (str (b/toggle-show-recipient-name! ctx badgeid show_recipient_name (:id current-user)))))

             (POST "/toggle_evidence/:badgeid" []
                   :path-params [badgeid :- Long]
                   :body-params [show_evidence :- (s/enum false true)]
                   :summary "Set evidence visibility"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (str (b/toggle-show-evidence! ctx badgeid show_evidence (:id current-user)))))

             (POST "/congratulate/:badgeid" []
                   :return {:status (s/enum "success" "error") :message (s/maybe s/Str)}
                   :path-params [badgeid :- Long]
                   :summary "Congratulate user who received a badge"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (b/congratulate! ctx badgeid (:id current-user))))

             (GET "/export-to-pdf" [badges lang-option]
                   :summary "Export badges to PDF"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (let [badge-ids (map #(Integer/parseInt %)  (vals badges))
                        h (if-not (empty? (rest badge-ids)) (str "attachment; filename=\"badge-collection_"lang-option".pdf\"") (str "attachment; filename=\"badge_"(first badge-ids)"_" lang-option ".pdf\""))]
                     (-> (io/piped-input-stream (pdf/generatePDF ctx (:id current-user) badge-ids lang-option))
                         ok
                         (header "Content-Disposition" h)
                         (header "Content-Type" "application/pdf")
                         )))

             (GET "/export" []
                  :return {:emails [s/Str] :badges [schemas/BadgesToExport]}
                  :summary "Get the badges of a specified user for export"
                  :auth-rules access/signed
                  :current-user current-user
                  (let [emails (i/user-backpack-emails ctx (:id current-user))]
                    (if (:private current-user)
                    (forbidden)
                    (ok {:emails emails :badges (b/user-badges-to-export ctx (:id current-user))}))
                    ))

             (GET "/import" []
                  :return schemas/Import
                  :summary "Fetch badges from Mozilla Backpack to import"
                  :auth-rules access/signed
                  :current-user current-user
                  (if (:private current-user)
                    (forbidden)
                    (ok (i/badges-to-import ctx (:id current-user)))))

             (POST "/import_selected" []
                   ;:return {:errors (s/maybe s/Str)
                   :body-params [keys :- [s/Str]]
                   :summary "Import selected badges from Mozilla Backpack"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (if (:private current-user)
                     (forbidden)
                     (ok (i/do-import ctx (:id current-user) keys))))

             (POST "/upload" []
                   :return schemas/Upload
                   :multipart-params [file :- upload/TempFileUpload]
                   :middleware [upload/wrap-multipart-params]
                   :summary "Upload badge PNG or SVG file"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (if (:private current-user)
                     (forbidden)
                     (ok (i/upload-badge ctx file (:id current-user)))))

             (GET "/settings/:user-badge-id" []
                  ;return schemas/UserBadgeContent
                  :path-params [user-badge-id :- Long]
                  :summary "Get badge settings"
                  :auth-rules access/authenticated
                  :current-user current-user
                  (ok (b/badge-settings ctx user-badge-id (:id current-user))))

             (POST "/save_settings/:badgeid" []
                   :return {:status (s/enum "success" "error")}
                   :path-params [badgeid :- Long]
                   :body-params [visibility :- (s/enum "private" "public" "internal")
                                 evidence-url :- (s/maybe s/Str)
                                 rating :- (s/maybe (s/enum 5 10 15 20 25 30 35 40 45 50))
                                 tags :- (s/maybe [s/Str])]
                   :summary "Save badge settings"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (b/save-badge-settings! ctx badgeid (:id current-user) visibility evidence-url rating tags)))

             (POST "/save_raiting/:badgeid" []
                   :return {:status (s/enum "success" "error")}
                   :path-params [badgeid :- Long]
                   :body-params [rating :- (s/maybe (s/enum 5 10 15 20 25 30 35 40 45 50))]
                   :summary "Save badge raiting"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (b/save-badge-raiting! ctx badgeid (:id current-user) rating)))

             (DELETE "/:badgeid" []
                     :return {:status (s/enum "success" "error") :message (s/maybe s/Str)}
                     :path-params [badgeid :- Long]
                     :summary "Delete badge"
                     :auth-rules access/authenticated
                     :current-user current-user
                     (ok (b/delete-badge! ctx badgeid (:id current-user))))

             (GET "/stats" []
                  :return schemas/BadgeStats
                  :summary "Get badge statistics about badges, badge view counts, congratulations and issuers"
                  :auth-rules access/signed
                  :current-user current-user
                  (ok (b/badge-stats ctx (:id current-user)))))))

(ns salava.badge.routes
  (:require [clojure.pprint :refer [pprint]]
            [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer :all]
            [ring.util.io :as io]
            [ring.swagger.upload :as upload]
            [schema.core :as s]
            [salava.badge.schemas :as schemas] ;cljc
            [salava.badge.main :as b]
            [salava.badge.importer :as i]
            [salava.factory.db :as f]
            [salava.core.layout :as layout]
            [salava.core.access :as access]
            [salava.badge.pdf :as pdf]
            [salava.core.helper :refer [dump]]
            [salava.badge.verify :as v]
            salava.core.restructure))

(defn route-def [ctx]
  (routes
    (context "/badge" []
             (layout/main ctx "/")
             (layout/main ctx "/mybadges")
             (layout/main-meta ctx "/info/:id" :badge)
             (layout/main-meta ctx "/info/:id/embed" :badge)
             (layout/main-meta ctx "/info/:id/pic/embed" :badge)
             (layout/main ctx "/import")
             (layout/main ctx "/export")
             (layout/main ctx "/upload")
             (layout/main ctx "/receive/:id")
             (layout/main ctx "/stats"))

    (context "/obpv1/badge" []
             :tags  ["badge"]
             (GET "/" []
                  :return [schemas/UserBadgeContent]
                  :summary "Get the badges of a current user"
                  :auth-rules access/signed
                  :current-user current-user
                  (do
                    ;(f/save-pending-assertions ctx (:id current-user))
                    (ok (b/user-badges-all ctx (:id current-user)))))

             (GET "/info/:badgeid" []
                  ;:return schemas/UserBadgeContent
                  :path-params [badgeid :- Long]
                  :summary "Get badge"
                  :current-user current-user
                  (let [user-id (:id current-user)
                        badge (b/get-badge ctx badgeid user-id)
                        badge-owner-id (:owner badge)
                        visibility (:visibility badge)
                        owner? (= user-id badge-owner-id)]
                    (if (or (and user-id badge-owner-id owner?)
                            (= visibility "public")
                            (and user-id
                                 (= visibility "internal")))
                      (do
                        (if (and badge (not owner?))
                          (b/badge-viewed ctx badgeid user-id))
                        (ok (assoc badge :owner? owner?
                                         :user-logged-in? (boolean user-id))))
                      (if (and (not user-id) (= visibility "internal"))
                        (unauthorized)
                        (not-found)))))

             (GET "/verify" [assertion_url]
                  :summary "verify badge"
                  :current-user current-user
                  (ok (v/verify-badge ctx assertion_url (:id current-user)))
                  )

             (GET "/pending/:badgeid" req
                  :path-params [badgeid :- Long]
                  :summary "Get pending badge content"
                  (if (= badgeid (get-in req [:session :pending :user-badge-id]))
                    (ok (->> badgeid
                             (b/fetch-badge ctx)
                             (b/badge-issued-and-verified-by-obf ctx)))
                      (not-found)))

             (GET "/issuer/:issuerid" []
                  :return schemas/IssuerContent
                  :path-params [issuerid :- String]
                  :summary "Get issuer details"
                  :current-user current-user
                  (ok (b/get-issuer-endorsements ctx issuerid)))

             (GET "/endorsement/:badgeid" []
                  :return [schemas/Endorsement]
                  :path-params [badgeid :- String]
                  :summary "Get badge endorsements"
                  :current-user current-user
                  (ok (b/get-endorsements ctx badgeid)))

             (GET "/info-embed/:badgeid" []
                  ;:return schemas/UserBadgeContent
                  :path-params [badgeid :- Long]
                  :summary "Get badge for embed view"
                  (let [user-id nil
                        badge (b/get-badge ctx badgeid user-id)
                        badge-owner-id (:owner badge)
                        visibility (:visibility badge)
                        owner? (= user-id badge-owner-id)]
                    (if (= visibility "public")
                      (do
                        (if badge
                          (b/badge-viewed ctx badgeid user-id))
                        (ok (assoc badge :owner? owner?
                                   :user-logged-in? (boolean user-id))))
                      (not-found))))

             (POST "/set_visibility/:badgeid" []
                   :path-params [badgeid :- Long]
                   :body-params [visibility :- (s/enum "private" "public")]
                   :summary "Set badge visibility"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (if (:private current-user)
                     (forbidden)
                     (ok (str (b/set-visibility! ctx badgeid visibility (:id current-user))))))

             (POST "/set_status/:user-badge-id" []
                   :path-params [user-badge-id :- Long]
                   :body-params [status :- (s/enum "accepted" "declined")]
                   :summary "Set badge status"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (str (b/set-status! ctx user-badge-id status (:id current-user)))))

             (POST "/toggle_recipient_name/:badgeid" []
                   :path-params [badgeid :- Long]
                   :body-params [show_recipient_name :- (s/enum false true)]
                   :summary "Set recipient name visibility"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (str (b/toggle-show-recipient-name! ctx badgeid show_recipient_name (:id current-user)))))

             (POST "/toggle_evidence/:badgeid" []
                   :path-params [badgeid :- Long]
                   :body-params [show_evidence :- (s/enum false true)]
                   :summary "Set evidence visibility"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (str (b/toggle-show-evidence! ctx badgeid show_evidence (:id current-user)))))

             (POST "/congratulate/:badgeid" []
                   :return {:status (s/enum "success" "error") :message (s/maybe s/Str)}
                   :path-params [badgeid :- Long]
                   :summary "Congratulate user who received a badge"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (b/congratulate! ctx badgeid (:id current-user))))

             (GET "/export-to-pdf" [badges lang-option]
                   :summary "Export badges to PDF"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (let [badge-ids (map #(Integer/parseInt %)  (vals badges))
                        h (if-not (empty? (rest badge-ids)) (str "attachment; filename=\"badge-collection_"lang-option".pdf\"") (str "attachment; filename=\"badge_"(first badge-ids)"_" lang-option ".pdf\""))]
                     (-> (io/piped-input-stream (pdf/generatePDF ctx (:id current-user) badge-ids lang-option))
                         ok
                         (header "Content-Disposition" h)
                         (header "Content-Type" "application/pdf")
                         )))

             (GET "/export" []
                  :return {:emails [s/Str] :badges [schemas/BadgesToExport]}
                  :summary "Get the badges of a specified user for export"
                  :auth-rules access/signed
                  :current-user current-user
                  (let [emails (i/user-backpack-emails ctx (:id current-user))]
                    (if (:private current-user)
                    (forbidden)
                    (ok {:emails emails :badges (b/user-badges-to-export ctx (:id current-user))}))
                    ))

             (GET "/import" []
                  :return schemas/Import
                  :summary "Fetch badges from Mozilla Backpack to import"
                  :auth-rules access/signed
                  :current-user current-user
                  (if (:private current-user)
                    (forbidden)
                    (ok (i/badges-to-import ctx (:id current-user)))))

             (POST "/import_selected" []
                   ;:return {:errors (s/maybe s/Str)
                   :body-params [keys :- [s/Str]]
                   :summary "Import selected badges from Mozilla Backpack"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (if (:private current-user)
                     (forbidden)
                     (ok (i/do-import ctx (:id current-user) keys))))

             (POST "/upload" []
                   :return schemas/Upload
                   :multipart-params [file :- upload/TempFileUpload]
                   :middleware [upload/wrap-multipart-params]
                   :summary "Upload badge PNG or SVG file"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (if (:private current-user)
                     (forbidden)
                     (ok (i/upload-badge ctx file (:id current-user)))))

             (GET "/settings/:user-badge-id" []
                  ;return schemas/UserBadgeContent
                  :path-params [user-badge-id :- Long]
                  :summary "Get badge settings"
                  :auth-rules access/authenticated
                  :current-user current-user
                  (ok (b/badge-settings ctx user-badge-id (:id current-user))))

             (POST "/save_settings/:badgeid" []
                   :return {:status (s/enum "success" "error")}
                   :path-params [badgeid :- Long]
                   :body-params [visibility :- (s/enum "private" "public" "internal")
                                 evidence-url :- (s/maybe s/Str)
                                 rating :- (s/maybe (s/enum 5 10 15 20 25 30 35 40 45 50))
                                 tags :- (s/maybe [s/Str])]
                   :summary "Save badge settings"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (b/save-badge-settings! ctx badgeid (:id current-user) visibility evidence-url rating tags)))

             (POST "/save_raiting/:badgeid" []
                   :return {:status (s/enum "success" "error")}
                   :path-params [badgeid :- Long]
                   :body-params [rating :- (s/maybe (s/enum 5 10 15 20 25 30 35 40 45 50))]
                   :summary "Save badge raiting"
                   :auth-rules access/authenticated
                   :current-user current-user
                   (ok (b/save-badge-raiting! ctx badgeid (:id current-user) rating)))

             (DELETE "/:badgeid" []
                     :return {:status (s/enum "success" "error") :message (s/maybe s/Str)}
                     :path-params [badgeid :- Long]
                     :summary "Delete badge"
                     :auth-rules access/authenticated
                     :current-user current-user
                     (ok (b/delete-badge! ctx badgeid (:id current-user))))

             (GET "/stats" []
                  :return schemas/BadgeStats
                  :summary "Get badge statistics about badges, badge view counts, congratulations and issuers"
                  :auth-rules access/signed
                  :current-user current-user
                  (ok (b/badge-stats ctx (:id current-user)))))))

add verify route

add verify route