(ns theatralia.database.t-txd-gen
  (:require [midje.sweet :refer :all]
            [clojure.test.check :as tc]
            [clojure.test.check.generators :as gen]
            [clojure.test.check.properties :as prop]
            [theatralia.test.utils :refer [quick-check]]
            [com.stuartsierra.component :as component]
            [datomic.api :as d]
            [theatralia.database.canned-queries :as qcan]
            [theatralia.database.component :as db-component]
            [theatralia.database.txd-gen :as nut])) ; namespace under test

;;; Credits: http://yellerapp.com/posts/2014-05-07-testing-datomic.html

(defn empty-db-conn
  []
  (-> (db-component/make-database "datomic:mem://theatralia-test")
      component/start
      :conn))

(defn empty-db
  []
  (d/db (empty-db-conn)))

(defn suppose [db txd]
  (:db-after (d/with db txd)))

(defn contains-all? [haystack needles]
  (every? (set haystack) needles))

(facts "about add-tags-txd"
  (fact "After transacting the results, all tags should be present in DB."
    (let [db (empty-db)
          owner-eid (qcan/username->eid db "sandbox")]
      (prop/for-all [tags (gen/vector gen/string-ascii)]
        (let [db-after (suppose db ((nut/add-tags-txd db tags owner-eid) 1))
              tags-after (qcan/tags-of-user-eid db-after owner-eid)]
          (contains-all? tags-after tags))))
    => (quick-check 100))

  (fact "After transacting once, the result of the second run should be empty."
    (let [db (empty-db)
          owner-eid (qcan/username->eid db "sandbox")]
      (prop/for-all [tags (gen/vector gen/string)]
        (let [db-after (suppose db ((nut/add-tags-txd db tags owner-eid) 1))
              new-txd ((nut/add-tags-txd db-after tags owner-eid) 1)]
          (empty? new-txd))))
    => (quick-check 100))

  (fact "There should be no two tags with the same text and owner-eid."
    (let [db (empty-db)
          owner-eid (qcan/username->eid db "sandbox")]
      (prop/for-all [tags (gen/vector gen/string)]
        (let [db-after (suppose db ((nut/add-tags-txd db tags owner-eid) 1))
              tags-after (qcan/tags-of-user-eid db-after owner-eid)]
          (apply distinct? tags-after))))
    => (quick-check 100)))

(ns theatralia.database.t-txd-gen
  (:require [midje.sweet :refer :all]
            [clojure.data :refer [diff]]
            [clojure.pprint :refer [pprint]]
            [clojure.test.check :as tc]
            [clojure.test.check.generators :as gen]
            [clojure.test.check.properties :as prop]
            [theatralia.test.utils :refer [quick-check]]
            [com.stuartsierra.component :as component]
            [datomic.api :as d]
            [theatralia.database.canned-queries :as qcan]
            [theatralia.database.component :as db-component]
            [theatralia.database.txd-gen :as txd-gen]))

;;;; General purpose helpers

(defn contains-all?
  "Returns true iff all elements from seq NEEDLES are contained in seq
  HAYSTACK."
  [haystack needles]
  (every? (set haystack) needles))

;;;; Auxiliary functions for testing against Datomic

;;; Credits: http://yellerapp.com/posts/2014-05-07-testing-datomic.html

(defn fresh-db
  "Returns a db that contains only the example data."
  []
  (-> (db-component/make-database "datomic:mem://theatralia-test")
      component/start
      :conn
      d/db))

(defn suppose
  "Returns a db that looks as if TXD had been transacted into DB."
  [db txd]
  (:db-after (d/with db txd)))

;;;; Sugar for easier testing of txd-gen/add-tags-txd

(defn add-tags-txd-only
  "Like txd-gen/add-tags-txd, but returns only the second element of the tuple
  returned by the add-tags-txd."
  [& args]
  ((apply txd-gen/add-tags-txd args) 1))

(defmacro tags-txd-prop
  "Template for shortening the definition of a property of txd-gen/add-tags-txd
  slighly. BODY will be evaluated in a context where ARGS are filled as follows:

    0 (tags)      – a generator generating a vector of strings to be used as
                    tags
    1 (owner-eid) – the eid of the user for whom we're adding tags
    2 (db-before) - the database value before adding TAGS
    3 (db-after)  – the database value after adding TAGS"
  [args & body]
  `(let [db-before# (fresh-db)
         owner-eid# (qcan/username->eid db-before# "sandbox")
         ~(subvec args 1 3) [owner-eid# db-before#]]
     (prop/for-all [tags# (gen/vector gen/string)]
       (let [db-after# (suppose db-before#
                                (add-tags-txd-only db-before# tags# owner-eid#))
             ~(args 0) tags#
             ~(args 3) db-after#]
         ~@body))))

;;;; Tests for txd-gen/add-tags-txd

(facts "about add-tags-txd"
  (fact "After transacting the results, all tags should be present in DB."
    (tags-txd-prop [tags owner-eid db-before db-after]
      (let [tags-after (qcan/tags-of-user-eid db-after owner-eid)]
        (contains-all? tags-after tags)))
    => (quick-check 100))

  (fact "Transacting the generated data doesn't modify pre-existing tags."
    (let [db-0 (fresh-db)
          owner-eid (qcan/username->eid db-0 "sandbox")]
      (prop/for-all [tags-1 (gen/vector gen/string)
                     tags-2 (gen/vector gen/string)]
        (let [db-1 (suppose db-0 (add-tags-txd-only db-0 tags-1 owner-eid))
              tag-eids-1 (d/q '[:find [?e ...] :where [?e :tag/text _]] db-1)
              db-2 (suppose db-1 (add-tags-txd-only db-1 tags-2 owner-eid))
              [tag-info-1 tag-info-2] (mapv #(d/pull-many % '[*] tag-eids-1)
                                            [db-1 db-2])]
          (= tag-info-1 tag-info-2))))
    => (quick-check 100))

  (fact "After transacting once, the result of the second run should be empty."
    (tags-txd-prop [tags owner-eid db-before db-after]
      (let [new-txd (add-tags-txd-only db-after tags owner-eid)]
        (empty? new-txd)))
    => (quick-check 100))

  (fact "There should be no two tags with the same text and owner-eid."
    (tags-txd-prop [tags owner-eid db-before db-after]
      (let [tags-after (qcan/tags-of-user-eid db-after owner-eid)]
        (apply distinct? tags-after)))
    => (quick-check 100)))

(comment

  (require '[theatralia.database.t-txd-gen :as t])
  (require '[theatralia.database.canned-queries :as qcan])
  (require '[theatralia.database.txd-gen :as txd-gen])

  (def db-0 (t/fresh-db))
  (def oeid (qcan/username->eid db-0 "sandbox"))
  (def res-1 (txd-gen/add-tags-txd db-0 ["a"] oeid))

  )

  ; add-material-txd
  ; Properties:
  ;  - None should have nil? for a value.
  ;  - Hm, this one is pretty borinrc/clj/theatralia/routes.clj
  ;  - What do we want to do if same material transacted twice?
  ;  - Tags already present shouldn't be modified.
  ;  - Shouldn't add more tags than we want.
  ;  - Make sure that when there are some tags already in the database and our
  ;    list of tags contains some of these, the ones that are contained are left
  ;    in peace and the extra ones are added.
  ;  - What about duplicate tags in tags?

Clean up tests for add-tags-txd

Clean up tests for add-tags-txd

This is what I set out to do some commits ago, but then got interrupted
by other considerations. Pull out some structure from the properties.
Add comments. Rearrange the definitions.

Note that I started using all uppercase for procedure arguments (already
in one of the preceding commits). [1] hinted me to this convention from
Emacs Lisp and I find it quite helpful. Especially when I want to use a
word both as an argument name and as a regular word.

Pulling out common structure meant writing a macro. Of course I could
have made it a function, but that wouldn't have been as pretty. Alas, I
can't use it for the fact about "transacting doesn't modify", since this
one has a slightly different setup than the others.

[1] https://groups.google.com/d/msg/clojure/kBXoYuL2bP0/5QQSrN1lrNkJ


(defproject puppetlabs.packages/pe-classifier "0.3.3"
  :description "Release artifacts for classifier"
  :pedantic? :abort
  :dependencies [[puppetlabs/classifier "0.3.3"]
                 [puppetlabs/trapperkeeper-webserver-jetty9 "0.5.1"]]

  :uberjar-name "classifier-release.jar"

  :repositories [["releases" "http://nexus.delivery.puppetlabs.net/content/repositories/releases/"]
                 ["snapshots" "http://nexus.delivery.puppetlabs.net/content/repositories/snapshots/"]]

  :main puppetlabs.trapperkeeper.main

  :ezbake {:user "pe-classifier"
           :group "pe-classifier"
           :build-type "pe"})

(defproject puppetlabs.packages/pe-classifier "{{{pe-classifier-version}}}"
  :description "Release artifacts for classifier"
  :pedantic? :abort
  :dependencies [[puppetlabs/classifier "{{{pe-classifier-version}}}"]
                 [puppetlabs/trapperkeeper-webserver-jetty9 "0.5.1"]]

  :uberjar-name "classifier-release.jar"

  :repositories [["releases" "http://nexus.delivery.puppetlabs.net/content/repositories/releases/"]
                 ["snapshots" "http://nexus.delivery.puppetlabs.net/content/repositories/snapshots/"]]

  :main puppetlabs.trapperkeeper.main

  :ezbake {:user "pe-classifier"
           :group "pe-classifier"
           :build-type "pe"})

Update pe-classifier config to use a templated version


(ns refactor-nrepl.analyzer
  (:refer-clojure :exclude [macroexpand-1])
  (:require [clojure.tools.analyzer.ast :refer :all]
            [clojure.tools.analyzer :as ana]
            [clojure.tools.analyzer.jvm :as ana.jvm]
            [clojure.tools.namespace.parse :refer [read-ns-decl]])
  (:import java.io.PushbackReader))

;; these two fns could go to clojure.tools.namespace.parse: would worth a pull request
(defn get-alias [as v]
  (cond as (first v)
        (= (first v) :as) (get-alias true (rest v))
        :else (get-alias nil (rest v))))

(defn parse-ns
  "Returns tuples with the ns as the first element and
   a map of the aliases for the namespace as the second element
   in the same format as ns-aliases"
  [body]
  (let [ns-decl (read-ns-decl (PushbackReader. (java.io.StringReader. body)))
        aliases (->> ns-decl
                     (filter list?)
                     (some #(when (#{:require} (first %)) %))
                     rest
                     (filter #(contains? (into #{} %) :as))
                     (#(zipmap (map (partial get-alias nil) %)
                               (map first %))))]
    [(second ns-decl) aliases]))

(defn- noop-macroexpand-1 [form]
  form)

(defn string-ast [string]
  (try
    (let [[ns aliases] (parse-ns string)]
      (binding [ana/macroexpand-1 noop-macroexpand-1]
        (when ns
          (assoc-in (ana.jvm/analyze-ns ns) [0 :alias-info] aliases))))
    (catch Exception ex
      (println "error when building AST for" (first (parse-ns string)))
      (.printStackTrace ex)
      [])))

(ns refactor-nrepl.analyzer
  (:refer-clojure :exclude [macroexpand-1])
  (:require [clojure.tools.analyzer.ast :refer :all]
            [clojure.tools.analyzer :as ana]
            [clojure.tools.analyzer.jvm :as ana.jvm]
            [clojure.tools.namespace.parse :refer [read-ns-decl]])
  (:import java.io.PushbackReader))

;;; The structure here is {ns {content-hash ast}}
(def ^:private ast-cache (atom {}))

;; these two fns could go to clojure.tools.namespace.parse: would worth a pull request
(defn get-alias [as v]
  (cond as (first v)
        (= (first v) :as) (get-alias true (rest v))
        :else (get-alias nil (rest v))))

(defn parse-ns
  "Returns tuples with the ns as the first element and
  a map of the aliases for the namespace as the second element
  in the same format as ns-aliases"
  [body]
  (let [ns-decl (read-ns-decl (PushbackReader. (java.io.StringReader. body)))
        aliases (->> ns-decl
                     (filter list?)
                     (some #(when (#{:require} (first %)) %))
                     rest
                     (filter #(contains? (into #{} %) :as))
                     (#(zipmap (map (partial get-alias nil) %)
                               (map first %))))]
    [(second ns-decl) aliases]))

(defn- noop-macroexpand-1 [form]
  form)

(defn- get-ast-from-cache
  [ns file-content]
  (-> (get @ast-cache ns)
      (get (hash file-content))))

(defn- update-ast-cache
  [file-content ns ast]
  (swap! ast-cache update-in [ns] merge {(hash file-content) ast})
  ast)

(defn- build-ast
  [ns aliases]
  (binding [ana/macroexpand-1 noop-macroexpand-1]
    (assoc-in (ana.jvm/analyze-ns ns) [0 :alias-info] aliases)))

(defn- cachable-ast [file-content]
  (let [[ns aliases] (parse-ns file-content)]
    (when ns
      (if-let [cached-ast (get-ast-from-cache ns file-content)]
        cached-ast
        (update-ast-cache file-content ns (build-ast ns aliases))))))

(defn string-ast
  [file-content]
  (try
    (cachable-ast file-content)
    (catch Exception ex
      (println "error when building AST for" (first (parse-ns file-content)))
      (.printStackTrace ex)
      [])))

Add caching of ASTs

Add caching of ASTs

This should hopefully improve performance quite a bit.  I'm hoping that
this will allow us to perform the refactorings synchronously rather than
asynchronously.


(ns pc.auth
  (:require [cheshire.core :as json]
            [clojure.tools.logging :as log]
            [crypto.equality :as crypto]
            [datomic.api :as d]
            [org.httpkit.client :as http]
            [pc.analytics :as analytics]
            [pc.auth.google :as google-auth]
            [pc.crm :as crm]
            [pc.models.cust :as cust]
            [pc.models.permission :as permission-model]
            [pc.datomic :as pcd]
            [pc.profile :as profile]
            [pc.utils :as utils])
  (:import java.util.UUID))

(defn update-user-from-sub [cust]
  (let [sub (:google-account/sub cust)
        {:keys [first-name last-name gender
                avatar-url birthday occupation]} (utils/with-report-exceptions
                                                   (google-auth/user-info-from-sub sub))
        cust (-> cust
               (cust/update! (utils/remove-map-nils {:cust/first-name first-name
                                                     :cust/last-name last-name
                                                     :cust/birthday birthday
                                                     :cust/gender gender
                                                     :cust/occupation occupation
                                                     :google-account/avatar avatar-url}))
               crm/update-with-dribbble-username)]
    (utils/with-report-exceptions
      (analytics/track-user-info cust))
    (when (profile/prod?)
      (utils/with-report-exceptions
        (crm/ping-chat-with-new-user cust)))
    cust))

(defn cust-from-google-oauth-code [code ring-req]
  {:post [(string? (:google-account/sub %))]} ;; should never break, but just in case...
  (let [user-info (google-auth/user-info-from-code code)
        db (pcd/default-db)]
    (if-let [cust (cust/find-by-google-sub db (:sub user-info))]
      (do
        (analytics/track-login cust)
        (cust/update! cust (merge {:cust/email (:email user-info)
                                   :cust/verified-email (:email_verified user-info)}
                                  (when-not (:cust/http-session-key cust)
                                    {:cust/http-session-key (UUID/randomUUID)}))))
      (try
        (let [user (cust/create! {:cust/email (:email user-info)
                                  :cust/verified-email (:email_verified user-info)
                                  :cust/http-session-key (UUID/randomUUID)
                                  :google-account/sub (:sub user-info)
                                  :cust/uuid (UUID/randomUUID)})]
          (analytics/track-signup user ring-req)
          (future (utils/with-report-exceptions (update-user-from-sub user)))
          user)
        (catch Exception e
          (if (pcd/unique-conflict? e)
            (cust/find-by-google-sub (pcd/default-db) (:sub user-info))
            (throw e)))))))

(def prcrsr-bot-email "prcrsr-bot@prcrsr.com")
(defn prcrsr-bot-uuid [db]
  (ffirst (d/q '{:find [?u]
                 :in [$ ?e]
                 :where [[?t :cust/email ?e]
                         [?t :cust/uuid ?u]]}
               db prcrsr-bot-email)))

(defn cust-permission [db doc cust]
  (when cust
    (cond (and (:document/creator doc)
               (crypto/eq? (str (:cust/uuid cust))
                           (str (:document/creator doc))))
          :owner

          (contains? (permission-model/permits db doc cust) :permission.permits/admin)
          :admin

          :else nil)))

(defn access-grant-permission [db doc access-grant]
  (when (and access-grant
             (:db/id doc)
             (= (:db/id doc)
                (:access-grant/document access-grant)))
    :read))

(defn permission-permission [db doc permission]
  (when (and permission
             (:db/id doc)
             (:permission/document permission)
             (= (:db/id doc) (:permission/document permission))
             (not (permission-model/expired? permission))
             (cond (contains? (:permission/permits permission) :permission.permits/admin)
                   :admin
                   (contains? (:permission/permits permission) :permission.permits/read)
                   :read
                   :else nil))))

;; TODO: unify these so that there is only 1 permission type
;;       Could still have multiple permissions for a doc, but want
;;       to have 1 type. Owner would automatically get the owner permission
;; TODO: this should return a :permission/permits type of thing
(defn document-permission [db doc auth]
  (or (cust-permission db doc (:cust auth))
      (access-grant-permission db doc (:access-grant auth))
      (permission-permission db doc (:permission auth))))

(def scope-heirarchy [:read :admin :owner])

(defn contains-scope? [heirarchy granted-scope requested-scope]
  (contains? (set (take (inc (.indexOf heirarchy granted-scope)) heirarchy))
             requested-scope))

;; TODO: public and have permission are different things
(defn has-document-permission? [db doc auth scope]
  (or (= :document.privacy/public (:document/privacy doc))
      (contains-scope? scope-heirarchy (document-permission db doc auth) scope)))

(defn logged-in? [ring-req]
  (seq (get-in ring-req [:auth :cust])))

(ns pc.auth
  (:require [cheshire.core :as json]
            [clojure.tools.logging :as log]
            [crypto.equality :as crypto]
            [datomic.api :as d]
            [org.httpkit.client :as http]
            [pc.analytics :as analytics]
            [pc.auth.google :as google-auth]
            [pc.crm :as crm]
            [pc.models.cust :as cust]
            [pc.models.permission :as permission-model]
            [pc.datomic :as pcd]
            [pc.profile :as profile]
            [pc.utils :as utils])
  (:import java.util.UUID))

(defn update-user-from-sub [cust]
  (let [sub (:google-account/sub cust)
        {:keys [first-name last-name gender
                avatar-url birthday occupation]} (utils/with-report-exceptions
                                                   (google-auth/user-info-from-sub sub))
        cust (-> cust
               (cust/update! (utils/remove-map-nils {:cust/first-name first-name
                                                     :cust/last-name last-name
                                                     :cust/birthday birthday
                                                     :cust/gender gender
                                                     :cust/occupation occupation
                                                     :google-account/avatar avatar-url}))
               crm/update-with-dribbble-username)]
    (utils/with-report-exceptions
      (analytics/track-user-info cust))
    (when (profile/prod?)
      (utils/with-report-exceptions
        (crm/ping-chat-with-new-user cust)))
    cust))

(defn cust-from-google-oauth-code [code ring-req]
  {:post [(string? (:google-account/sub %))]} ;; should never break, but just in case...
  (let [user-info (google-auth/user-info-from-code code)
        db (pcd/default-db)]
    (if-let [cust (cust/find-by-google-sub db (:sub user-info))]
      (do
        (analytics/track-login cust)
        (cust/update! cust (merge {:cust/email (:email user-info)
                                   :cust/verified-email (:email_verified user-info)}
                                  (when-not (:cust/http-session-key cust)
                                    {:cust/http-session-key (UUID/randomUUID)}))))
      (try
        (let [user (cust/create! {:cust/email (:email user-info)
                                  :cust/verified-email (:email_verified user-info)
                                  :cust/http-session-key (UUID/randomUUID)
                                  :google-account/sub (:sub user-info)
                                  :cust/uuid (UUID/randomUUID)})]
          (analytics/track-signup user ring-req)
          (future (utils/with-report-exceptions (update-user-from-sub user)))
          user)
        (catch Exception e
          (if (pcd/unique-conflict? e)
            (cust/find-by-google-sub (pcd/default-db) (:sub user-info))
            (throw e)))))))

(def prcrsr-bot-email "prcrsr-bot@prcrsr.com")
(defn prcrsr-bot-uuid [db]
  (ffirst (d/q '{:find [?u]
                 :in [$ ?e]
                 :where [[?t :cust/email ?e]
                         [?t :cust/uuid ?u]]}
               db prcrsr-bot-email)))

(defn cust-permission [db doc cust]
  (when cust
    (cond (and (:document/creator doc)
               (crypto/eq? (str (:cust/uuid cust))
                           (str (:document/creator doc))))
          :owner

          (contains? (permission-model/permits db doc cust) :permission.permits/admin)
          :admin

          :else nil)))

(defn access-grant-permission [db doc access-grant]
  (when (and access-grant
             (:db/id doc)
             (= (:db/id doc)
                (:access-grant/document access-grant)))
    :read))

(defn permission-permission [db doc permission]
  (when (and permission
             (:db/id doc)
             (:permission/document permission)
             (= (:db/id doc) (:permission/document permission))
             (not (permission-model/expired? permission)))
    (cond (contains? (:permission/permits permission) :permission.permits/admin)
          :admin
          (contains? (:permission/permits permission) :permission.permits/read)
          :read
          :else nil)))

;; TODO: unify these so that there is only 1 permission type
;;       Could still have multiple permissions for a doc, but want
;;       to have 1 type. Owner would automatically get the owner permission
;; TODO: this should return a :permission/permits type of thing
(defn document-permission [db doc auth]
  (or (cust-permission db doc (:cust auth))
      ;; TODO: stop using access grant tokens as permissions
      ;;       Can remove once all of the tokens expire
      (access-grant-permission db doc (:access-grant auth))
      (permission-permission db doc (:permission auth))))

(def scope-heirarchy [:read :admin :owner])

(defn contains-scope? [heirarchy granted-scope requested-scope]
  (contains? (set (take (inc (.indexOf heirarchy granted-scope)) heirarchy))
             requested-scope))

;; TODO: public and have permission are different things
(defn has-document-permission? [db doc auth scope]
  (or (= :document.privacy/public (:document/privacy doc))
      (contains-scope? scope-heirarchy (document-permission db doc auth) scope)))

(defn logged-in? [ring-req]
  (seq (get-in ring-req [:auth :cust])))

fix paren nesting

fix paren nesting


(ns <%= namespace %>.<%= domain %>.list.views
    (:require [reagent.core :as r]
              [re-frame.core :refer [subscribe dispatch]]
              [<%= namespace %>.<%= domain %>.item.views :refer [<%= domain %>-item]]))

;; Display <%= domain %> list

(defn <%= domain %>-list []
  (let list (subscribe [:get-<%= domain %>-list])
    [:div {:class "<%= domain %>-list"}
      [:h3 "<%= domain %> list"]
      [:ul
        (for [item list]
          (<%= domain %>-item item))
      ]
      [:button "Create <%= domain %>" #(dispatch [:new-<%= domain %>])]
    ]))

(ns <%= namespace %>.<%= domain %>.list.views
    (:require [reagent.core :as r]
              [re-frame.core :refer [subscribe dispatch]]
              [<%= namespace %>.<%= domain %>.item.views :refer [<%= domain %>-item]]))

;; Display <%= domain %> list

(defn <%= domain %>-list []
  (let [list (subscribe [:get-<%= domain %>-list])]
    [:div {:class "<%= domain %>-list"}
      [:h3 "<%= domain %> list"]
      [:ul
        (for [item list]
          (<%= domain %>-item item))
      ]
      [:button "Create <%= domain %>" #(dispatch [:new-<%= domain %>])]
    ]))

Fix typo in list/views, put let binding in a vector

Throwing "ANALYSIS ERROR: let requires a vector for its binding at line ..."


;; Copyright (c) 2011-2016 Juan Pedro Bolivar Puente <raskolnikov@gnu.org>
;;
;; This file is part of Sinusoid.es.
;;
;; Sinusoid.es is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; Sinusoid.es is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with Sinusoid.es.  If not, see
;; <http://www.gnu.org/licenses/>.

(ns sinusoides.views.think
  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
  (:require [sinusoides.views.sinusoid :as sinusoid]
            [sinusoides.views.addons :refer [css-transitions]]
            [sinusoides.util :as util]
            [clojure.string :as string]
            [clojure.string :as string]
            [cljs.core.match :refer-macros [match]]
            [cljs-http.client :as http]
            [cljs.core.async :as async :refer [<! >!]]
            [reagent.core :as r]
            [goog.events :as events]))

(def sc-client-id
  "485230fd2a6e151244a57a584f904070")

(defn sc-add-client-id [api-call]
  (str api-call "?client_id=" sc-client-id))

(defn sc-api [& command]
  (http/jsonp (sc-add-client-id
                (str "http://api.soundcloud.com"
                     (apply str command)
                     ".json"))))

(defn audio-player-state [source]
  {:source source
   :duration 0
   :current-time 0
   :progress 0
   :status nil})

(defn audio-player [state command-ch]
  (let [events (atom)
        source (r/track #(:source @state))
        ch     (->> (async/chan) (async/pipe command-ch))]
    (r/create-class
      {:component-did-mount
       (fn [this]
         (let [audio (r/dom-node this)

               update-time
               (fn []
                 (swap! state assoc-in [:duration] (.-duration audio))
                 (swap! state assoc-in [:current-time] (.-currentTime audio)))

               update-progress
               (fn []
                 (when (-> audio .-buffered .-length pos?)
                   (swap! state assoc-in [:progress] (-> audio
                                                         .-buffered
                                                         (.end 0)))))

               update-status
               (fn [status]
                 (prn "status changed:")
                 (prn "   - source: " @source)
                 (prn "   - status: " status)
                 (swap! state assoc-in [:status] status))]

           (reset!
             events
             [(events/listen audio "durationchange" update-time)
              (events/listen audio "timeupdate" update-time)
              (events/listen audio "progress" update-progress)
              (events/listen audio "play" #(update-status :playing))
              (events/listen audio "playing" #(update-status :playing))
              (events/listen audio "pause" #(update-status :paused))
              (events/listen audio "ended" #(update-status :ended))
              (events/listen audio "error" #(update-status :error))
              (events/listen audio "abort" #(update-status :aborted))
              (events/listen audio "stalled" #(update-status :stalled))])

           (go-loop []
             (match [(<! ch)]
                    [:play]        (do (.play audio) (recur))
                    [:pause]       (do (.pause audio) (recur))
                    [[:seek time]] (do (set! (.-currentTime audio) time) (recur))
                    :else nil))))

       :component-will-unmount
       (fn [this]
         (async/close! ch)
         (dorun (map events/unlistenByKey @events)))

       :reagent-render
       (fn []
         [:audio {:preload "none"
                  :src @source}])})))

(defn audio-player-view [source]
  (r/with-let [command-ch (async/chan)
               mouse-time (r/atom 0)
               state      (r/atom (audio-player-state source))

               toggle-play
               #(go (>! command-ch
                        (if (= (:status @state) :playing)
                          :pause :play)))

               update-mouse-time
               #(reset! mouse-time (-> (.-clientX %)
                                       (- (.-left (.getBoundingClientRect (.-target %))))
                                       (- (.-clientLeft (.-target %)))
                                       (/ (.-offsetWidth (.-target %)))
                                       (* (:duration @state))))

               seek-time
               #(go (>! command-ch [:seek @mouse-time]))]

    [:div.audio-player {:class (clj->js (:status @state))}
     [:div.play-button
      {:on-click toggle-play}]

     [:div.seek-bar
      {:on-click seek-time
       :on-mouse-move update-mouse-time}

      (when (pos? @mouse-time)
        [:div.seek-bar-tooltip
         {:class
          (cond
            (> @mouse-time (:progress @state)) "unbuffered"
            (> @mouse-time (:current-time @state)) "buffered"
            :else "played")
          :style {:left (-> @mouse-time
                            (/ (:duration @state))
                            (* 100)
                            (str "%"))}}
         (str (quot @mouse-time 60) ":"
              (int (rem @mouse-time 60)))])

      (when (pos? (:progress @state))
        [:div.seek-bar-loaded
         {:style {:width (-> (:progress @state)
                             (/ (:duration @state))
                             (* 100)
                             (str "%"))}}])

      (when (pos? (:duration @state))
        [:div.seek-bar-position
         {:style {:width (-> (:current-time @state)
                             (/ (:duration @state))
                             (* 100)
                             (str "%"))}}])]

     [audio-player state command-ch]]))

(defn soundcloud-thumbnail-view [thing]
  (r/with-let
    [data (r/atom nil)
     _    (go (let [response (<! (sc-api "/tracks/" (:track thing)))]
                (reset! data (:body response))))]
    (if @data
      (let [background (string/replace (:artwork_url @data)
                                       #"-large.jpg"
                                       "-t500x500.jpg")
            audio-src  (sc-add-client-id (:stream_url @data))]
        [:div.thingy.soundcloud
         {:style {:background-image (str "url(" background ")")}}
         [audio-player-view audio-src]])
      [:div.thingy.soundcloud])))

(defn text-thumbnail-view [thing]
  [:div.thingy.text (:title thing)])

(def thumbnail-view-map
  {"soundcloud" soundcloud-thumbnail-view
   "text"       text-thumbnail-view})

(defn think-view [sin think]
  (r/with-let [_ (go (let [response (<! (http/get "/data/think.json"))
                           entries  (map #(assoc % :slug (util/to-slug (:title %)))
                                         (:body response))]
                       (swap! think assoc-in [:entries] entries)))]
    [:div#think-page.page
     [:div#title (sinusoid/hovered sin) "Think."]
     [:div#stuff
      (for [thing (:entries @think)]
        ^{:key (:slug thing)}
        [(get thumbnail-view-map (:type thing)) thing])]]))

;; Copyright (c) 2011-2016 Juan Pedro Bolivar Puente <raskolnikov@gnu.org>
;;
;; This file is part of Sinusoid.es.
;;
;; Sinusoid.es is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; Sinusoid.es is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with Sinusoid.es.  If not, see
;; <http://www.gnu.org/licenses/>.

(ns sinusoides.views.think
  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
  (:require [sinusoides.views.sinusoid :as sinusoid]
            [sinusoides.views.addons :refer [css-transitions]]
            [sinusoides.util :as util]
            [clojure.string :as string]
            [clojure.string :as string]
            [cljs.core.match :refer-macros [match]]
            [cljs-http.client :as http]
            [cljs.core.async :as async :refer [<! >!]]
            [reagent.core :as r]
            [goog.events :as events]))

(def sc-client-id
  "485230fd2a6e151244a57a584f904070")

(defn sc-add-client-id [api-call]
  (str api-call "?client_id=" sc-client-id))

(defn sc-api [& command]
  (http/jsonp (sc-add-client-id
                (str "http://api.soundcloud.com"
                     (apply str command)
                     ".json"))))

(defn audio-player-state [source]
  {:source source
   :duration 0
   :current-time 0
   :progress 0
   :status nil})

(defn audio-player [state command-ch]
  (let [events (atom)
        source (r/track #(:source @state))
        ch     (->> (async/chan) (async/pipe command-ch))]
    (r/create-class
      {:component-did-mount
       (fn [this]
         (let [audio (r/dom-node this)

               update-time
               (fn []
                 (swap! state assoc-in [:duration] (.-duration audio))
                 (swap! state assoc-in [:current-time] (.-currentTime audio)))

               update-progress
               (fn []
                 (when (-> audio .-buffered .-length pos?)
                   (swap! state assoc-in [:progress] (-> audio
                                                         .-buffered
                                                         (.end 0)))))

               update-status
               (fn [status]
                 (prn "status changed:")
                 (prn "   - source: " @source)
                 (prn "   - status: " status)
                 (swap! state assoc-in [:status] status))]

           (reset!
             events
             [(events/listen audio "durationchange" update-time)
              (events/listen audio "timeupdate" update-time)
              (events/listen audio "progress" update-progress)
              (events/listen audio "play" #(update-status :play))
              (events/listen audio "playing" #(update-status :playing))
              (events/listen audio "pause" #(update-status :paused))
              (events/listen audio "ended" #(update-status :ended))
              (events/listen audio "error" #(update-status :error))
              (events/listen audio "abort" #(update-status :aborted))
              (events/listen audio "stalled" #(update-status :stalled))])

           (go-loop []
             (match [(<! ch)]
                    [:play]        (do (when (let [st (:status @state)]
                                               (or (= st :error)
                                                   (= st :aborted)))
                                         (.load audio))
                                       (.play audio) (recur))
                    [:pause]       (do (.pause audio) (recur))
                    [[:seek time]] (do (set! (.-currentTime audio) time) (recur))
                    :else nil))))

       :component-will-unmount
       (fn [this]
         (async/close! ch)
         (dorun (map events/unlistenByKey @events)))

       :reagent-render
       (fn []
         [:audio {:preload "none"
                  :src @source}])})))

(defn audio-player-view [source]
  (r/with-let [command-ch (async/chan)
               mouse-time (r/atom 0)
               state      (r/atom (audio-player-state source))

               is-playing
               #(let [st (:status @state)]
                  (or (= st :play)
                      (= st :playing)
                      (= st :stalled)))

               toggle-play
               #(go (>! command-ch (if (is-playing) :pause :play)))

               update-mouse-time
               #(reset! mouse-time (-> (.-clientX %)
                                       (- (.-left (.getBoundingClientRect (.-target %))))
                                       (- (.-clientLeft (.-target %)))
                                       (/ (.-offsetWidth (.-target %)))
                                       (* (:duration @state))))

               seek-time
               #(go (>! command-ch [:seek @mouse-time]))]

    [:div.audio-player {:class (clj->js (:status @state))}
     [:div.play-button
      {:class (when (is-playing) "is-playing")
       :on-click toggle-play}]

     [:div.seek-bar
      {:on-click seek-time
       :on-mouse-move update-mouse-time}

      (when (pos? @mouse-time)
        [:div.seek-bar-tooltip
         {:class
          (cond
            (> @mouse-time (:progress @state)) "unbuffered"
            (> @mouse-time (:current-time @state)) "buffered"
            :else "played")
          :style {:left (-> @mouse-time
                            (/ (:duration @state))
                            (* 100)
                            (str "%"))}}
         (str (quot @mouse-time 60) ":"
              (int (rem @mouse-time 60)))])

      (when (pos? (:progress @state))
        [:div.seek-bar-loaded
         {:style {:width (-> (:progress @state)
                             (/ (:duration @state))
                             (* 100)
                             (str "%"))}}])

      (when (pos? (:duration @state))
        [:div.seek-bar-position
         {:style {:width (-> (:current-time @state)
                             (/ (:duration @state))
                             (* 100)
                             (str "%"))}}])]

     [audio-player state command-ch]]))

(defn soundcloud-thumbnail-view [thing]
  (r/with-let
    [data (r/atom nil)
     _    (go (let [response (<! (sc-api "/tracks/" (:track thing)))]
                (reset! data (:body response))))]
    (if @data
      (let [background (string/replace (:artwork_url @data)
                                       #"-large.jpg"
                                       "-t500x500.jpg")
            audio-src  (sc-add-client-id (:stream_url @data))]
        [:div.thingy.soundcloud
         {:style {:background-image (str "url(" background ")")}}
         [audio-player-view audio-src]])
      [:div.thingy.soundcloud])))

(defn text-thumbnail-view [thing]
  [:div.thingy.text (:title thing)])

(def thumbnail-view-map
  {"soundcloud" soundcloud-thumbnail-view
   "text"       text-thumbnail-view})

(defn think-view [sin think]
  (r/with-let [_ (go (let [response (<! (http/get "/data/think.json"))
                           entries  (map #(assoc % :slug (util/to-slug (:title %)))
                                         (:body response))]
                       (swap! think assoc-in [:entries] entries)))]
    [:div#think-page.page
     [:div#title (sinusoid/hovered sin) "Think."]
     [:div#stuff
      (for [thing (:entries @think)]
        ^{:key (:slug thing)}
        [(get thumbnail-view-map (:type thing)) thing])]]))

Make play command more resilient

Make play command more resilient


(ns status-im.chat.sign-up
  (:require [re-frame.core :refer [subscribe dispatch dispatch-sync]]
            [status-im.components.styles :refer [default-chat-color]]
            [status-im.utils.utils :refer [http-post]]
            [status-im.utils.random :as random]
            [status-im.utils.sms-listener :refer [add-sms-listener
                                                  remove-sms-listener]]
            [status-im.utils.phone-number :refer [format-phone-number]]
            [status-im.constants :refer [console-chat-id
                                         text-content-type
                                         content-type-command
                                         content-type-command-request
                                         content-type-status]]
            [status-im.i18n :refer [label]]
            [clojure.string :as s]))

(defn send-console-message [text]
  {:message-id   (random/id)
   :from         "me"
   :to           console-chat-id
   :content      text
   :content-type text-content-type
   :outgoing     true})

; todo fn name is not too smart, but...
(defn command-content
  [command content]
  {:command (name command)
   :content content})

;; -- Send phone number ----------------------------------------
(defn on-sign-up-response [& [message]]
  (let [message-id (random/id)]
    (dispatch [:received-message
               {:message-id   message-id
                :content      (command-content
                                :confirmation-code
                                (or message (label :t/confirmation-code)))
                :content-type content-type-command-request
                :outgoing     false
                :from         console-chat-id
                :to           "me"}])))

(defn handle-sms [{body :body}]
  (when-let [matches (re-matches #"(\d{4})" body)]
    (dispatch [:sign-up-confirm (second matches)])))

(defn start-listening-confirmation-code-sms [db]
  (if (not (:confirmation-code-sms-listener db))
    (assoc db :confirmation-code-sms-listener (add-sms-listener handle-sms))
    db))

(defn stop-listening-confirmation-code-sms [db]
  (when-let [listener (:confirmation-code-sms-listener db)]
    (remove-sms-listener listener)
    (dissoc db :confirmation-code-sms-listener)))

;; -- Send confirmation code and synchronize contacts---------------------------
(defn on-sync-contacts []
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      (label :t/contacts-syncronized)
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"}])
  (dispatch [:set-signed-up true]))

(defn sync-contacts []
  ;; TODO 'on-sync-contacts' is never called
  (dispatch [:sync-contacts on-sync-contacts]))

(defn on-send-code-response [body]
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      (:message body)
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"}])
  (let [status (keyword (:status body))]
    (when (= :confirmed status)
      (do
        (dispatch [:stop-listening-confirmation-code-sms])
        (sync-contacts)
        ;; TODO should be called after sync-contacts?
        (dispatch [:set-signed-up true])))
    (when (= :failed status)
      (on-sign-up-response (label :t/incorrect-code)))))

(defn start-signup []
  (let [message-id (random/id)]
    (dispatch [:received-message
               {:message-id   message-id
                :content      (command-content
                                :phone
                                (label :t/phone-number-required))
                :content-type content-type-command-request
                :outgoing     false
                :from         console-chat-id
                :to           "me"}])))

;; -- Saving password ----------------------------------------
(defn passpharse-messages [mnemonic]
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      (label :t/here-is-your-passphrase)
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"
              :new?         false}])
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      mnemonic
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"
              :new?         false}])
  ;; TODO highlight '!phone'
  (start-signup))

(def intro-status
  {:message-id   "intro-status"
   :content      (label :t/intro-status)
   :from         console-chat-id
   :chat-id      console-chat-id
   :content-type content-type-status
   :outgoing     false
   :to           "me"})

(defn intro []
  (dispatch [:received-message intro-status])
  (dispatch [:received-message
             {:message-id   "intro-message1"
              :content      (command-content
                              :password
                              (label :t/intro-message1))
              :content-type content-type-command-request
              :outgoing     false
              :from         console-chat-id
              :to           "me"}]))

(def console-chat
  {:chat-id    console-chat-id
   :name       (s/capitalize console-chat-id)
   ; todo remove/change dapp config fot console
   :dapp-url   "http://localhost:8185/resources"
   :dapp-hash  858845357
   :color      default-chat-color
   :group-chat false
   :is-active  true
   :timestamp  (.getTime (js/Date.))
   :photo-path console-chat-id
   :contacts   [{:identity         console-chat-id
                 :text-color       "#FFFFFF"
                 :background-color "#AB7967"}]})

(def console-contact
  {:whisper-identity console-chat-id
   :name             (s/capitalize console-chat-id)
   :photo-path       console-chat-id
   :dapp?            true})

(ns status-im.chat.sign-up
  (:require [re-frame.core :refer [subscribe dispatch dispatch-sync]]
            [status-im.components.styles :refer [default-chat-color]]
            [status-im.utils.utils :refer [http-post]]
            [status-im.utils.random :as random]
            [status-im.utils.sms-listener :refer [add-sms-listener
                                                  remove-sms-listener]]
            [status-im.utils.phone-number :refer [format-phone-number]]
            [status-im.constants :refer [console-chat-id
                                         text-content-type
                                         content-type-command
                                         content-type-command-request
                                         content-type-status]]
            [status-im.i18n :refer [label]]
            [clojure.string :as s]))

(defn send-console-message [text]
  {:message-id   (random/id)
   :from         "me"
   :to           console-chat-id
   :content      text
   :content-type text-content-type
   :outgoing     true})

; todo fn name is not too smart, but...
(defn command-content
  [command content]
  {:command (name command)
   :content content})

;; -- Send phone number ----------------------------------------
(defn on-sign-up-response [& [message]]
  (let [message-id (random/id)]
    (dispatch [:received-message
               {:message-id   message-id
                :content      (command-content
                                :confirmation-code
                                (or message (label :t/confirmation-code)))
                :content-type content-type-command-request
                :outgoing     false
                :from         console-chat-id
                :to           "me"}])))

(defn handle-sms [{body :body}]
  (when-let [matches (re-matches #"(\d{4})" body)]
    (dispatch [:sign-up-confirm (second matches)])))

(defn start-listening-confirmation-code-sms [db]
  (if (not (:confirmation-code-sms-listener db))
    (assoc db :confirmation-code-sms-listener (add-sms-listener handle-sms))
    db))

(defn stop-listening-confirmation-code-sms [db]
  (when-let [listener (:confirmation-code-sms-listener db)]
    (remove-sms-listener listener)
    (dissoc db :confirmation-code-sms-listener)))

;; -- Send confirmation code and synchronize contacts---------------------------
(defn on-sync-contacts []
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      (label :t/contacts-syncronized)
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"}])
  (dispatch [:set-signed-up true]))

(defn sync-contacts []
  ;; TODO 'on-sync-contacts' is never called
  (dispatch [:sync-contacts on-sync-contacts]))

(defn on-send-code-response [body]
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      (:message body)
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"}])
  (let [status (keyword (:status body))]
    (when (= :confirmed status)
      (do
        (dispatch [:stop-listening-confirmation-code-sms])
        (sync-contacts)
        ;; TODO should be called after sync-contacts?
        (dispatch [:set-signed-up true])))
    (when (= :failed status)
      (on-sign-up-response (label :t/incorrect-code)))))

(defn start-signup []
  (let [message-id (random/id)]
    (dispatch [:received-message
               {:message-id   message-id
                :content      (command-content
                                :phone
                                (label :t/phone-number-required))
                :content-type content-type-command-request
                :outgoing     false
                :from         console-chat-id
                :to           "me"}])))

;; -- Saving password ----------------------------------------
(defn passpharse-messages [mnemonic]
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      (label :t/here-is-your-passphrase)
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"
              :new?         false}])
  (dispatch [:received-message
             {:message-id   (random/id)
              :content      mnemonic
              :content-type text-content-type
              :outgoing     false
              :from         console-chat-id
              :to           "me"
              :new?         false}])
  ;; TODO highlight '!phone'
  (start-signup))

(def intro-status
  {:message-id   "intro-status"
   :content      (label :t/intro-status)
   :from         console-chat-id
   :chat-id      console-chat-id
   :content-type content-type-status
   :outgoing     false
   :to           "me"})

(defn intro []
  (dispatch [:received-message intro-status])
  (dispatch [:received-message
             {:chat-id      console-chat-id
              :message-id   "intro-message1"
              :content      (command-content
                              :password
                              (label :t/intro-message1))
              :content-type content-type-command-request
              :outgoing     false
              :from         console-chat-id
              :to           "me"}]))

(def console-chat
  {:chat-id    console-chat-id
   :name       (s/capitalize console-chat-id)
   ; todo remove/change dapp config fot console
   :dapp-url   "http://localhost:8185/resources"
   :dapp-hash  858845357
   :color      default-chat-color
   :group-chat false
   :is-active  true
   :timestamp  (.getTime (js/Date.))
   :photo-path console-chat-id
   :contacts   [{:identity         console-chat-id
                 :text-color       "#FFFFFF"
                 :background-color "#AB7967"}]})

(def console-contact
  {:whisper-identity console-chat-id
   :name             (s/capitalize console-chat-id)
   :photo-path       console-chat-id
   :dapp?            true})

fix #423

fix #423


(ns test-utils.word-source
   (:require [clojure.string :as clj-str]))

#?(:cljs (def fs (js/require "fs")))

(defn read-text-file [pathname]
  #?(:cljs (.readFileSync fs pathname "utf-8"))
  #?(:clj (slurp pathname)))

(defn empty-string? [to-test]
  "Determine if to-test is an empty string."
  (and (string? to-test)
       (== #?(:cljs (.-length to-test))
           #?(:clj (.length to-test))
           0)))

(defn parse-lines [text]
  (clj-str/split text #"\n"))

(defn empty-string-sequence? [to-test]
  "Determine if to-test is a sequence containing only an empty string."
  (and (= 1 (count to-test))
       (empty-string? (first to-test))))

(defn parse-definitions [lines]
  (->> lines
       (drop 2)
       (map #(.trim %))
       (partition-by empty-string?)
       (remove empty-string-sequence?)))

(defn read-latin-words-from [pathname]
  (let [definitions (-> pathname
                        (read-text-file)
                        (parse-lines)
                        (parse-definitions))]
    (map #(str (first %) (second %)) definitions)))

(def read-latin-words (memoize read-latin-words-from))

(defn rand-word
  ([] (rand-word (read-latin-words "latin-words.md") rand-nth))
  ([words rand-f] (rand-f words)))

(defn rand-words
  "Return a sequence of `n` (defaults to 3) random words."
  ([] (rand-words 3))
  ([n] (repeatedly n rand-word)))

(defn noun-mnemonic [declension]
  (println
    (case declension
      1 (clj-str/join "\n" ["Maria, queen of reggae, gave Fannie Mae some jam for her bananā.",
                            "Fannie Mae, fond of ā rum, gave the Israelīs some bananās from the delīs."])
      2 (clj-str/join "\n" ["Gus and Peter, friends of Luigī, gave Mariō some gum for his burritō.",
                            "He and Ī, kings of the quōrum, gave the Israelīs some burritōs from the delīs."])
      3 (clj-str/join "\n" ["The Black Hole Gang*, friends of Beavis, gave Bambī a gem from Chile.",
                            "The Apachēs, masters of the drum, gave the minibus some tamalēs from the omnibus."]))))

(defn grammar-gender [] (rand-nth [:m :f :n]))

(defn grammar-number [] (rand-nth [:s :pl]))

(defn grammar-case [] (rand-nth [:nom :gen :dat :acc :abl :voc]))

(defn grammar-person [] (rand-nth [:1st :2nd :3rd]))

(defn grammar-mood [] (rand-nth [:indicative :subjunctive :imperative :infinitive]))

(defn grammar-tense [] (rand-nth [:present :imperfect :future :perfect :pluperfect :future-perfect]))

(defn declension [] [(grammar-gender) (grammar-number) (grammar-case)])

(defn conjugation [] [(grammar-person) (grammar-mood) (grammar-number) (grammar-tense)])

(ns test-utils.word-source
   (:require [clojure.string :as clj-str]))

#?(:cljs (def fs (js/require "fs")))

(defn read-text-file [pathname]
  #?(:cljs (.readFileSync fs pathname "utf-8"))
  #?(:clj (slurp pathname)))

(defn empty-string? [to-test]
  "Determine if to-test is an empty string."
  (and (string? to-test)
       (== #?(:cljs (.-length to-test))
           #?(:clj (.length to-test))
           0)))

(defn parse-lines [text]
  (clj-str/split text #"\n"))

(defn empty-string-sequence? [to-test]
  "Determine if to-test is a sequence containing only an empty string."
  (and (= 1 (count to-test))
       (empty-string? (first to-test))))

(defn parse-definitions [lines]
  (->> lines
       (drop 2)
       (map #(.trim %))
       (partition-by empty-string?)
       (remove empty-string-sequence?)))

(defn read-latin-words-from [pathname]
  (let [definitions (-> pathname
                        (read-text-file)
                        (parse-lines)
                        (parse-definitions))]
    (map #(str (first %) (second %)) definitions)))

(def read-latin-words (memoize read-latin-words-from))

(defn rand-word
  ([] (rand-word (read-latin-words "latin-words.md") rand-nth))
  ([words rand-f] (rand-f words)))

(defn rand-words
  "Return a sequence of `n` (defaults to 3) random words."
  ([] (rand-words 3))
  ([n] (repeatedly n rand-word)))

(defn noun-mnemonic [declension]
  (println
    (case declension
      1 (clj-str/join "\n" ["Maria, queen of reggae, gave Fannie Mae some jam for her bananā.",
                            "Fannie Mae, fond of ā rum, gave the Israelīs some bananās from the delīs."])
      2 (clj-str/join "\n" ["Gus and Peter, friends of Luigī, gave Mariō some gum for his burritō.",
                            "He and Ī, kings of the quōrum, gave the Israelīs some burritōs from the delīs."])
      3 (clj-str/join "\n" ["The Black Hole Gang*, friends of Beavis, gave Bambī a gem from Chile.",
                            "The Apachēs, masters of the drum, gave the minibus some tamalēs from the omnibus."]))))

(defn grammar-gender [] (rand-nth [:m :f :n]))

(defn grammar-number [] (rand-nth [:s :pl]))

(defn grammar-case [] (rand-nth [:nom :gen :dat :acc :abl :voc]))

(defn grammar-person [] (rand-nth [:1st :2nd :3rd]))

(defn grammar-mood [] (rand-nth [:indicative :subjunctive :imperative :infinitive]))

(defn grammar-tense [] (rand-nth [:present :imperfect :future :perfect :pluperfect :future-perfect]))

(defn declension [] [(grammar-number) (grammar-case)])

(defn conjugation [] [(grammar-person) (grammar-mood) (grammar-number) (grammar-tense)])

Remove gender from random declension

Remove gender from random declension


(ns patient.routes
  (:require [reagent.core :as r]
            [re-frame.core :as rf]
            [mobile-patient.ui :as ui]
            [mobile-patient.color :as color]
            [mobile-patient.route-helpers :as rh]
            [mobile-patient.routes :refer [routes]]
            [patient.drawer :refer [Drawer]]))

(defn dumb-component [text]
  (r/reactify-component (fn [] [ui/text text])))

(def drawer-routes
  (ui/DrawerNavigator
   routes
   (clj->js
    {:initialRouteName "Vitals Signs" ;;for dev
     :drawerWidth 250
     :contentComponent (fn [props]
                         (r/as-element [Drawer props]))})))

(ns patient.routes
  (:require [reagent.core :as r]
            [re-frame.core :as rf]
            [mobile-patient.ui :as ui]
            [mobile-patient.color :as color]
            [mobile-patient.route-helpers :as rh]
            [mobile-patient.routes :refer [routes]]
            [patient.drawer :refer [Drawer]]))

(defn dumb-component [text]
  (r/reactify-component (fn [] [ui/text text])))

(def drawer-routes
  (ui/DrawerNavigator
   routes
   (clj->js
    {;;:initialRouteName "Vitals Signs" ;;for dev
     :drawerWidth 250
     :contentComponent (fn [props]
                         (r/as-element [Drawer props]))})))

disable dev default route

disable dev default route


(ns com.palletops.hyde-pallet.core
  (:require [palletops.hyde :as hyde]
            [clojure.walk :refer [postwalk]]
            [clojure.edn :as edn]
            [clojure.java.io :refer [resource file as-file]]
            [clojure.string :as string]))

(def jekyll-config
  {:gems
   [{:gem "jekyll" :version "2.0.3"}
    {:gem "rouge" :version "~> 1.3"}
    {:gem "coderay"}]})

(def site-config
  {:template :crate
   :config
   {:name "test site"
    :title "test title"
    :description "this si a long description"
;;    :highlighter "rouge"
    :markdown "kramdown"
    :kramdown {:use_coderay "true"
               :enable_coderay "true"
               :input "GFM"
               :hard_wrap "false"
               :coderay
               {:coderay_line_numbers "nil"
                :coderay_css "class"
                :coderay_wrap "div"
                :coderay_tab_width "2"
                :coderay_bold_every "false"}}
    :collections
    {:api
     {:output true
      :layout "post"}}}})

(defn clean-api [api-doc]
  (let [;; if `d` is a map, replace the value for key `k` with the
        ;; results of applying the function `fk` to it
        swapper (fn [d k fk]
                  (if-let [v (k d)]
                    (assoc d k (fk v))
                    d))
        ;; turn all symbols into strings
        clean-arglists (fn [al]
                         (postwalk (fn [x] (if (symbol? x) (str x) x)) al))
        indent-md-headers (fn [d] (-> d
                                     (string/replace #"^#" "###")
                                     (string/replace #"\n#" "\n###")))
        clean (fn [d]
                (-> d
                    (swapper :ns str)
                    (swapper :name str)
                    (swapper :var-type (comp str name))
                    (swapper :ns-name str)
                    (swapper :arglists clean-arglists)
                    (swapper :doc indent-md-headers)))]
    (postwalk clean api-doc)))

(defn build-site [root jekyll-config site-config]
  (hyde/create-collections-dirs! root site-config)
  (hyde/write-gemfile! root jekyll-config)
  (hyde/write-config! root site-config)
  (hyde/copy-resources! root site-config)
  (hyde/write-document! root {:path "_posts/2012-01-01-my-example.md"
                         :content "this is a *test*!"
                         :front-matter
                         {:title "This is the document"
                          :index 1}})
  (hyde/write-data!
   root "topbar-menu"
   {:brand "Sample Crate"
    :main-options
    [{:title "Home" :href "/"}
     {:title "Documentation" :href "/README.html"}
     {:title "API" :href "/api.html"}
     {:title "About" :href "/about"}]})

  (hyde/write-data!
   root "api-doc"
   (clean-api (edn/read-string (slurp (file  "target/docudata.edn")))))
  (hyde/write-collection!
   "/tmp/site"
   "api"
   {:index-key :my-index
    :docs [{:path "doc-a.md"
            :front-matter
            {:title "doc a"
             :layout "default"}
            :content "this is doc *a*"}
           {:path "doc-b.md"
            :front-matter
            {:title "doc b"
             :layout "default"}
            :content "this is verbatim *b*"}]})
  (hyde/write-document!
   root
   {:path "README.md"
    :front-matter
    {:title "lein-pallet-release"
     :layout "doc"}
    :content
     "A Leiningen plugin to release PalletOps projects.

Releases are made by creating a local release branch which is pushed
to github.  The branch will be built by travis, and pushed to master
and develop if it succeeds.  Jars are then built locally from master
and pushed to clojars.

## Usage

Add the plugin to your `:user` `:plugins` in `~/.lein/profiles.clj`:

```clojure
:plugins [[lein-pallet-release \"0.1.17\"]]
```
Install the
[travis command line](http://blog.travis-ci.com/2013-01-14-new-client/).

### init

The `init` subcommand is used to initialise a project for releasing
with a test on travis.  It requires a single argument, a 40 digit hex
github key for the `pbors` github user, that will be used to authorise
travis to push to github master if the build succeeds.  The key should
only have permissions to read and write repositories.

```
lein pallet-release init 435afe787ab878c32432435afe787ab878c32432
```

This will write the `.travis.yml` file if it doesn't exist.  It will also
add the plugin and configuration to `profiles.clj`.

After running the command, inspect the created files and commit them.
{: .alert .alert-success}

### start

To start a release, run:

```shell
lein pallet-release start previous-release new-release
```

This will create a release branch, enable the project on travis, and
update release notes, readme, etc.

After running, check the modifications.  Anything modified will be
commited by the `finish` command.

### finish New

To finish a release, run:

```shell
lein pallet-release finish
```

This will commit any modified files (eg. README.md, project.clj, etc)
with a commit message including the version number.

It then pushes the branch to github, from where travis will build it,
and push it back to the `master` and `develop` branches on github.

## test

alsfkjafs;dlkfj
lasjfda;slkdj
;lkjsdf;askjl

### Configuration

You can specify the url and branch travis should push to on the
 `:pallet-release` key.

```clojure
:pallet-release {:url \"Url for travis to push to\"
                 :develop-branch \"develop\"
                 :branch \"master\"}
```

## More clojure

```clojure
(defn sub-file
  \"Given a root path, it provides the path to a subdirectory defined
  by the subs vector of directory names\"
  [root subs]
  (path/render-path
   (path/normalize*
    (apply conj (path/parse-path root) subs))))

(defn sub-dir [root subs]
  (path/ensure-trailing-separator (sub-file root subs )))

(defn-api write-config!
  {:sig [[s/Str Site-Config :- s/Bool]]}
  [root {:keys [config] :as site-config}]
  (let [content (yaml/generate-string config)
        config-path (sub-file root [\"_config.yml\"])]
    (println \"path is\" config-path)
    (println \"content is\" content)
    (spit config-path content)
    true))

(defn gemfile [config]
  (stencil/render-file  \"Gemfile\" config))

(defn-api write-gemfile!
  {:sig [[s/Str Jekyll-Config :- s/Bool]]}
  [root config]
  (let [content (gemfile config)
        path (sub-file root [\"Gemfile\"])]
    (spit path content)
    true))

(defn-api create-collections-dirs!
  {:sig [[s/Str Site-Config :- s/Bool]]}
  [root {:keys [config]}]
  (let [default-dirs [\"_posts\" \"_includes\" \"_layouts\" \"_data\"]
        collections (-> config :collections keys)
        collection-dirs (map #(str \"_\" (name %)) collections)
        all-dirs (concat default-dirs collection-dirs)
        all-paths (map (partial sub-dir root) (map vector all-dirs))]
    (doseq [p all-paths] (println p))
    (doall (map fs/mkdirs all-paths))
    true))
```

## License

### test

Copyright © 2014 Hugo Duncan, Antoni Batchelli

Distributed under the Eclipse Public License either version 1.0 or (at
your option) any later version."}))

(ns com.palletops.hyde-pallet.core
  (:require [palletops.hyde :as hyde]
            [clojure.walk :refer [postwalk]]
            [clojure.edn :as edn]
            [clojure.java.io :refer [resource file as-file]]
            [clojure.string :as string]))

(def jekyll-config
  {:gems
   [{:gem "jekyll" :version "2.0.3"}
    {:gem "rouge" :version "~> 1.3"}
    {:gem "coderay"}]})

(def site-config
  {:template :crate
   :config
   {:name "test site"
    :title "test title"
    :description "this si a long description"
;;    :highlighter "rouge"
    :markdown "kramdown"
    :kramdown {:use_coderay "true"
               :enable_coderay "true"
               :input "GFM"
               :hard_wrap "false"
               :coderay
               {:coderay_line_numbers "nil"
                :coderay_css "class"
                :coderay_wrap "div"
                :coderay_tab_width "2"
                :coderay_bold_every "false"}}
    :collections
    {:api
     {:output true
      :layout "post"}}}})

(defn clean-api [api-doc]
  (let [;; if `d` is a map, replace the value for key `k` with the
        ;; results of applying the function `fk` to it
        swapper (fn [d k fk]
                  (if-let [v (k d)]
                    (assoc d k (fk v))
                    d))
        ;; turn all symbols into strings
        clean-arglists (fn [al]
                         (postwalk (fn [x] (if (symbol? x) (str x) x)) al))
        indent-md-headers (fn [d] (-> d
                                     (string/replace #"^#" "###")
                                     (string/replace #"\n#" "\n###")))
        clean (fn [d]
                (-> d
                    (swapper :ns str)
                    (swapper :name str)
                    (swapper :var-type (comp str name))
                    (swapper :ns-name str)
                    (swapper :arglists clean-arglists)
                    (swapper :doc indent-md-headers)))]
    (postwalk clean api-doc)))

(defrecord Project [project])
(defmethod hyde/render Project [p]
  (format "[%s](http://github.com/pallet/%s)" (:project p) (:project p)))

(defn build-site [root jekyll-config site-config]
  (hyde/create-collections-dirs! root site-config)
  (hyde/write-gemfile! root jekyll-config)
  (hyde/write-config! root site-config)
  (hyde/copy-resources! root site-config)
  (hyde/write-document! root {:path "_posts/2012-01-01-my-example.md"
                         :content "this is a *test*!"
                         :front-matter
                         {:title "This is the document"
                          :index 1}})
  (hyde/write-data!
   root "topbar-menu"
   {:brand "Sample Crate"
    :main-options
    [{:title "Home" :href "/"}
     {:title "Documentation" :href "/README.html"}
     {:title "API" :href "/api.html"}
     {:title "About" :href "/about"}]})

  (hyde/write-data!
   root "api-doc"
   (clean-api (edn/read-string (slurp (file  "target/docudata.edn")))))
  (hyde/write-collection!
   root
   "api"
   {:index-key :my-index
    :docs [{:path "doc-a.md"
            :front-matter
            {:title "doc a"
             :layout "default"}
            :content "this is doc *a*"}
           {:path "doc-b.md"
            :front-matter
            {:title "doc b"
             :layout "default"}
            :content "this is verbatim *b* [* #pallet/project pallet *]"}]}
   {'pallet/project #'->Project})
  (hyde/write-document!
   root
   {:path "README.md"
    :front-matter
    {:title "lein-pallet-release"
     :layout "doc"}
    :content
     "A Leiningen plugin to release PalletOps projects.

Releases are made by creating a local release branch which is pushed
to github. [* #pallet/project pallet *] The branch will be
built by travis, and pushed to master and develop if it succeeds. Jars
are then built locally from master and pushed to clojars.

## Usage

Add the plugin to your `:user` `:plugins` in `~/.lein/profiles.clj`:

```clojure
:plugins [[lein-pallet-release \"0.1.17\"]]
```
Install the
[travis command line](http://blog.travis-ci.com/2013-01-14-new-client/).

### init

The `init` subcommand is used to initialise a project for releasing
with a test on travis.  It requires a single argument, a 40 digit hex
github key for the `pbors` github user, that will be used to authorise
travis to push to github master if the build succeeds.  The key should
only have permissions to read and write repositories.

```
lein pallet-release init 435afe787ab878c32432435afe787ab878c32432
```

This will write the `.travis.yml` file if it doesn't exist.  It will also
add the plugin and configuration to `profiles.clj`.

After running the command, inspect the created files and commit them.
{: .alert .alert-success}

### start

To start a release, run:

```shell
lein pallet-release start previous-release new-release
```

This will create a release branch, enable the project on travis, and
update release notes, readme, etc.

After running, check the modifications.  Anything modified will be
commited by the `finish` command.

### finish New

To finish a release, run:

```shell
lein pallet-release finish
```

This will commit any modified files (eg. README.md, project.clj, etc)
with a commit message including the version number.

It then pushes the branch to github, from where travis will build it,
and push it back to the `master` and `develop` branches on github.

## test

alsfkjafs;dlkfj
lasjfda;slkdj
;lkjsdf;askjl

### Configuration

You can specify the url and branch travis should push to on the
 `:pallet-release` key.

```clojure
:pallet-release {:url \"Url for travis to push to\"
                 :develop-branch \"develop\"
                 :branch \"master\"}
```

## More clojure

```clojure
(defn sub-file
  \"Given a root path, it provides the path to a subdirectory defined
  by the subs vector of directory names\"
  [root subs]
  (path/render-path
   (path/normalize*
    (apply conj (path/parse-path root) subs))))

(defn sub-dir [root subs]
  (path/ensure-trailing-separator (sub-file root subs )))

(defn-api write-config!
  {:sig [[s/Str Site-Config :- s/Bool]]}
  [root {:keys [config] :as site-config}]
  (let [content (yaml/generate-string config)
        config-path (sub-file root [\"_config.yml\"])]
    (println \"path is\" config-path)
    (println \"content is\" content)
    (spit config-path content)
    true))

(defn gemfile [config]
  (stencil/render-file  \"Gemfile\" config))

(defn-api write-gemfile!
  {:sig [[s/Str Jekyll-Config :- s/Bool]]}
  [root config]
  (let [content (gemfile config)
        path (sub-file root [\"Gemfile\"])]
    (spit path content)
    true))

(defn-api create-collections-dirs!
  {:sig [[s/Str Site-Config :- s/Bool]]}
  [root {:keys [config]}]
  (let [default-dirs [\"_posts\" \"_includes\" \"_layouts\" \"_data\"]
        collections (-> config :collections keys)
        collection-dirs (map #(str \"_\" (name %)) collections)
        all-dirs (concat default-dirs collection-dirs)
        all-paths (map (partial sub-dir root) (map vector all-dirs))]
    (doseq [p all-paths] (println p))
    (doall (map fs/mkdirs all-paths))
    true))
```

## License

### test

Copyright © 2014 Hugo Duncan, Antoni Batchelli

Distributed under the Eclipse Public License either version 1.0 or (at
your option) any later version."}
    {'pallet/project #'->Project}))

Use extensible tags in examples.

Use extensible tags in examples.


(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))

(def ambly-bonjour-name-prefix "Ambly ")

(defn is-ambly-bonjour-name? [bonjour-name]
  (.startsWith bonjour-name ambly-bonjour-name-prefix))

(defn bonjour-name->display-name
  [bonjour-name]
  (subs bonjour-name (count ambly-bonjour-name-prefix)))

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

(defn print-discovered-devices [name-endpoint-map]
  (if (empty? name-endpoint-map)
    (println "(No devices)")
    (doseq [[choice-number [bonjour-name _]] (name-endpoint-map->choice-list name-endpoint-map)]
      (println (str "[" choice-number "] " (bonjour-name->display-name bonjour-name))))))

(defn discover-and-choose-device
  "Looks for Ambly WebDAV devices advertised via Bonjour and presents
  a simple command-line UI letting user pick one, unless
  choose-first-discovered? is set to true in which case the UI is bypassed"
  [choose-first-discovered?]
  (let [reg-type "_http._tcp.local."
        name-endpoint-map (atom (sorted-map))
        mdns-service (JmDNS/create)
        service-listener
        (reify ServiceListener
          (serviceAdded [_ service-event]
            (let [name (.getName service-event)]
              (when (is-ambly-bonjour-name? name)
                (.requestServiceInfo mdns-service (.getType service-event) (.getName service-event) 1))))
          (serviceRemoved [_ service-event]
            (swap! name-endpoint-map dissoc (.getName service-event)))
          (serviceResolved [_ service-event]
            (let [name (.getName service-event)]
              (when (is-ambly-bonjour-name? name)
                (let [entry {name (let [info (.getInfo service-event)]
                                    {:address (.getAddress info)
                                     :port    (.getPort info)})}]
                  (swap! name-endpoint-map merge entry))))))]
    (try
      (.addServiceListener mdns-service reg-type service-listener)
      (loop [count 0]
        (when (empty? @name-endpoint-map)
          (Thread/sleep 100)
          (when (= 20 count)
            (println "\nSearching for devices ..."))
          (recur (inc count))))
      (Thread/sleep 500)                                    ;; Sleep a little more to catch stragglers
      (loop [current-name-endpoint-map @name-endpoint-map]
        (println)
        (print-discovered-devices current-name-endpoint-map)
        (when-not choose-first-discovered?
          (println "\n[R] Refresh\n")
          (print "Choice: ")
          (flush))
        (let [choice (if choose-first-discovered? "1" (read-line))]
          (if (= "r" (.toLowerCase choice))
            (recur @name-endpoint-map)
            (let [choices (name-endpoint-map->choice-list current-name-endpoint-map)
                  choice-ndx (try (dec (Long/parseLong choice)) (catch NumberFormatException _ -1))]
              (if (< -1 choice-ndx (count choices))
                (second (nth choices choice-ndx))
                (recur current-name-endpoint-map))))))
      (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)
        [bonjour-name endpoint] (discover-and-choose-device (:choose-first-discovered repl-env))
        endpoint-address (.getHostAddress (:address endpoint))
        endpoint-port (:port 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")]
    (println "\nConnecting to" (bonjour-name->display-name bonjour-name) "...\n")
    (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})

  )

(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))

(def ambly-bonjour-name-prefix "Ambly ")

(defn is-ambly-bonjour-name? [bonjour-name]
  (.startsWith bonjour-name ambly-bonjour-name-prefix))

(defn bonjour-name->display-name
  [bonjour-name]
  (subs bonjour-name (count ambly-bonjour-name-prefix)))

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

(defn print-discovered-devices [name-endpoint-map]
  (if (empty? name-endpoint-map)
    (println "(No devices)")
    (doseq [[choice-number [bonjour-name _]] (name-endpoint-map->choice-list name-endpoint-map)]
      (println (str "[" choice-number "] " (bonjour-name->display-name bonjour-name))))))

(defn discover-and-choose-device
  "Looks for Ambly WebDAV devices advertised via Bonjour and presents
  a simple command-line UI letting user pick one, unless
  choose-first-discovered? is set to true in which case the UI is bypassed"
  [choose-first-discovered?]
  (let [reg-type "_http._tcp.local."
        name-endpoint-map (atom (sorted-map))
        mdns-service (JmDNS/create)
        service-listener
        (reify ServiceListener
          (serviceAdded [_ service-event]
            (let [name (.getName service-event)]
              (when (is-ambly-bonjour-name? name)
                (.requestServiceInfo mdns-service (.getType service-event) (.getName service-event) 1))))
          (serviceRemoved [_ service-event]
            (swap! name-endpoint-map dissoc (.getName service-event)))
          (serviceResolved [_ service-event]
            (let [name (.getName service-event)]
              (when (is-ambly-bonjour-name? name)
                (let [entry {name (let [info (.getInfo service-event)]
                                    {:address (.getAddress info)
                                     :port    (.getPort info)})}]
                  (swap! name-endpoint-map merge entry))))))]
    (try
      (.addServiceListener mdns-service reg-type service-listener)
      (loop [count 0]
        (when (empty? @name-endpoint-map)
          (Thread/sleep 100)
          (when (= 20 count)
            (println "\nSearching for devices ..."))
          (recur (inc count))))
      (Thread/sleep 500)                                    ;; Sleep a little more to catch stragglers
      (loop [current-name-endpoint-map @name-endpoint-map]
        (println)
        (print-discovered-devices current-name-endpoint-map)
        (when-not choose-first-discovered?
          (println "\n[R] Refresh\n")
          (print "Choice: ")
          (flush))
        (let [choice (if choose-first-discovered? "1" (read-line))]
          (if (= "r" (.toLowerCase choice))
            (recur @name-endpoint-map)
            (let [choices (name-endpoint-map->choice-list current-name-endpoint-map)
                  choice-ndx (try (dec (Long/parseLong choice)) (catch NumberFormatException _ -1))]
              (if (< -1 choice-ndx (count choices))
                (second (nth choices choice-ndx))
                (recur current-name-endpoint-map))))))
      (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/OFF)
        [bonjour-name endpoint] (discover-and-choose-device (:choose-first-discovered repl-env))
        endpoint-address (.getHostAddress (:address endpoint))
        endpoint-port (:port 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")]
    (println "\nConnecting to" (bonjour-name->display-name bonjour-name) "...\n")
    (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})

  )

Fix #33 AirDrop causes JmDNS to spew hex

Just turn logging off for now. Things still appear to work even with
all of the SEVERE warns.