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

(require '[datomic.client.api :as d]
         '[datomic.samples.repl :as repl])
(import '(java.util UUID))

(def client-cfg (read-string (slurp "config.edn")))
(def client (d/client client-cfg))
(def db-name (str "scratch-" (UUID/randomUUID)))
(d/create-database client {:db-name db-name})
(def conn (d/connect client {:db-name db-name}))

(repl/transact-all conn (repl/resource "day-of-datomic-cloud/social-news.edn"))
(def db (d/db conn))

;; find the idents of all schema elements in the system
(sort (d/q '[:find ?ident
             :where [_ :db/ident ?ident]]
           db))

;; find just the attributes
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]]
           db))

;; documentation of a schema element
(d/pull db '[:db/doc] :db.unique/identity)

;; complete details of a schema element
(d/pull db '[*] :user/email)

;; find attributes in the user namespace
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]
             [(namespace ?ident) ?ns]
             [(= ?ns "user")]]
           db))

;; find all reference attributes
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]
             [?e :db/valueType :db.type/ref]]
           db))

;; find all attributes that are cardinality-many
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]
             [?e :db/cardinality :db.cardinality/many]]
           db))

(d/delete-database client {:db-name db-name})

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

(require '[datomic.client.api :as d])

(def client (d/client {:server-type :dev-local
                       :system "datomic-samples"}))
(def conn (d/connect client {:db-name "social-news"}))

(def db (d/db conn))

;; find the idents of all schema elements in the system
(sort (d/q '[:find ?ident
             :where [_ :db/ident ?ident]]
           db))

;; find just the attributes
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]]
           db))

;; documentation of a schema element
(d/pull db '[:db/doc] :db.unique/identity)

;; complete details of a schema element
(d/pull db '[*] :user/email)

;; find attributes in the user namespace
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]
             [(namespace ?ident) ?ns]
             [(= ?ns "user")]]
           db))

;; find all reference attributes
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]
             [?e :db/valueType :db.type/ref]]
           db))

;; find all attributes that are cardinality-many
(sort (d/q '[:find ?ident
             :where
             [?e :db/ident ?ident]
             [_ :db.install/attribute ?e]
             [?e :db/cardinality :db.cardinality/many]]
           db))

move to dev local

move to dev local


(defproject domain "0.1.0-SNAPSHOT"
  :description "CV + RTB"
  :url "http://example.com/OMGLOL"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [ring/ring-jetty-adapter "1.4.0"]
                 [ring/ring-defaults "0.1.5"]
                 [ring/ring-json "0.4.0"]
                 [compojure "1.4.0"]
                 [clj-http "2.0.0"]]
  :plugins [[lein-ring "0.9.7"]]
  :ring {:handler domain.core/app
         :nrepl {:start? true
                 :port 3001}}
  :aot [domain.core])

(defproject domain "0.1.0-SNAPSHOT"
  :description "CV + RTB"
  :url "http://example.com/OMGLOL"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.7.0"]
                 [ring/ring-jetty-adapter "1.4.0"]
                 [ring/ring-defaults "0.1.5"]
                 [ring/ring-json "0.4.0"]
                 [compojure "1.4.0"]
                 [clj-http "2.0.0"]]
  :plugins [[lein-ring "0.9.7"]]
  :ring {:handler domain.core/app
         :nrepl {:start? true
                 :port 3001}}
  :jvm-opts ["-agentlib:jdwp=transport=dt_socket,server=y,suspend=y,address=5005"]
  :aot [domain.core])

Add remote debug JVM param to project.clj


(ns frontend.components.enterprise
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [clojure.string :as str]
            [frontend.async :refer [raise!]]
            [frontend.components.common :as common]
            [frontend.components.plans :as plans-component]
            [frontend.components.shared :as shared]
            [frontend.state :as state]
            [frontend.stefon :as stefon]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.ajax :as ajax]
            [goog.string :as gstr]
            [om.core :as om :include-macros true])
  (:require-macros [frontend.utils :refer [defrender html inspect]]
                   [cljs.core.async.macros :as am :refer [go go-loop alt!]]))

(defn modal [app owner]
  (reify
    om/IRender
    (render [_]
      (html
       [:div#enterpriseModal.fade.hide.modal
        [:div.modal-body
         [:h4
          "Contact us to learn more about enterprise Continuous Delivery"]
         [:hr]
         (om/build shared/contact-form app {:opts {:enterprise? true}})]]))))

(defn arrow [name]
  [:img.arrow {:class name
               :src (utils/cdn-path (str "/img/outer/enterprise/arrow-" name ".svg"))}])

(defn language [name]
  [:img.language {:class name
                  :src (utils/cdn-path (str "/img/outer/languages/language-" name ".svg"))}])

(defn contact-form
  [app owner opts]
  (reify
    om/IInitState
    (init-state [_]
      {:company nil
       :email nil
       :phone nil
       :developer-count nil
       :name nil
       :notice nil})
    om/IRenderState
    (render-state [_ {:keys [email name phone company developer-count notice loading?] :as st}]
      (let [clear-notice! #(om/set-state! owner [:notice] nil)]
        (html
          [:form.form-horizontal {:data-purpose "contact-form"}
           [:div.row.contact-form
            [:div.col-sm-4.col-sm-offset-2
             [:input.input-lg {:value company
                               :type "text"
                               :name "company"
                               :required true
                               :class (when loading? "disabled")
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:company] (.. % -target -value))
                                             true)
                               :placeholder "Company"}]
             [:input.input-lg {:value name
                               :type "text"
                               :name "name"
                               :required true
                               :class (when loading? "disabled")
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:name] (.. % -target -value)))
                               :placeholder "Name"}]
             [:input.input-lg {:value email
                               :type "email"
                               :name "email"
                               :require true
                               :class (when loading? "disabled")
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:email] (.. % -target -value)))
                               :placeholder "Email"}]]
            [:div.col-sm-4
             [:input.input-lg {:value phone
                               :type "text"
                               :name "phone"
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:phone] (.. % -target -value)))
                               :placeholder "Phone"}]
             [:input.input-lg {:value developer-count
                               :type "text"
                               :name "developer-count"
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:developer-count] (.. % -target -value)))
                               :placeholder "# of Developers"}]
             [:div.telephone-info
              "Or call "
              [:a.telephone-number {:href "tel:+14158515247"} "415.851.5247"]
              " for an Enterprise quote."]]]
           [:div.row
            [:div.col-xs-12.text-center
             [:button.btn.btn-cta
              {:on-click #(do (cond
                                (not (utils/valid-email? email))
                                (om/set-state! owner [:notice] {:type "error"
                                                                :message "Please enter a valid email address."})

                                :else
                                (do
                                  (om/set-state! owner [:loading?] true)
                                  (go (let [resp (<! (ajax/managed-form-post
                                                       "/about/contact"
                                                       :params (merge {:name name
                                                                       :email email
                                                                       :message (gstr/format "Company: %s\nPhone: %s\nDeveloper count: %s" company phone developer-count)
                                                                       :enterprise true})))]
                                        (if (= (:status resp) :success)
                                          (om/update-state! owner (fn [s]
                                                                    {:name ""
                                                                     :email ""
                                                                     :phone ""
                                                                     :company ""
                                                                     :developer-count ""
                                                                     :loading? false
                                                                     :notice (:resp resp)}))
                                          (do
                                            (om/set-state! owner [:loading?] false)
                                            (om/set-state! owner [:notice] {:type "error" :message "Sorry! There was an error sending your message."})))))))
                              false)}
              (if loading? "Sending..." "Get More Info")]]]])))))

(defn enterprise [app owner]
  (reify
    om/IRender
    (render [_]
      (html
       [:div#enterprise
        [:div.jumbotron
         (map arrow ["left-a-1"
                     "left-a-2"
                     "left-a-3"
                     "left-a-4"
                     "right-a-1"
                     "right-a-2"
                     "right-a-3"
                     "right-a-4"])
         ;; [:img.arrow {:src (utils/cdn-path "/img/outer/enterprise/arrow-left-a-1.svg")}]
         [:section.container
          [:div.row
           [:article.hero-title.center-block
            [:div.text-center
             [:img.hero-logo {:src (utils/cdn-path "/img/outer/enterprise/logo-circleci.svg")}]]
            [:h1.text-center "Ship code at the speed of business."]
            [:h3.text-center "The same Continuous Integration and Deployment platform that developers love, with added security for the enterprise. CircleCI Enterprise lets you quickly and securely build, test, and deploy your applications."]]]

          [:div.row.text-center
           [:button.btn.btn-cta
            {:on-click #(utils/scroll-to-selector! "form[data-purpose='contact-form']")}
            "Get More Info"]]]]
        ;; need this wrapper for border-top to span the full screen
        [:div.outer-section
         [:div.container
          [:section.row
           [:div.col-xs-4
            [:article
             (common/feature-icon "deploy-1")
             [:h2.text-center "Ship Faster"]
             [:p "The same Continuous Integration and Deployment platform that developers love, with added security for the enterprise. CircleCI Enterprise lets you quickly and securely build, test, and deploy your applications."]]
            ]
           [:div.col-xs-4
            [:article
             (common/feature-icon "security")
             [:h2.text-center "World Class Security"]
             [:p
              "You can run CircleCI Enterprise in your own private cloud or in ours, allowing you to maintain scalability while achieving enterprise level security."]]]
           [:div.col-xs-4
            [:article
             (common/feature-icon "time")
             [:h2.text-center "Focus on What Matters"]
             [:p
              "Time is a valuable resource, so you should focus on what moves the needle for your business. CircleCI removes the pain of managing build machines and scaling your build fleet, allowing developers to focus on what matters."]]]]]]
         [:div.outer-section
          [:div.container
           [:section.row
            [:div.col-xs-8.col-xs-offset-2.enterprise-integrations
             [:h2.text-center "Integrations"]
             [:p "CircleCI is built for unlimited flexibility. From hosting options to test frameworks or programming frameworks, we let you use the technology you need. GitHub Enterprise, Docker, SauceLabs, and many more."]]]
           [:section.row
            [:div.col-xs-4
             [:div.integration-logo.github
              [:img {:src (utils/cdn-path "/img/outer/enterprise/integration-github-1.svg")}]]
             [:div.integration-text
              "Enjoy all of the benefits of CircleCI's rich GitHub integration with your own GitHub Enterprise instance. Authenticate against GitHub Enterprise, see the status of CircleCI builds from your PR pages on GitHub Enterprise, and easily navigate to specific GitHub PRs and commits from CircleCI build pages."
              ;; TODO: add integrations page for GitHub
              ; [:a.integration-learn-more {:href "/integrations"} "Learn more"]
              ]]
            [:div.col-xs-4
             [:div.integration-logo.docker
              [:img {:src (utils/cdn-path "/img/outer/enterprise/integration-docker-1.svg")}]]
             [:div.integration-text
              "CircleCI Enterprise supports all of the container-oriented features Docker has to offer. Pull down base images from any registry, build your own Dockerfiles right in CircleCI, link containers together and run integration tests, and push built Docker images to production - all driven by CircleCI's simple yaml-based configuration and intuitive UI."
              [:a.integration-learn-more {:href "/integrations/docker"} "Learn more"]]]
            [:div.col-xs-4
             [:div.integration-logo.sauce-labs
              [:img {:src (utils/cdn-path "/img/outer/enterprise/integration-sauce-1.png")}]]
             [:div.integration-text
              "Test against any version of any browser with CircleCI's Enterprise SauceLabs integration. Using the Sauce Connect tunnel, you can even test applications running securely within CircleCI build containers behind your firewall. Automate your cross-browser and mobile testing."
              ;; TODO: add integrations page for Sauce Labs
              [:a.integration-learn-more {:href "/integrations/saucelabs"} "Learn more"]]]]]]
        [:section.enterprise-story
          (map language ["rails-2"
                         "clojure-2"
                         "java-2"
                         "php-2"])
         [:div.container
          [:div.row
           [:div.col-xs-8.col-xs-offset-2
            [:img.story-logo {:src (utils/cdn-path "/img/outer/customers/customer-shopify.svg")}]
            [:blockquote
             "CircleCI lets us be more agile and ship product faster. We can focus on delivering value to our customers, not maintaining CI Infrastructure."
             [:footer
              [:strong "John Duff"]
              ", Director of Engineering at "
              [:strong "Shopify"]
              [:br]
              [:cite
               [:a {:href "/stories/shopify"} "Read the Story"]]]]]]]]

        [:div.outer-section
         [:section.container
          (common/feature-icon "phone")
          [:h2.text-center "Learn More About CircleCI Enterprise"]
          [:div.enterprise-cta-contact
           (om/build contact-form app)]]]]))))

(ns frontend.components.enterprise
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [clojure.string :as str]
            [frontend.async :refer [raise!]]
            [frontend.components.common :as common]
            [frontend.components.plans :as plans-component]
            [frontend.components.shared :as shared]
            [frontend.state :as state]
            [frontend.stefon :as stefon]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.ajax :as ajax]
            [goog.string :as gstr]
            [om.core :as om :include-macros true])
  (:require-macros [frontend.utils :refer [defrender html inspect]]
                   [cljs.core.async.macros :as am :refer [go go-loop alt!]]))

(defn modal [app owner]
  (reify
    om/IRender
    (render [_]
      (html
       [:div#enterpriseModal.fade.hide.modal
        [:div.modal-body
         [:h4
          "Contact us to learn more about enterprise Continuous Delivery"]
         [:hr]
         (om/build shared/contact-form app {:opts {:enterprise? true}})]]))))

(defn arrow [name]
  [:img.arrow {:class name
               :src (utils/cdn-path (str "/img/outer/enterprise/arrow-" name ".svg"))}])

(defn language [name]
  [:img.background.language {:class name
                             :src (utils/cdn-path (str "/img/outer/languages/language-" name ".svg"))}])

(defn contact-form
  [app owner opts]
  (reify
    om/IInitState
    (init-state [_]
      {:company nil
       :email nil
       :phone nil
       :developer-count nil
       :name nil
       :notice nil})
    om/IRenderState
    (render-state [_ {:keys [email name phone company developer-count notice loading?] :as st}]
      (let [clear-notice! #(om/set-state! owner [:notice] nil)]
        (html
          [:form.form-horizontal {:data-purpose "contact-form"}
           [:div.row.contact-form
            [:div.col-sm-4.col-sm-offset-2
             [:input.input-lg {:value company
                               :type "text"
                               :name "company"
                               :required true
                               :class (when loading? "disabled")
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:company] (.. % -target -value))
                                             true)
                               :placeholder "Company"}]
             [:input.input-lg {:value name
                               :type "text"
                               :name "name"
                               :required true
                               :class (when loading? "disabled")
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:name] (.. % -target -value)))
                               :placeholder "Name"}]
             [:input.input-lg {:value email
                               :type "email"
                               :name "email"
                               :require true
                               :class (when loading? "disabled")
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:email] (.. % -target -value)))
                               :placeholder "Email"}]]
            [:div.col-sm-4
             [:input.input-lg {:value phone
                               :type "text"
                               :name "phone"
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:phone] (.. % -target -value)))
                               :placeholder "Phone"}]
             [:input.input-lg {:value developer-count
                               :type "text"
                               :name "developer-count"
                               :on-change #(do
                                             (clear-notice!)
                                             (om/set-state! owner [:developer-count] (.. % -target -value)))
                               :placeholder "# of Developers"}]
             [:div.telephone-info
              "Or call "
              [:a.telephone-number {:href "tel:+14158515247"} "415.851.5247"]
              " for an Enterprise quote."]]]
           [:div.row
            [:div.col-xs-12.text-center
             [:button.btn.btn-cta
              {:on-click #(do (cond
                                (not (utils/valid-email? email))
                                (om/set-state! owner [:notice] {:type "error"
                                                                :message "Please enter a valid email address."})

                                :else
                                (do
                                  (om/set-state! owner [:loading?] true)
                                  (go (let [resp (<! (ajax/managed-form-post
                                                       "/about/contact"
                                                       :params (merge {:name name
                                                                       :email email
                                                                       :message (gstr/format "Company: %s\nPhone: %s\nDeveloper count: %s" company phone developer-count)
                                                                       :enterprise true})))]
                                        (if (= (:status resp) :success)
                                          (om/update-state! owner (fn [s]
                                                                    {:name ""
                                                                     :email ""
                                                                     :phone ""
                                                                     :company ""
                                                                     :developer-count ""
                                                                     :loading? false
                                                                     :notice (:resp resp)}))
                                          (do
                                            (om/set-state! owner [:loading?] false)
                                            (om/set-state! owner [:notice] {:type "error" :message "Sorry! There was an error sending your message."})))))))
                              false)}
              (if loading? "Sending..." "Get More Info")]]]])))))

(defn enterprise [app owner]
  (reify
    om/IRender
    (render [_]
      (html
       [:div#enterprise
        [:div.jumbotron
         (map arrow ["left-a-1"
                     "left-a-2"
                     "left-a-3"
                     "left-a-4"
                     "right-a-1"
                     "right-a-2"
                     "right-a-3"
                     "right-a-4"])
         ;; [:img.arrow {:src (utils/cdn-path "/img/outer/enterprise/arrow-left-a-1.svg")}]
         [:section.container
          [:div.row
           [:article.hero-title.center-block
            [:div.text-center
             [:img.hero-logo {:src (utils/cdn-path "/img/outer/enterprise/logo-circleci.svg")}]]
            [:h1.text-center "Ship code at the speed of business."]
            [:h3.text-center "The same Continuous Integration and Deployment platform that developers love, with added security for the enterprise. CircleCI Enterprise lets you quickly and securely build, test, and deploy your applications."]]]

          [:div.row.text-center
           [:button.btn.btn-cta
            {:on-click #(utils/scroll-to-selector! "form[data-purpose='contact-form']")}
            "Get More Info"]]]]
        ;; need this wrapper for border-top to span the full screen
        [:div.outer-section
         [:div.container
          [:section.row
           [:div.col-xs-4
            [:article
             (common/feature-icon "deploy-1")
             [:h2.text-center "Ship Faster"]
             [:p "The same Continuous Integration and Deployment platform that developers love, with added security for the enterprise. CircleCI Enterprise lets you quickly and securely build, test, and deploy your applications."]]
            ]
           [:div.col-xs-4
            [:article
             (common/feature-icon "security")
             [:h2.text-center "World Class Security"]
             [:p
              "You can run CircleCI Enterprise in your own private cloud or in ours, allowing you to maintain scalability while achieving enterprise level security."]]]
           [:div.col-xs-4
            [:article
             (common/feature-icon "time")
             [:h2.text-center "Focus on What Matters"]
             [:p
              "Time is a valuable resource, so you should focus on what moves the needle for your business. CircleCI removes the pain of managing build machines and scaling your build fleet, allowing developers to focus on what matters."]]]]]]
         [:div.outer-section
          [:div.container
           [:section.row
            [:div.col-xs-8.col-xs-offset-2.enterprise-integrations
             [:h2.text-center "Integrations"]
             [:p "CircleCI is built for unlimited flexibility. From hosting options to test frameworks or programming frameworks, we let you use the technology you need. GitHub Enterprise, Docker, SauceLabs, and many more."]]]
           [:section.row
            [:div.col-xs-4
             [:div.integration-logo.github
              [:img {:src (utils/cdn-path "/img/outer/enterprise/integration-github-1.svg")}]]
             [:div.integration-text
              "Enjoy all of the benefits of CircleCI's rich GitHub integration with your own GitHub Enterprise instance. Authenticate against GitHub Enterprise, see the status of CircleCI builds from your PR pages on GitHub Enterprise, and easily navigate to specific GitHub PRs and commits from CircleCI build pages."
              ;; TODO: add integrations page for GitHub
              ; [:a.integration-learn-more {:href "/integrations"} "Learn more"]
              ]]
            [:div.col-xs-4
             [:div.integration-logo.docker
              [:img {:src (utils/cdn-path "/img/outer/enterprise/integration-docker-1.svg")}]]
             [:div.integration-text
              "CircleCI Enterprise supports all of the container-oriented features Docker has to offer. Pull down base images from any registry, build your own Dockerfiles right in CircleCI, link containers together and run integration tests, and push built Docker images to production - all driven by CircleCI's simple yaml-based configuration and intuitive UI."
              [:a.integration-learn-more {:href "/integrations/docker"} "Learn more"]]]
            [:div.col-xs-4
             [:div.integration-logo.sauce-labs
              [:img {:src (utils/cdn-path "/img/outer/enterprise/integration-sauce-1.png")}]]
             [:div.integration-text
              "Test against any version of any browser with CircleCI's Enterprise SauceLabs integration. Using the Sauce Connect tunnel, you can even test applications running securely within CircleCI build containers behind your firewall. Automate your cross-browser and mobile testing."
              ;; TODO: add integrations page for Sauce Labs
              [:a.integration-learn-more {:href "/integrations/saucelabs"} "Learn more"]]]]]]
        [:section.enterprise-story
          (map language ["rails-2"
                         "clojure-2"
                         "java-2"
                         "php-2"])
         [:div.container
          [:div.row
           [:div.col-xs-8.col-xs-offset-2
            [:img.story-logo {:src (utils/cdn-path "/img/outer/customers/customer-shopify.svg")}]
            [:blockquote
             "CircleCI lets us be more agile and ship product faster. We can focus on delivering value to our customers, not maintaining CI Infrastructure."
             [:footer
              [:strong "John Duff"]
              ", Director of Engineering at "
              [:strong "Shopify"]
              [:br]
              [:cite
               [:a {:href "/stories/shopify"} "Read the Story"]]]]]]]]

        [:div.outer-section
         [:section.container
          (common/feature-icon "phone")
          [:h2.text-center "Learn More About CircleCI Enterprise"]
          [:div.enterprise-cta-contact
           (om/build contact-form app)]]]]))))

Generalize background css to be not just for /enterprise


(ns {{name}}.queue
  (:require [langohr.core :as rmq]
            [kehaar.rabbitmq]
            [kehaar.configured :as kehaar]))

(defn initialize [{:keys [connection kehaar]}]
  (let [max-retries 5
        rmq-conn (kehaar.rabbitmq/connect-with-retries connection max-retries)
        kehaar-resources (kehaar/init! rmq-conn kehaar)]
    {:connections [connection]
     :kehaar-resources kehaar-resources}))

(defn close-resources! [resources]
  (doseq [resource resources]
    (when-not (rmq/closed? resource) (rmq/close resource))))

(defn close-all! [{:keys [connections kehaar-resources]}]
  (kehaar/shutdown! kehaar-resources)
  (close-resources! connections))

(ns {{name}}.queue
  (:require [langohr.core :as rmq]
            [kehaar.rabbitmq]
            [kehaar.configured :as kehaar]))

(defn initialize [{:keys [connection kehaar]}]
  (let [max-retries 5
        rmq-conn (kehaar.rabbitmq/connect-with-retries connection max-retries)
        kehaar-resources (kehaar/init! rmq-conn kehaar)]
    {:connections [rmq-conn]
     :kehaar-resources kehaar-resources}))

(defn close-resources! [resources]
  (doseq [resource resources]
    (when-not (rmq/closed? resource) (rmq/close resource))))

(defn close-all! [{:keys [connections kehaar-resources]}]
  (kehaar/shutdown! kehaar-resources)
  (close-resources! connections))

Return the actual rmq-connection

Return the actual rmq-connection


(ns atom-finder.questions.comment-counts
  (:require
   [atom-finder.util :refer :all]
   [atom-finder.constants :refer :all]
   [atom-finder.classifier :refer :all]
;   [atom-finder.location-dump :refer :all]
   [atom-finder.questions.question-util :refer :all]
   [clojure.pprint :refer [pprint]]
   [clojure.set :as set]
   [schema.core :as s]
   [clojure.data.csv :as csv]
   [clojure.string :as str]
   )
  (:import
   [org.eclipse.cdt.core.dom.ast IASTNode]
   )
  )

(defn separate-by-function
  [records] ; {:type :omitted-curly-braces, :start-line 245, :end-line 246, :offset 10887, :length 104, :path [12 2 0]}

  (let [[functions others] (separate #(= :function (:type %)) records)
        in-function? (->> functions
                          (map (fn [m] [(:start m) (:end m)]))
                          fn-range-set-cc)]
    (separate #(in-function? (:start %)) others)))

(defn not-in-function-by-node
  "A set of all the AST nodes not inside a function"
  [root]
  (if (function-node? root)
    #{}
    (apply clojure.set/union (conj (map not-in-function-by-node (children root)) #{root}))))

(defn function-nodes
  [node]
   (if (function-node? node)
     (list node)
     (mapcat function-nodes (children node))))

(def node-offset-range (juxt offset end-offset))

(defn node-range-set
  "create a cc range-set from a list of nodes"
  [nodes]
  (->> nodes
       (map node-offset-range)
       (filter (partial every? identity))))

(defn function-offset-ranges
  "the closed ranges of what function definitions live"
  [root]
  (node-range-set (function-nodes root)))

(def function-offset-range-set (comp fn-range-set-cc function-offset-ranges))

(defn nodes-near-comments-by-function
  "find all AST nodes near comments and
   categorize them by whether their in a function"
  [root]
  (let [comment-proximity-lines 1 ; how far away from a comment is still "commented"
        comments (all-comments root)
        function-offset-set (function-offset-range-set root)
        in-function-offset? #(and (not (function-node? %1))
                                  (offset %1)
                                  (function-offset-set (offset %1)))
        all-nodes  (potential-atom-nodes root)
        all-node-lines (set (mapcat (juxt start-line end-line) all-nodes))
        inline-comment? #(all-node-lines (start-line %)) ; does a comment appear on the same line as an AST node
        [fn-comments global-comments] (separate in-function-offset? comments)
        [fn-comment-line-set global-comment-line-set] (for [comments [fn-comments global-comments]]
                                                        (->> comments ; the lines this comment is likely talking about
                                                           (map (fn [cmnt]
                                                                  (if (inline-comment? cmnt)
                                                                    [(start-line cmnt) (+ (end-line cmnt) comment-proximity-lines)]
                                                                    [(start-line cmnt) (end-line cmnt)])))
                                                           fn-range-set-cc))
        ]
    (->> all-nodes
         (concat (all-preprocessor root))
         (filter offset)
         (map (fn [node]
                {node
                 {:in-function? (in-function-offset? node)
                  :comment ((if (in-function-offset? node) fn-comment-line-set  global-comment-line-set) (start-line node))
                  ;:line (start-line node)
                  }}))
         (into {}))
    ))

(defn atoms-by-comments&function
  "Classify every node by whether its an atom,
   inside a function, and described by a comment"
  [root]
  (let [file (filename root)
        fn-cmnts (nodes-near-comments-by-function root)
        all-atoms (->> root find-all-atoms (mapcat (fn [[atm nodes]] (map #(vector atm %) nodes))))
        atom-cmnts     (map (fn [[atom-name node]] (merge {:file file :node node :atom atom-name} (fn-cmnts node))) all-atoms)
        non-atom-cmnts (map (fn [[node   fn-cmnt]] (merge {:file file :node node :atom nil} fn-cmnt)) (apply dissoc fn-cmnts (map second all-atoms)))
        ]

    (concat atom-cmnts non-atom-cmnts)
    ))

;; 33 hours
'((->> "~/opt/src/atom-finder"
       expand-home
       list-dirs
       (map str)
       (mapcat (fn [dir]
                 (->> dir
                    (pmap-dir-trees atoms-by-comments&function)
                    (mapcat (fn [file-nodes]
                           (->> file-nodes
                                (map #(assoc %
                                             ;:atom (or (:atom %) (->> % :node typename))
                                             ;:proj (str/replace dir #".*\/" "")
                                             :file (->> % :file atom-finder.questions.all-nodes/atom-finder-relative-path)
                                             ;:line (->> % :node start-line)
                                             ))
                                     (map (partial-right dissoc :node))
                                     frequencies
                                     )))
                    )))
       ;(take 2)
       ;frequencies
       (map prn)
       dorun
       (log-to "tmp/comment-counts_2018-01-30_01_potential-atom-nodes_memory.edn")
       time-mins
   ))

'((->> "tmp/comment-counts_2018-01-27_01_proximity-1-line.edn"
      read-lines
      (map (fn [[[proj in-function comment atom] count]]
             {:proj proj :in-function (boolean in-function)
              :comment (boolean comment) :atom (some-> atom name) :count count}))
      (maps-to-csv "tmp/comment-counts_2018-01-27_01_proximity-1-line.csv")
 ))

;; Find only literal-encoding in mongo
'((->>"~/opt/src/atom-finder/"
       expand-home
       (pmap-dir-trees atoms-by-comments&function)
       flatten
       (filter #(and (:atom %) (true? (:comment %))))
       (map (fn [h]
              (let [[no-node {node :node}] (split-map-by-keys h [:node])]
                (merge no-node {:line (start-line node) :file (filename node) :node (write-tree node)}))))
       (map prn)
       ;(take 20)
       dorun
       (log-to "tmp/comment-counts_2018-01-26_01_proximity-1-line.edn")
       time-mins
   ))

(ns atom-finder.questions.comment-counts
  (:require
   [atom-finder.util :refer :all]
   [atom-finder.constants :refer :all]
   [atom-finder.classifier :refer :all]
;   [atom-finder.location-dump :refer :all]
   [atom-finder.questions.question-util :refer :all]
   [clojure.pprint :refer [pprint]]
   [clojure.set :as set]
   [schema.core :as s]
   [clojure.data.csv :as csv]
   [clojure.string :as str]
   )
  (:import
   [org.eclipse.cdt.core.dom.ast IASTNode]
   )
  )

(defn separate-by-function
  [records] ; {:type :omitted-curly-braces, :start-line 245, :end-line 246, :offset 10887, :length 104, :path [12 2 0]}

  (let [[functions others] (separate #(= :function (:type %)) records)
        in-function? (->> functions
                          (map (fn [m] [(:start m) (:end m)]))
                          fn-range-set-cc)]
    (separate #(in-function? (:start %)) others)))

(defn not-in-function-by-node
  "A set of all the AST nodes not inside a function"
  [root]
  (if (function-node? root)
    #{}
    (apply clojure.set/union (conj (map not-in-function-by-node (children root)) #{root}))))

(defn function-nodes
  [node]
   (if (function-node? node)
     (list node)
     (mapcat function-nodes (children node))))

(def node-offset-range (juxt offset end-offset))

(defn node-range-set
  "create a cc range-set from a list of nodes"
  [nodes]
  (->> nodes
       (map node-offset-range)
       (filter (partial every? identity))))

(defn function-offset-ranges
  "the closed ranges of what function definitions live"
  [root]
  (node-range-set (function-nodes root)))

(def function-offset-range-set (comp fn-range-set-cc function-offset-ranges))

(defn nodes-near-comments-by-function
  "find all AST nodes near comments and
   categorize them by whether their in a function"
  [root]
  (let [comment-proximity-lines 1 ; how far away from a comment is still "commented"
        comments (all-comments root)
        function-offset-set (function-offset-range-set root)
        in-function-offset? #(and (not (function-node? %1))
                                  (offset %1)
                                  (function-offset-set (offset %1)))
        all-nodes  (potential-atom-nodes root)
        all-node-lines (set (mapcat (juxt start-line end-line) all-nodes))
        inline-comment? #(all-node-lines (start-line %)) ; does a comment appear on the same line as an AST node
        [fn-comments global-comments] (separate in-function-offset? comments)
        [fn-comment-line-set global-comment-line-set] (for [comments [fn-comments global-comments]]
                                                        (->> comments ; the lines this comment is likely talking about
                                                           (map (fn [cmnt]
                                                                  (if (inline-comment? cmnt)
                                                                    [(start-line cmnt) (+ (end-line cmnt) comment-proximity-lines)]
                                                                    [(start-line cmnt) (end-line cmnt)])))
                                                           fn-range-set-cc))
        ]
    (->> all-nodes
         (concat (all-preprocessor root))
         (filter offset)
         (map (fn [node]
                {node
                 {:in-function? (in-function-offset? node)
                  :comment ((if (in-function-offset? node) fn-comment-line-set  global-comment-line-set) (start-line node))
                  ;:line (start-line node)
                  }}))
         (into {}))
    ))

(defn atoms-by-comments&function
  "Classify every node by whether its an atom,
   inside a function, and described by a comment"
  [root]
  (let [file (filename root)
        fn-cmnts (nodes-near-comments-by-function root)
        all-atoms (->> root find-all-atoms (mapcat (fn [[atm nodes]] (map #(vector atm %) nodes))))
        atom-cmnts     (map (fn [[atom-name node]] (merge {:file file :node node :atom atom-name} (fn-cmnts node))) all-atoms)
        non-atom-cmnts (map (fn [[node   fn-cmnt]] (merge {:file file :node node :atom nil} fn-cmnt)) (apply dissoc fn-cmnts (map second all-atoms)))
        ]

    (concat atom-cmnts non-atom-cmnts)
    ))

;; 33 hours
'((->> "~/opt/src/atom-finder"
       expand-home
       list-dirs
       (map str)
       (mapcat (fn [dir]
                 (->> dir
                    (pmap-dir-trees atoms-by-comments&function)
                    (mapcat (fn [file-nodes]
                           (->> file-nodes
                                (map #(assoc %
                                             ;:atom (or (:atom %) (->> % :node typename))
                                             ;:proj (str/replace dir #".*\/" "")
                                             :file (->> % :file atom-finder.questions.all-nodes/atom-finder-relative-path)
                                             ;:line (->> % :node start-line)
                                             ))
                                     (map (partial-right dissoc :node))
                                     frequencies
                                     )))
                    )))
       ;(take 2)
       ;frequencies
       (map prn)
       dorun
       (log-to "tmp/comment-counts_2018-10-05_01_filter-better-extensions.edn")
       time-mins
   ))

'((->> "tmp/comment-counts_2018-01-27_01_proximity-1-line.edn"
      read-lines
      (map (fn [[[proj in-function comment atom] count]]
             {:proj proj :in-function (boolean in-function)
              :comment (boolean comment) :atom (some-> atom name) :count count}))
      (maps-to-csv "tmp/comment-counts_2018-01-27_01_proximity-1-line.csv")
 ))

;; Find only literal-encoding in mongo
'((->>"~/opt/src/atom-finder/"
       expand-home
       (pmap-dir-trees atoms-by-comments&function)
       flatten
       (filter #(and (:atom %) (true? (:comment %))))
       (map (fn [h]
              (let [[no-node {node :node}] (split-map-by-keys h [:node])]
                (merge no-node {:line (start-line node) :file (filename node) :node (write-tree node)}))))
       (map prn)
       ;(take 20)
       dorun
       (log-to "tmp/comment-counts_2018-01-26_01_proximity-1-line.edn")
       time-mins
   ))

bring comment-counts filename up to date


(ns lens.api
  (:use plumbing.core)
  (:require [clojure.core.async :refer [go <!]]
            [clojure.tools.logging :as log]
            [hap-client.core :as hap]
            [async-error.core :refer [<? go-try]]
            [schema.core :as s]))

;; ---- Schema ----------------------------------------------------------------

(def SD
  {:data {:name s/Str :version s/Str s/Any s/Any}
   s/Any s/Any})

;; ---- Helper ----------------------------------------------------------------

(defn- query [doc id]
  (or (-> doc :queries id)
      (log/error "Can't find query" id "in" (keys (:queries doc)))))

(defn- form [doc id]
  (or (-> doc :forms id)
      (log/error "Can't find form" id "in" (keys (:forms doc)))))

(defn update-rep!
  "Returns a channel conveying the updated representation or any errors."
  [rep changes]
  (let [edited (merge rep {:data (dissoc changes :type)})]
    (when (not= rep edited)
      (hap/update (:self (:links rep)) edited))
    (go rep)))

(defn upsert! [find-query create-form {:keys [id] :as data}]
  {:pre [find-query id]}
  (go-try
    (let [result (<! (hap/query find-query {:id id}))]
      (if (instance? Throwable result)
        (if (= 404 (:status (ex-data result)))
          (<? (hap/fetch (<? (hap/create create-form data))))
          (throw result))
        (<? (update-rep! result data))))))

(defn create-ref! [find-query create-form data]
  (go-try
    (let [result (<! (hap/query find-query data))]
      (if (instance? Throwable result)
        (if (= 404 (:status (ex-data result)))
          (<? (hap/fetch (<? (hap/create create-form data))))
          (throw result))
        result))))

;; ---- Study -----------------------------------------------------------------

(s/defn upsert-study! [service-document :- SD study-data]
  (upsert! (query service-document :lens/find-study)
           (form service-document :lens/create-study)
           study-data))

;; ---- Study Event Def -------------------------------------------------------

(defn upsert-study-event-def! [study study-event-data]
  {:pre [study (:id study-event-data)]}
  (upsert! (query study :lens/find-study-event-def)
           (form study :lens/create-study-event-def)
           study-event-data))

;; ---- Form Ref --------------------------------------------------------------

(defn create-form-ref! [study-event-def {:keys [form-id]}]
  {:pre [study-event-def form-id]}
  (create-ref! (query study-event-def :lens/find-form-ref)
               (form study-event-def :lens/create-form-ref)
               {:form-id form-id}))

;; ---- Form Def --------------------------------------------------------------

(defn upsert-form-def! [study form-data]
  {:pre [study (:id form-data)]}
  (upsert! (query study :lens/find-form-def)
           (form study :lens/create-form-def)
           (dissoc form-data :study-id)))

;; ---- Item Group Ref --------------------------------------------------------

(defn create-item-group-ref! [form-def {:keys [item-group-id]}]
  {:pre [form-def item-group-id]}
  (create-ref! (query form-def :lens/find-item-group-ref)
               (form form-def :lens/create-item-group-ref)
               {:item-group-id item-group-id}))

;; ---- Item Group Def --------------------------------------------------------

(defn upsert-item-group-def! [study item-group-data]
  {:pre [study (:id item-group-data)]}
  (upsert! (query study :lens/find-item-group-def)
           (form study :lens/create-item-group-def)
           (dissoc item-group-data :study-id)))

;; ---- Item Ref --------------------------------------------------------

(defn create-item-ref! [item-group-def {:keys [item-id]}]
  {:pre [item-group-def item-id]}
  (create-ref! (query item-group-def :lens/find-item-ref)
               (form item-group-def :lens/create-item-ref)
               {:item-id item-id}))

;; ---- Item Def --------------------------------------------------------

(defn upsert-item-def! [study item-data]
  {:pre [study (:id item-data)]}
  (upsert! (query study :lens/find-item-def)
           (form study :lens/create-item-def)
           (dissoc item-data :study-id)))

(ns lens.api
  (:use plumbing.core)
  (:require [clojure.core.async :refer [go <!]]
            [clojure.tools.logging :as log]
            [hap-client.core :as hap]
            [async-error.core :refer [<? go-try]]
            [schema.core :as s]))

;; ---- Schema ----------------------------------------------------------------

(def SD
  {:data {:name s/Str :version s/Str s/Any s/Any}
   s/Any s/Any})

;; ---- Helper ----------------------------------------------------------------

(defn- query [doc id]
  (or (-> doc :queries id)
      (log/error "Can't find query" id "in" (keys (:queries doc)))))

(defn- form [doc id]
  (or (-> doc :forms id)
      (log/error "Can't find form" id "in" (keys (:forms doc)))))

(defn update-rep!
  "Returns a channel conveying the updated representation or any errors."
  [rep changes]
  (let [edited (merge rep {:data (dissoc changes :type)})]
    (if (not= rep edited)
      (hap/update (:self (:links rep)) edited)
      (go rep))))

(defn upsert! [find-query create-form {:keys [id] :as data}]
  {:pre [find-query id]}
  (go-try
    (let [result (<! (hap/query find-query {:id id}))]
      (if (instance? Throwable result)
        (if (= 404 (:status (ex-data result)))
          (<? (hap/fetch (<? (hap/create create-form data))))
          (throw result))
        (<? (update-rep! result data))))))

(defn create-ref! [find-query create-form data]
  (go-try
    (let [result (<! (hap/query find-query data))]
      (if (instance? Throwable result)
        (if (= 404 (:status (ex-data result)))
          (<? (hap/fetch (<? (hap/create create-form data))))
          (throw result))
        result))))

;; ---- Study -----------------------------------------------------------------

(s/defn upsert-study! [service-document :- SD study-data]
  (upsert! (query service-document :lens/find-study)
           (form service-document :lens/create-study)
           study-data))

;; ---- Study Event Def -------------------------------------------------------

(defn upsert-study-event-def! [study study-event-data]
  {:pre [study (:id study-event-data)]}
  (upsert! (query study :lens/find-study-event-def)
           (form study :lens/create-study-event-def)
           study-event-data))

;; ---- Form Ref --------------------------------------------------------------

(defn create-form-ref! [study-event-def {:keys [form-id]}]
  {:pre [study-event-def form-id]}
  (create-ref! (query study-event-def :lens/find-form-ref)
               (form study-event-def :lens/create-form-ref)
               {:form-id form-id}))

;; ---- Form Def --------------------------------------------------------------

(defn upsert-form-def! [study form-data]
  {:pre [study (:id form-data)]}
  (upsert! (query study :lens/find-form-def)
           (form study :lens/create-form-def)
           (dissoc form-data :study-id)))

;; ---- Item Group Ref --------------------------------------------------------

(defn create-item-group-ref! [form-def {:keys [item-group-id]}]
  {:pre [form-def item-group-id]}
  (create-ref! (query form-def :lens/find-item-group-ref)
               (form form-def :lens/create-item-group-ref)
               {:item-group-id item-group-id}))

;; ---- Item Group Def --------------------------------------------------------

(defn upsert-item-group-def! [study item-group-data]
  {:pre [study (:id item-group-data)]}
  (upsert! (query study :lens/find-item-group-def)
           (form study :lens/create-item-group-def)
           (dissoc item-group-data :study-id)))

;; ---- Item Ref --------------------------------------------------------

(defn create-item-ref! [item-group-def {:keys [item-id]}]
  {:pre [item-group-def item-id]}
  (create-ref! (query item-group-def :lens/find-item-ref)
               (form item-group-def :lens/create-item-ref)
               {:item-id item-id}))

;; ---- Item Def --------------------------------------------------------

(defn upsert-item-def! [study item-data]
  {:pre [study (:id item-data)]}
  (upsert! (query study :lens/find-item-def)
           (form study :lens/create-item-def)
           (dissoc item-data :study-id)))

Fix Error Hiding on Update

Fix Error Hiding on Update


(ns ambly.repl.jsc
  (:require [clojure.string :as string]
            [clojure.java.io :as io]
            [cljs.analyzer :as ana]
            [cljs.util :as util]
            [cljs.compiler :as comp]
            [cljs.repl :as repl]
            [cljs.closure :as closure]
            [clojure.data.json :as json]
            [clojure.java.shell :as shell])
  (:import java.net.Socket
           java.lang.StringBuilder
           [java.io File BufferedReader BufferedWriter IOException]
           (javax.jmdns JmDNS ServiceListener)))

(defn set-logging-level [logger-name level]
  (.setLevel (java.util.logging.Logger/getLogger logger-name) level))

(defn service-name->display-name [service-name]
  (subs service-name (count "Ambly WebDAV Server on ")))

(defn service-map->choice-list [service-map]
  (map vector (iterate inc 1) service-map))

(defn print-services [service-map]
  (doseq [[choice-number [service-name _]] (service-map->choice-list service-map)]
    (println (str "[" choice-number "] " (service-name->display-name service-name)))))

(defn discover-and-pick-ambly-instance
  "Looks for Ambly WebDAV services advertised via Bonjour and presents
  a simple command-line UI letting user pick one."
  []
  (let [reg-type "_http._tcp.local."
        discovered-services (atom (sorted-map))
        mdns-service (JmDNS/create)
        service-listener
        (reify ServiceListener
          (serviceAdded [_ service-event]
            (let [name (.getName service-event)]
              (when (.startsWith name "Ambly WebDAV Server")
                (.requestServiceInfo mdns-service (.getType service-event) (.getName service-event) 1))))
          (serviceRemoved [_ service-event]
            (swap! discovered-services dissoc (.getName service-event)))
          (serviceResolved [_ service-event]
            (let [entry {(.getName service-event)
                         (let [info (.getInfo service-event)]
                           {:address (.getAddress info)
                            :port    (.getPort info)})}]
              (swap! discovered-services merge entry))))]
    (try
      (.addServiceListener mdns-service reg-type service-listener)
      (loop [count 0]
        (when (empty? @discovered-services)
          (Thread/sleep 100)
          (when (= 1000 count)
            (println "\nSearching ..."))
          (recur (inc count))))
      (Thread/sleep 500)                                    ;; Sleep a little more to catch stragglers
      (loop [current-discovered-services @discovered-services]
        (println)
        (print-services current-discovered-services)
        (println "\n[r] Refresh\n")
        (print "Choice: ")
        (flush)
        (let [choice (read-line)]
          (if (= "r" choice)
            (recur @discovered-services)
            (let [choices (service-map->choice-list current-discovered-services)
                  choice-ndx (try (dec (Long/parseLong choice)) (catch NumberFormatException _ nil))]
              (if (< -1 choice-ndx (count choices))
                (second (nth choices choice-ndx))
                (recur current-discovered-services))))))
      (finally
        (future
          (.removeServiceListener mdns-service reg-type service-listener)
          (.close mdns-service))))))

(defn socket [host port]
  (let [socket (Socket. host port)
        in     (io/reader socket)
        out    (io/writer socket)]
    {:socket socket :in in :out out}))

(defn close-socket [s]
  (.close (:socket s)))

(defn write [^BufferedWriter out ^String js]
  (.write out js)
  (.write out (int 0)) ;; terminator
  (.flush out))

(defn read-messages [^BufferedReader in response-promise]
  (loop [sb (StringBuilder.) c (.read in)]
    (cond
      (= c -1) (do
                 (if-let [resp-promise @response-promise]
                   (deliver resp-promise :eof))
                 :eof)
      (= c 1) (do
                (print (str sb))
                (flush)
                (recur (StringBuilder.) (.read in)))
      (= c 0) (do
                (deliver @response-promise (str sb))
                (recur (StringBuilder.) (.read in)))
      :else (do
              (.append sb (char c))
              (recur sb (.read in))))))

(defn start-reading-messages
  "Starts a thread reading inbound messages."
  [repl-env]
  (.start
        (Thread.
          #(try
            (let [rv (read-messages (:in @(:socket repl-env)) (:response-promise repl-env))]
              (when (= :eof rv)
                (close-socket @(:socket repl-env))))
            (catch IOException e
              (when-not (.isClosed (:socket @(:socket repl-env)))
                (.printStackTrace e)))))))

(defn stack-line->canonical-frame
  "Parses a stack line into a frame representation, returning nil
  if parse failed."
  [stack-line opts]
  (let [[function file line column]
        (rest (re-matches #"(.*)@file:///(.*):([0-9]+):([0-9]+)"
                stack-line))]
    (if (and file function line column)
      {:file     (str (io/file (util/output-directory opts) file))
       :function function
       :line     (Long/parseLong line)
       :column   (Long/parseLong column)})))

(defn raw-stacktrace->canonical-stacktrace
  "Parse a raw JSC stack representation, parsing it into stack frames.
  The canonical stacktrace must be a vector of maps of the form
  {:file <string> :function <string> :line <integer> :column <integer>}."
  [raw-stacktrace opts]
  (->> raw-stacktrace
    string/split-lines
    (map #(stack-line->canonical-frame % opts))
    (remove nil?)
    vec))

(defn jsc-eval
  "Evaluate a JavaScript string in the JSC REPL process."
  [repl-env js]
  (let [{:keys [out]} @(:socket repl-env)
        response-promise (promise)]
    (reset! (:response-promise repl-env) response-promise)
    (write out js)
    (let [response @response-promise]
      (if (= :eof response)
        {:status :error
         :value  "Connection to JavaScriptCore closed."}
        (let [result (json/read-str response
                       :key-fn keyword)]
          (merge
            {:status (keyword (:status result))
             :value  (:value result)}
            (when-let [raw-stacktrace (:stacktrace result)]
              {:stacktrace raw-stacktrace})))))))

(defn load-javascript
  "Load a Closure JavaScript file into the JSC REPL process."
  [repl-env provides url]
  (jsc-eval repl-env
    (str "goog.require('" (comp/munge (first provides)) "')")))

(defn form-require-expr-js
  "Takes a JavaScript path expression anf forms a `require` command."
  [path-expr]
  {:pre [(string? path-expr)]}
  (str "require(" path-expr ");"))

(defn form-require-path-js
  "Takes a path and forms a JavaScript `require` command."
  [path]
  {:pre [(or (string? path) (instance? File path))]}
  (form-require-expr-js (str "'" path "'")))

(defn setup
  [repl-env opts]
  (let [_ (set-logging-level "javax.jmdns" java.util.logging.Level/SEVERE)
        [webdav-endpoint-name webdav-endpoint] (discover-and-pick-ambly-instance)
        _ (println "\nConnecting to" (service-name->display-name webdav-endpoint-name) "...\n")
        ; Assuming IPv4 for now
        endpoint-address (.getHostAddress (:address webdav-endpoint))
        endpoint-port (:port webdav-endpoint)
        webdav-mount-point (str "/Volumes/Ambly-" endpoint-address)
        output-dir (io/file webdav-mount-point)
        _ (.mkdirs output-dir)
        env (ana/empty-env)
        core (io/resource "cljs/core.cljs")]
    (reset! (:webdav-mount-point repl-env) webdav-mount-point)
    (shell/sh "mount_webdav" (str "http://" endpoint-address ":" endpoint-port) webdav-mount-point)
    (reset! (:socket repl-env)
      (socket endpoint-address (:port repl-env)))
    ;; Start dedicated thread to read messages from socket
    (start-reading-messages repl-env)
    ;; compile cljs.core & its dependencies, goog/base.js must be available
    ;; for bootstrap to load, use new closure/compile as it can handle
    ;; resources in JARs
    (let [core-js (closure/compile core
                    (assoc opts
                      :output-dir webdav-mount-point
                      :output-file
                      (closure/src-file->target-file core)))
          deps (closure/add-dependencies opts core-js)]
      ;; output unoptimized code and the deps file
      ;; for all compiled namespaces
      (apply closure/output-unoptimized
        (assoc opts
          :output-dir webdav-mount-point
          :output-to (.getPath (io/file output-dir "ambly_repl_deps.js")))
        deps))
    ;; Set up CLOSURE_IMPORT_SCRIPT function, injecting path
    (jsc-eval repl-env
      (str "CLOSURE_IMPORT_SCRIPT = function(src) {"
        (form-require-expr-js
          (str "'goog" File/separator "' + src"))
        "return true; };"))
    ;; bootstrap
    (jsc-eval repl-env
      (form-require-path-js (io/file "goog" "base.js")))
    ;; load the deps file so we can goog.require cljs.core etc.
    (jsc-eval repl-env
      (form-require-path-js (io/file "ambly_repl_deps.js")))
    ;; monkey-patch isProvided_ to avoid useless warnings - David
    (jsc-eval repl-env
      (str "goog.isProvided_ = function(x) { return false; };"))
    ;; monkey-patch goog.require, skip all the loaded checks
    (repl/evaluate-form repl-env env "<cljs repl>"
      '(set! (.-require js/goog)
         (fn [name]
           (js/CLOSURE_IMPORT_SCRIPT
             (aget (.. js/goog -dependencies_ -nameToPath) name)))))
    ;; load cljs.core, setup printing
    (repl/evaluate-form repl-env env "<cljs repl>"
      '(do
         (.require js/goog "cljs.core")
         (set-print-fn! js/out.write)))
    ;; redef goog.require to track loaded libs
    (repl/evaluate-form repl-env env "<cljs repl>"
      '(do
         (set! *loaded-libs* #{"cljs.core"})
         (set! (.-require js/goog)
           (fn [name reload]
             (when (or (not (contains? *loaded-libs* name)) reload)
               (set! *loaded-libs* (conj (or *loaded-libs* #{}) name))
               (js/CLOSURE_IMPORT_SCRIPT
                 (aget (.. js/goog -dependencies_ -nameToPath) name)))))))
    {:merge-opts {:output-dir webdav-mount-point}}))

(defrecord JscEnv [host port socket response-promise webdav-mount-point]
  repl/IParseStacktrace
  (-parse-stacktrace [this stacktrace error opts]
    (raw-stacktrace->canonical-stacktrace stacktrace opts))
  repl/IPrintStacktrace
  (-print-stacktrace [repl-env stacktrace error build-options]
    (doseq [{:keys [function file url line column]}
            (cljs.repl/mapped-stacktrace stacktrace build-options)]
      (println "\t" (str function " (" (str (or url file)) ":" line ":" column ")"))))
  repl/IJavaScriptEnv
  (-setup [this opts]
    (setup this opts))
  (-evaluate [this filename line js]
    (jsc-eval this js))
  (-load [this provides url]
    (load-javascript this provides url))
  (-tear-down [this]
    (shell/sh "umount" @webdav-mount-point)
    (close-socket @socket)
    (shutdown-agents)))

(defn repl-env* [options]
  (let [{:keys [host port]}
        (merge
          {:host "localhost"
           :port 50505}
          options)]
    (JscEnv. host port (atom nil) (atom nil) (atom nil))))

(defn repl-env
  [& {:as options}]
  (repl-env* options))

(comment

  (require
    '[cljs.repl :as repl]
    '[ambly.repl.jsc :as jsc])

  (repl/repl* (jsc/repl-env)
    {:output-dir "out"
     :cache-analysis true
     :source-map true})

  )

(ns ambly.repl.jsc
  (:require [clojure.string :as string]
            [clojure.java.io :as io]
            [cljs.analyzer :as ana]
            [cljs.util :as util]
            [cljs.compiler :as comp]
            [cljs.repl :as repl]
            [cljs.closure :as closure]
            [clojure.data.json :as json]
            [clojure.java.shell :as shell])
  (:import java.net.Socket
           java.lang.StringBuilder
           [java.io File BufferedReader BufferedWriter IOException]
           (javax.jmdns JmDNS ServiceListener)))

(defn set-logging-level [logger-name level]
  (.setLevel (java.util.logging.Logger/getLogger logger-name) level))

(defn service-name->display-name [service-name]
  (subs service-name (count "Ambly WebDAV Server on ")))

(defn service-map->choice-list [service-map]
  (map vector (iterate inc 1) service-map))

(defn print-services [service-map]
  (doseq [[choice-number [service-name _]] (service-map->choice-list service-map)]
    (println (str "[" choice-number "] " (service-name->display-name service-name)))))

(defn discover-and-pick-ambly-instance
  "Looks for Ambly WebDAV services advertised via Bonjour and presents
  a simple command-line UI letting user pick one."
  [choose-first-discovered?]
  (let [reg-type "_http._tcp.local."
        discovered-services (atom (sorted-map))
        mdns-service (JmDNS/create)
        service-listener
        (reify ServiceListener
          (serviceAdded [_ service-event]
            (let [name (.getName service-event)]
              (when (.startsWith name "Ambly WebDAV Server")
                (.requestServiceInfo mdns-service (.getType service-event) (.getName service-event) 1))))
          (serviceRemoved [_ service-event]
            (swap! discovered-services dissoc (.getName service-event)))
          (serviceResolved [_ service-event]
            (let [entry {(.getName service-event)
                         (let [info (.getInfo service-event)]
                           {:address (.getAddress info)
                            :port    (.getPort info)})}]
              (swap! discovered-services merge entry))))]
    (try
      (.addServiceListener mdns-service reg-type service-listener)
      (loop [count 0]
        (when (empty? @discovered-services)
          (Thread/sleep 100)
          (when (= 1000 count)
            (println "\nSearching ..."))
          (recur (inc count))))
      (Thread/sleep 500)                                    ;; Sleep a little more to catch stragglers
      (loop [current-discovered-services @discovered-services]
        (println)
        (print-services current-discovered-services)
        (when-not choose-first-discovered?
          (println "\n[r] Refresh\n")
          (print "Choice: ")
          (flush))
        (let [choice (if choose-first-discovered? "1" (read-line))]
          (if (= "r" choice)
            (recur @discovered-services)
            (let [choices (service-map->choice-list current-discovered-services)
                  choice-ndx (try (dec (Long/parseLong choice)) (catch NumberFormatException _ nil))]
              (if (< -1 choice-ndx (count choices))
                (second (nth choices choice-ndx))
                (recur current-discovered-services))))))
      (finally
        (future
          (.removeServiceListener mdns-service reg-type service-listener)
          (.close mdns-service))))))

(defn socket [host port]
  (let [socket (Socket. host port)
        in     (io/reader socket)
        out    (io/writer socket)]
    {:socket socket :in in :out out}))

(defn close-socket [s]
  (.close (:socket s)))

(defn write [^BufferedWriter out ^String js]
  (.write out js)
  (.write out (int 0)) ;; terminator
  (.flush out))

(defn read-messages [^BufferedReader in response-promise]
  (loop [sb (StringBuilder.) c (.read in)]
    (cond
      (= c -1) (do
                 (if-let [resp-promise @response-promise]
                   (deliver resp-promise :eof))
                 :eof)
      (= c 1) (do
                (print (str sb))
                (flush)
                (recur (StringBuilder.) (.read in)))
      (= c 0) (do
                (deliver @response-promise (str sb))
                (recur (StringBuilder.) (.read in)))
      :else (do
              (.append sb (char c))
              (recur sb (.read in))))))

(defn start-reading-messages
  "Starts a thread reading inbound messages."
  [repl-env]
  (.start
        (Thread.
          #(try
            (let [rv (read-messages (:in @(:socket repl-env)) (:response-promise repl-env))]
              (when (= :eof rv)
                (close-socket @(:socket repl-env))))
            (catch IOException e
              (when-not (.isClosed (:socket @(:socket repl-env)))
                (.printStackTrace e)))))))

(defn stack-line->canonical-frame
  "Parses a stack line into a frame representation, returning nil
  if parse failed."
  [stack-line opts]
  (let [[function file line column]
        (rest (re-matches #"(.*)@file:///(.*):([0-9]+):([0-9]+)"
                stack-line))]
    (if (and file function line column)
      {:file     (str (io/file (util/output-directory opts) file))
       :function function
       :line     (Long/parseLong line)
       :column   (Long/parseLong column)})))

(defn raw-stacktrace->canonical-stacktrace
  "Parse a raw JSC stack representation, parsing it into stack frames.
  The canonical stacktrace must be a vector of maps of the form
  {:file <string> :function <string> :line <integer> :column <integer>}."
  [raw-stacktrace opts]
  (->> raw-stacktrace
    string/split-lines
    (map #(stack-line->canonical-frame % opts))
    (remove nil?)
    vec))

(defn jsc-eval
  "Evaluate a JavaScript string in the JSC REPL process."
  [repl-env js]
  (let [{:keys [out]} @(:socket repl-env)
        response-promise (promise)]
    (reset! (:response-promise repl-env) response-promise)
    (write out js)
    (let [response @response-promise]
      (if (= :eof response)
        {:status :error
         :value  "Connection to JavaScriptCore closed."}
        (let [result (json/read-str response
                       :key-fn keyword)]
          (merge
            {:status (keyword (:status result))
             :value  (:value result)}
            (when-let [raw-stacktrace (:stacktrace result)]
              {:stacktrace raw-stacktrace})))))))

(defn load-javascript
  "Load a Closure JavaScript file into the JSC REPL process."
  [repl-env provides url]
  (jsc-eval repl-env
    (str "goog.require('" (comp/munge (first provides)) "')")))

(defn form-require-expr-js
  "Takes a JavaScript path expression anf forms a `require` command."
  [path-expr]
  {:pre [(string? path-expr)]}
  (str "require(" path-expr ");"))

(defn form-require-path-js
  "Takes a path and forms a JavaScript `require` command."
  [path]
  {:pre [(or (string? path) (instance? File path))]}
  (form-require-expr-js (str "'" path "'")))

(defn setup
  [repl-env opts]
  (let [_ (set-logging-level "javax.jmdns" java.util.logging.Level/SEVERE)
        [webdav-endpoint-name webdav-endpoint] (discover-and-pick-ambly-instance (:choose-first-discovered repl-env))
        _ (println "\nConnecting to" (service-name->display-name webdav-endpoint-name) "...\n")
        ; Assuming IPv4 for now
        endpoint-address (.getHostAddress (:address webdav-endpoint))
        endpoint-port (:port webdav-endpoint)
        webdav-mount-point (str "/Volumes/Ambly-" endpoint-address)
        output-dir (io/file webdav-mount-point)
        _ (.mkdirs output-dir)
        env (ana/empty-env)
        core (io/resource "cljs/core.cljs")]
    (reset! (:webdav-mount-point repl-env) webdav-mount-point)
    (shell/sh "mount_webdav" (str "http://" endpoint-address ":" endpoint-port) webdav-mount-point)
    (reset! (:socket repl-env)
      (socket endpoint-address (:port repl-env)))
    ;; Start dedicated thread to read messages from socket
    (start-reading-messages repl-env)
    ;; compile cljs.core & its dependencies, goog/base.js must be available
    ;; for bootstrap to load, use new closure/compile as it can handle
    ;; resources in JARs
    (let [core-js (closure/compile core
                    (assoc opts
                      :output-dir webdav-mount-point
                      :output-file
                      (closure/src-file->target-file core)))
          deps (closure/add-dependencies opts core-js)]
      ;; output unoptimized code and the deps file
      ;; for all compiled namespaces
      (apply closure/output-unoptimized
        (assoc opts
          :output-dir webdav-mount-point
          :output-to (.getPath (io/file output-dir "ambly_repl_deps.js")))
        deps))
    ;; Set up CLOSURE_IMPORT_SCRIPT function, injecting path
    (jsc-eval repl-env
      (str "CLOSURE_IMPORT_SCRIPT = function(src) {"
        (form-require-expr-js
          (str "'goog" File/separator "' + src"))
        "return true; };"))
    ;; bootstrap
    (jsc-eval repl-env
      (form-require-path-js (io/file "goog" "base.js")))
    ;; load the deps file so we can goog.require cljs.core etc.
    (jsc-eval repl-env
      (form-require-path-js (io/file "ambly_repl_deps.js")))
    ;; monkey-patch isProvided_ to avoid useless warnings - David
    (jsc-eval repl-env
      (str "goog.isProvided_ = function(x) { return false; };"))
    ;; monkey-patch goog.require, skip all the loaded checks
    (repl/evaluate-form repl-env env "<cljs repl>"
      '(set! (.-require js/goog)
         (fn [name]
           (js/CLOSURE_IMPORT_SCRIPT
             (aget (.. js/goog -dependencies_ -nameToPath) name)))))
    ;; load cljs.core, setup printing
    (repl/evaluate-form repl-env env "<cljs repl>"
      '(do
         (.require js/goog "cljs.core")
         (set-print-fn! js/out.write)))
    ;; redef goog.require to track loaded libs
    (repl/evaluate-form repl-env env "<cljs repl>"
      '(do
         (set! *loaded-libs* #{"cljs.core"})
         (set! (.-require js/goog)
           (fn [name reload]
             (when (or (not (contains? *loaded-libs* name)) reload)
               (set! *loaded-libs* (conj (or *loaded-libs* #{}) name))
               (js/CLOSURE_IMPORT_SCRIPT
                 (aget (.. js/goog -dependencies_ -nameToPath) name)))))))
    {:merge-opts {:output-dir webdav-mount-point}}))

(defrecord JscEnv [host port socket response-promise webdav-mount-point choose-first-discovered]
  repl/IParseStacktrace
  (-parse-stacktrace [this stacktrace error opts]
    (raw-stacktrace->canonical-stacktrace stacktrace opts))
  repl/IPrintStacktrace
  (-print-stacktrace [repl-env stacktrace error build-options]
    (doseq [{:keys [function file url line column]}
            (cljs.repl/mapped-stacktrace stacktrace build-options)]
      (println "\t" (str function " (" (str (or url file)) ":" line ":" column ")"))))
  repl/IJavaScriptEnv
  (-setup [this opts]
    (setup this opts))
  (-evaluate [this filename line js]
    (jsc-eval this js))
  (-load [this provides url]
    (load-javascript this provides url))
  (-tear-down [this]
    (shell/sh "umount" @webdav-mount-point)
    (close-socket @socket)
    (shutdown-agents)))

(defn repl-env* [options]
  (let [{:keys [host port choose-first-discovered]}
        (merge
          {:host "localhost"
           :port 50505}
          options)]
    (JscEnv. host port (atom nil) (atom nil) (atom nil) choose-first-discovered)))

(defn repl-env
  [& {:as options}]
  (repl-env* options))

(comment

  (require
    '[cljs.repl :as repl]
    '[ambly.repl.jsc :as jsc])

  (repl/repl* (jsc/repl-env)
    {:output-dir "out"
     :cache-analysis true
     :source-map true})

  )

Add ability to automatically choose first device discovered

This works around inability to read input stream in nREPL / Cursive.
Need a better solution, but it at least lets the REPL start up.


(ns afterglow.max.Cue
  "This implements a class that allows https://cycling74.com[Max] from
  Cycling '74 to interact with
  https://github.com/brunchboy/afterglow#afterglow[Afterglow]
  https://github.com/brunchboy/afterglow/blob/master/doc/cues.adoc#the-cue-grid[cue
  grid] entries.

  Configured with the x and y coordinates of a cue in the default
  show's cue grid.

  The first inlet responds to `bang` in the same way a grid controller
  would: Starts the cue if it is not running, asks it to end if it is
  running, and kills it if it has already been asked to end but not
  yet finished doing so. It also responds to `start`, which will only
  ever start the cue, leaving it unaffected if it is already active,
  and `end` which ends it (gracefully the first time, forcefully
  thereafter), and `kill` which always forcefully terminates the cue.
  `end` and `kill` can also take a numeric parameter, and will only
  end the cue if it is still running an effect with the specified ID.

  The first outlet sends messages that provide status updates about
  the cue, `started`, `ending`, or `ended`, each followed by the
  numeric ID of the effect associated with that run of the cue. These
  messages will be sent regardless of whether the cue was started by
  this object.

  The remaining inlets and outlets allow the variables bound to the
  cue to be adjusted and monitored. They will be documented once
  implemented."
  {:doc/format :markdown}
  (:gen-class :extends com.cycling74.max.MaxObject
              :constructors {[int int] []}
              :exposes-methods {declareTypedIO parentDeclareTypedIO
                                setInletAssist parentSetInletAssist
                                setOutletAssist parentSetOutletAssist
                                createInfoOutlet parentCreateInfoOutlet
                                getInlet parentGetInlet}
              :state state
              :init init
              :post-init post-init
              :main false
              :methods [[start [] void]
                        [end [] void]
                        [end [int] void]
                        [kill [] void]
                        [kill [int] void]])
  (:require [afterglow.max.core :as core]
            [afterglow.controllers :as controllers]
            [afterglow.show :as show]
            [afterglow.show-context :refer [*show*]]
            [taoensso.timbre :as timbre])
  (:import (com.cycling74.max MaxObject Atom)))

(import 'afterglow.max.Cue)

;; TODO: Should we store the constructor value of *show* in our state, in case it changes?
;;       For now, no, establish convention that *show* gets set in afterglow-max startup
;;       and is not changed after that point.

;; TODO: Should we detect changes in the cue stored at our cell, and shut down?

(defn cue-variables
  "Return the cue's variables."
  [this]
  (get-in @(.state this) [:cue :variables]))

(defn cue-variable-names
  "Return the user-oriented names of the cue's variables."
  [this]
  (map :name (cue-variables this)))

(defn cue-variable-inlet-assist
  "Return the tooltip text describing the cue variable inlets."
  [this]
  (for [n (cue-variable-names this)]
    (str "float: Set " n "; bang: Report current value")))

(defn cue-variable-outlet-assist
  "Return the tooltip text describing the cue variable outlets."
  [this]
  (for [n (cue-variable-names this)]
    (str "Output changed values of " n)))

(defn cue-variable-type-string
  "Returns the type strings telling Max what kind of outlets each cue
  variable uses."
  [this]
  (clojure.string/join (map #(if (= (:type %) :int) "i" "f") (cue-variables this))))

(defn- -init
  [x y]
  (core/init)
  (when (nil? *show*)
    (throw (IllegalStateException. "Cannot create Cue object: No default show has been established.")))
  (let [cue (controllers/cue-at (:cue-grid *show*) x y)]
    (when (nil? cue)
      (throw (IllegalStateException. (str "Cannot create Cue object: No cue at " x ", " y " in *show*"))))
    [[] (atom {:x x :y y :cue cue})]))

(defn- -post-init
  "The post-init phase of the constructors tells Max about the inlets
  and outlets supported by this object, and registers our interest in
  cue state with Afterglow."
  [this x y]
  (let [type-string (str "m" (cue-variable-type-string this))
        cue-name (get-in @(.state this) [:cue :name])
        first-inlet-assist (str "start, end, kill, bang: Control cue \"" cue-name "\"")]
    (.parentDeclareTypedIO this type-string type-string)
    (.parentSetInletAssist this (into-array String (concat [first-inlet-assist]
                                                           (cue-variable-inlet-assist this))))
    (.parentSetOutletAssist this (into-array String (concat ["Output changes in Cue state and associated id values"]
                                                            (cue-variable-outlet-assist this))))
    (.parentCreateInfoOutlet this false)
    (swap! (.state this) assoc :f (fn [new-state _ id]
                                    (.outlet this 0 (name new-state)
                                             (into-array Atom [(Atom/newAtom id) (Atom/newAtom cue-name)])))))
  (controllers/add-cue-fn! (:cue-grid *show*) x y (:f @(.state this))))

(defn apply-cue-local-variables
  "After we start a cue, this function looks for any local values we
  have saved for variables are creted for the duration of the cue,
  and if any are found, copies them into the actual cue variables."
  [this]
  (let [{:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (when active
      (doseq [v (cue-variables this)]
        (when (string? (:key v))
          (let [cue-local-key (keyword (:key v))
                cue-local-value (get-in @(.state this) [:variables cue-local-key])]
            (when cue-local-value
              (show/set-variable! (get-in active [:variables cue-local-key]) cue-local-value))))))))

(defn- -start
  "Start the cue if it is not already running (if it is in the process
  of ending, start a new instance in its place)."
  [this]
  (let [{:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (when-not (and active (not (:ending active)))
      (show/add-effect-from-cue-grid! x y)
      (apply-cue-local-variables this))))

(defn- -end
  "Ask the cue to end; if it has already been asked once, kill it
  immediately. If an id parameter is given, the cue will be affected
  only if it is still running the effect with the specified id."
  ([this]
   (-end this nil))
  ([this id]
   (show/end-effect! (get-in @(.state this) [:cue :key]) :when-id id)))

(defn- -kill
  "Terminate the cue immediately. If an id parameter is given, the cue
  will be killed only if it is still running the effect with the
  specified id."
  ([this]
   (-kill this nil))
  ([this id]
  (show/end-effect! (get-in @(.state this) [:cue :key]) :force true :when-id id)))

(defn get-cue-local-variable
  "Look up the current value for a cue variable which gets created for
  the lifespan of a running cue. If the cue is currently active,
  report the value of the corresponding temporary show variable. If
  not, report the local value we are tracking to be used the next time
  we start the cue."
  [this v]
  (let [cue-local-key (keyword (:key v))
        {:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (if active
      (show/get-variable (get-in active [:variables cue-local-key]))
      (get-in @(.state this) [:variables cue-local-key]))))

(defn- -bang
  "Respond to a bang message. For the cue control inlet, this acts
  like a press on a grid controller pad: If the cue is not active,
  start it. If it is running, ask it to end; if it is still running
  after being asked to end, this will kill it. For variable inlets,
  causes the current value of the variable, if it is defined, to be
  output to the corresponding outlet. If the variable has no value, or
  is not a number, the corresponding outlet is simply banged."
  [this]
  (let [inlet (.parentGetInlet this)
        {:keys [x y cue]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (if (zero? inlet)  ; Cue control inlet?
      (if active  ; Transition the cue to the next appropriate state.
        (-end this)
        (-start this))
      (let [v (nth (cue-variables this) (dec inlet)) ; One of the variable inlets; output its current value.
            current-val (if (keyword? (:key v))
                          (show/get-variable (:key v))
                          (get-cue-local-variable this v))]
        (if (number? current-val)
          (.outlet this inlet (float current-val))
          (.outletBang this inlet))))))

(defn update-cue-local-variable
  "Max wants to set a value for a cue variable which gets created for
  the lifespan of a running cue. Save a local copy to use when
  starting up future cues, and if there is currently one active, also
  update the corresponding temporary show variable."
  [this new-value v]
  (let [cue-local-key (keyword (:key v))
        {:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (swap! (.state this) assoc-in [:variables cue-local-key] new-value)
    (when active (show/set-variable! (get-in active [:variables cue-local-key]) new-value))))

(defn- -inlet-float
  "Respond to a float message, meaning the value of one of the
  variable inlets has been set."
  [this new-value]
  (let [inlet (.parentGetInlet this)]
    (if (zero? inlet)  ; Only variable inlets accept floats, ignore attempts to send to 0, but complain.
      (timbre/error "Cue control inlet does not respond to numbers.")
      (let [v (nth (cue-variables this) (dec inlet))
            new-value (max new-value (:min v))  ; Restrict range of variable values as per cue specs.
            new-value (min new-value (:max v))]
        (if (keyword? (:key v))
          (show/set-variable! (:key v) new-value)
          (update-cue-local-variable this new-value v))
        (.outlet this inlet new-value)))))

(defn- -notifyDeleted
  "The Max peer object has been deleted, so this instance is no longer
  going to be used. Unregister our cue state notification function,
  and allow this object to be garbage collected."
  [this]
  (let [{:keys [x y f]} @(.state this)]
    (controllers/clear-cue-fn! (:cue-grid *show*) x y f)))

(ns afterglow.max.Cue
  "This implements a class that allows https://cycling74.com[Max] from
  Cycling '74 to interact with
  https://github.com/brunchboy/afterglow#afterglow[Afterglow]
  https://github.com/brunchboy/afterglow/blob/master/doc/cues.adoc#the-cue-grid[cue
  grid] entries.

  Configured with the x and y coordinates of a cue in the default
  show's cue grid.

  The first inlet responds to `bang` in the same way a grid controller
  would: Starts the cue if it is not running, asks it to end if it is
  running, and kills it if it has already been asked to end but not
  yet finished doing so. It also responds to `start`, which will only
  ever start the cue, leaving it unaffected if it is already active,
  and `end` which ends it (gracefully the first time, forcefully
  thereafter), and `kill` which always forcefully terminates the cue.
  `end` and `kill` can also take a numeric parameter, and will only
  end the cue if it is still running an effect with the specified ID.

  The first outlet sends messages that provide status updates about
  the cue, `started`, `ending`, or `ended`, each followed by the
  numeric ID of the effect associated with that run of the cue. These
  messages will be sent regardless of whether the cue was started by
  this object.

  The remaining inlets and outlets allow the variables bound to the
  cue to be adjusted and monitored. They will be documented once
  implemented."
  {:doc/format :markdown}
  (:gen-class :extends com.cycling74.max.MaxObject
              :constructors {[int int] []}
              :exposes-methods {declareTypedIO parentDeclareTypedIO
                                setInletAssist parentSetInletAssist
                                setOutletAssist parentSetOutletAssist
                                createInfoOutlet parentCreateInfoOutlet
                                getInlet parentGetInlet}
              :state state
              :init init
              :post-init post-init
              :main false
              :methods [[start [] void]
                        [end [] void]
                        [end [int] void]
                        [kill [] void]
                        [kill [int] void]])
  (:require [afterglow.max.core :as core]
            [afterglow.controllers :as controllers]
            [afterglow.show :as show]
            [afterglow.show-context :refer [*show*]]
            [taoensso.timbre :as timbre])
  (:import (com.cycling74.max MaxObject Atom)))

(import 'afterglow.max.Cue)

;; TODO: Should we store the constructor value of *show* in our state, in case it changes?
;;       For now, no, establish convention that *show* gets set in afterglow-max startup
;;       and is not changed after that point.

;; TODO: Should we detect changes in the cue stored at our cell, and shut down?

(defn cue-variables
  "Return the cue's variables."
  [this]
  (get-in @(.state this) [:cue :variables]))

(defn cue-variable-names
  "Return the user-oriented names of the cue's variables."
  [this]
  (map :name (cue-variables this)))

(defn cue-variable-inlet-assist
  "Return the tooltip text describing the cue variable inlets."
  [this]
  (for [n (cue-variable-names this)]
    (str "float: Set " n "; bang: Report current value")))

(defn cue-variable-outlet-assist
  "Return the tooltip text describing the cue variable outlets."
  [this]
  (for [n (cue-variable-names this)]
    (str "Output changed values of " n)))

(defn cue-variable-type-string
  "Returns the type strings telling Max what kind of outlets each cue
  variable uses."
  [this]
  (clojure.string/join (map #(if (= (:type %) :int) "i" "f") (cue-variables this))))

(defn unwatch-cue-local-variables
  "When a cue has ended, or this object is being deactivated, get rid
  of any callback functions that were watching cue-local variable
  value changes."
  [this]
  (doseq [[k f] (:local-var-fn @(.state this))]
    (show/clear-variable-set-fn! k f))
  (swap! (.state this) dissoc :local-var-fn))

(defn watch-cue-local-variables
  "After we start a cue, this function looks for any variable bindings
  which are cue-local, and registers callback functions to send
  updates if their values change. Also immediately sends out the
  values of the variables that the cue started up with."
  [this]
  (unwatch-cue-local-variables this)  ; Should be unnecessary, but clean up just in case
  (let [{:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (when active
      (doseq [[i v] (map vector (range) (cue-variables this))]
      (when (string? (:key v))
        (let [outlet (inc i)
              cue-local-key (keyword (:key v))
              cue-local-var (get-in active [:variables cue-local-key])
              f (fn [_ new-value] (when (number? new-value) (.outlet this outlet (float new-value))))]
          (swap! (.state this) assoc-in [:local-var-fn cue-local-var] f)
          (f cue-local-var (show/get-variable cue-local-var))
          (show/add-variable-set-fn! cue-local-var f)))))))

(defn- -init
  [x y]
  (core/init)
  (when (nil? *show*)
    (throw (IllegalStateException. "Cannot create Cue object: No default show has been established.")))
  (let [cue (controllers/cue-at (:cue-grid *show*) x y)]
    (when (nil? cue)
      (throw (IllegalStateException. (str "Cannot create Cue object: No cue at " x ", " y " in *show*"))))
    [[] (atom {:x x :y y :cue cue})]))

(defn- -post-init
  "The post-init phase of the constructors tells Max about the inlets
  and outlets supported by this object, and registers our interest in
  cue state with Afterglow."
  [this x y]
  (let [type-string (str "m" (cue-variable-type-string this))
        cue-name (get-in @(.state this) [:cue :name])
        first-inlet-assist (str "start, end, kill, bang: Control cue \"" cue-name "\"")]
    (.parentDeclareTypedIO this type-string type-string)
    (.parentSetInletAssist this (into-array String (concat [first-inlet-assist]
                                                           (cue-variable-inlet-assist this))))
    (.parentSetOutletAssist this (into-array String (concat ["Output changes in Cue state and associated id values"]
                                                            (cue-variable-outlet-assist this))))
    (.parentCreateInfoOutlet this false)

    ;; Set up the callback function for changes to cue state
    (let [f (fn [new-state _ id]
              (.outlet this 0 (name new-state) (into-array Atom [(Atom/newAtom id) (Atom/newAtom cue-name)]))
              (case new-state
                :started (watch-cue-local-variables this)
                :ended (unwatch-cue-local-variables this)
                nil))]
      (swap! (.state this) assoc :cue-fn f)
      (controllers/add-cue-fn! (:cue-grid *show*) x y f))

    ;; Set up the callback functions for changes to values of permanent show variables bound to the cue
    (doseq [[i v] (map vector (range) (cue-variables this))]
      (when (keyword? (:key v))
        (let [outlet (inc i)
              f (fn [_ new-value] (when (number? new-value) (.outlet this outlet (float new-value))))]
          (swap! (.state this) assoc-in [:perm-var-fn (:key v)] f)
          (show/add-variable-set-fn! (:key v) f))))))

(defn apply-cue-local-variables
  "After we start a cue, this function looks for any local values we
  have saved for variables are creted for the duration of the cue,
  and if any are found, copies them into the actual cue variables."
  [this]
  (let [{:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (when active
      (doseq [v (cue-variables this)]
        (when (string? (:key v))
          (let [cue-local-key (keyword (:key v))
                cue-local-value (get-in @(.state this) [:variables cue-local-key])]
            (when cue-local-value
              (show/set-variable! (get-in active [:variables cue-local-key]) cue-local-value))))))))

(defn- -start
  "Start the cue if it is not already running (if it is in the process
  of ending, start a new instance in its place)."
  [this]
  (let [{:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (when-not (and active (not (:ending active)))
      (show/add-effect-from-cue-grid! x y)
      (apply-cue-local-variables this))))

(defn- -end
  "Ask the cue to end; if it has already been asked once, kill it
  immediately. If an id parameter is given, the cue will be affected
  only if it is still running the effect with the specified id."
  ([this]
   (-end this nil))
  ([this id]
   (show/end-effect! (get-in @(.state this) [:cue :key]) :when-id id)))

(defn- -kill
  "Terminate the cue immediately. If an id parameter is given, the cue
  will be killed only if it is still running the effect with the
  specified id."
  ([this]
   (-kill this nil))
  ([this id]
  (show/end-effect! (get-in @(.state this) [:cue :key]) :force true :when-id id)))

(defn get-cue-local-variable
  "Look up the current value for a cue variable which gets created for
  the lifespan of a running cue. If the cue is currently active,
  report the value of the corresponding temporary show variable. If
  not, report the local value we are tracking to be used the next time
  we start the cue."
  [this v]
  (let [cue-local-key (keyword (:key v))
        {:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (if active
      (show/get-variable (get-in active [:variables cue-local-key]))
      (get-in @(.state this) [:variables cue-local-key]))))

(defn- -bang
  "Respond to a bang message. For the cue control inlet, this acts
  like a press on a grid controller pad: If the cue is not active,
  start it. If it is running, ask it to end; if it is still running
  after being asked to end, this will kill it. For variable inlets,
  causes the current value of the variable, if it is defined, to be
  output to the corresponding outlet. If the variable has no value, or
  is not a number, the corresponding outlet is simply banged."
  [this]
  (let [inlet (.parentGetInlet this)
        {:keys [x y cue]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (if (zero? inlet)  ; Cue control inlet?
      (if active  ; Transition the cue to the next appropriate state.
        (-end this)
        (-start this))
      (let [v (nth (cue-variables this) (dec inlet)) ; One of the variable inlets; output its current value.
            current-val (if (keyword? (:key v))
                          (show/get-variable (:key v))
                          (get-cue-local-variable this v))]
        (if (number? current-val)
          (.outlet this inlet (float current-val))
          (.outletBang this inlet))))))

(defn update-cue-local-variable
  "Max wants to set a value for a cue variable which gets created for
  the lifespan of a running cue. Save a local copy to use when
  starting up future cues, and if there is currently one active, also
  update the corresponding temporary show variable."
  [this new-value v]
  (let [cue-local-key (keyword (:key v))
        {:keys [x y]} @(.state this)
        [_ active] (show/find-cue-grid-active-effect *show* x y)]
    (swap! (.state this) assoc-in [:variables cue-local-key] new-value)
    (when active (show/set-variable! (get-in active [:variables cue-local-key]) new-value))))

(defn- -inlet-float
  "Respond to a float message, meaning the value of one of the
  variable inlets has been set."
  [this new-value]
  (let [inlet (.parentGetInlet this)]
    (if (zero? inlet)  ; Only variable inlets accept floats, ignore attempts to send to 0, but complain.
      (timbre/error "Cue control inlet does not respond to numbers.")
      (let [v (nth (cue-variables this) (dec inlet))
            new-value (max new-value (:min v))  ; Restrict range of variable values as per cue specs.
            new-value (min new-value (:max v))]
        (if (keyword? (:key v))
          (show/set-variable! (:key v) new-value)
          (update-cue-local-variable this new-value v))
        (.outlet this inlet new-value)))))

(defn- -notifyDeleted
  "The Max peer object has been deleted, so this instance is no longer
  going to be used. Unregister our cue state notification function,
  and any variable change notification functions, and allow this
  object to be garbage collected."
  [this]
  (let [{:keys [x y cue-fn perm-var-fn]} @(.state this)]
    (controllers/clear-cue-fn! (:cue-grid *show*) x y cue-fn)
    (doseq [[k f] perm-var-fn]
      (show/clear-variable-set-fn! k f))
    (unwatch-cue-local-variables this)))

Add feedback about external changes to cue vars.

I think the cue object is pretty much exactly how I want it now, and all
that remains is to create the documentation and help patchers, w00t!