;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.main.ui.workspace.recent-colors
  (:require [sablono.core :as html :refer-macros [html]]
            [rum.core :as rum]
            [lentes.core :as l]
            [uxbox.util.i18n :refer (tr)]
            [potok.core :as ptk]
            [uxbox.store :as st]
            [uxbox.main.data.workspace :as dw]
            [uxbox.main.ui.icons :as i]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.util.dom :as dom]
            [uxbox.main.ui.workspace.base :as wb]))

;; --- Helpers

(defn- count-color
  [state shape prop]
  (let [color (prop shape)]
    (if (contains? state color)
      (update state color inc)
      (assoc state color 1))))

(defn- calculate-colors
  [shapes]
  (as-> {} $
    (reduce #(count-color %1 %2 :fill) $ shapes)
    (reduce #(count-color %1 %2 :stroke) $ shapes)
    (remove nil? $)
    (sort-by second (into [] $))
    (take 5 (map first $))))

;; --- Component

(defn- recent-colors-render
  [own {:keys [page id] :as shape} callback]
  (let [shapes-by-id (mx/react wb/shapes-by-id-ref)
        shapes (->> (vals shapes-by-id)
                    (filter #(= (:page %) page)))
        colors (calculate-colors shapes)]
    (html
     [:div
      [:span (tr "ds.recent-colors")]
      [:div.row-flex
       (for [color colors]
         [:span.color-th {:style {:background-color color}
                          :key color
                          :on-click (partial callback color)}])
       (for [i (range (- 5 (count colors)))]
         [:span.color-th {:key (str "empty" i)}])
       [:span.color-th.palette-th i/picker]]])))

(def recent-colors
  (mx/component
   {:render recent-colors-render
    :name "recent-colors"
    :mixins [mx/static mx/reactive]}))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.main.ui.workspace.recent-colors
  (:require [lentes.core :as l]
            [potok.core :as ptk]
            [uxbox.store :as st]
            [uxbox.main.data.workspace :as dw]
            [uxbox.main.ui.workspace.base :as wb]
            [uxbox.main.ui.icons :as i]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.util.dom :as dom]
            [uxbox.util.i18n :refer (tr)]))

;; --- Helpers

(defn- count-color
  [state shape prop]
  (let [color (prop shape)]
    (if (contains? state color)
      (update state color inc)
      (assoc state color 1))))

(defn- calculate-colors
  [shapes]
  (as-> {} $
    (reduce #(count-color %1 %2 :fill-color) $ shapes)
    (reduce #(count-color %1 %2 :stroke-color) $ shapes)
    (remove nil? $)
    (sort-by second (into [] $))
    (take 5 (map first $))))

;; --- Component

(mx/defc recent-colors
  {:mixins [mx/static mx/reactive]}
  [{:keys [page id] :as shape} callback]
  (let [shapes-by-id (mx/react wb/shapes-by-id-ref)
        shapes (->> (vals shapes-by-id)
                    (filter #(= (:page %) page)))
        colors (calculate-colors shapes)]
    [:div
     [:span (tr "ds.recent-colors")]
     [:div.row-flex
      (for [color colors]
        [:span.color-th {:style {:background-color color}
                         :key color
                         :on-click (partial callback color)}])
      (for [i (range (- 5 (count colors)))]
        [:span.color-th {:key (str "empty" i)}])
      [:span.color-th.palette-th i/picker]]]))

Fix recent colors on shape color picker.


(ns
    ^{:doc "Browser events"}
  infinitelives.utils.events
  (:require
   [cljs.core.async :refer [put! chan <! >! alts! timeout close!]])
  (:require-macros
   [cljs.core.async.macros :refer [go]])
  )

;; a dynamic var that passes through ctrl+shift+key events
;; to the root event handler
(defonce ^:dynamic *devtools-passthrough* true)

;;
;; an atom which holds the present state of a key
;; true meaning pressed, and false or nil meaning raised
;;
(def key-state (atom {}))

(defn ascii
  "A clojurescript version of ascii value of. javascript doesn't have
  a char type, but uses a string of length 1 to represent"
  [c]
  (.charCodeAt c 0))

(def
  ^{:doc "A hashmap with a variety of keys (strings, keywords).
mapping to browser key codes. Use the is-pressed? function to test
keys directly.

Keycodes can be any string of length 1 representing a key (lowercase).
Keycodes can also be any of the following keywords

:backspace :tab :enter :shift :control :alt :pause :capslock :esc :space
:pageup :pagedown :end :home :left :up :right :down :insert :delete :f1
:f2 :f3 :f4 :f5 :f6 :f7 :f8 :f9 :f10 :f11 :f12 :numlock :scrolllock :comma
:. :/ :backtick :squareleft :backslash :squareright :quote

or any of the single alphanumeric lowercase characters as keywords

eg.
:w :a :s :d :1 :5 etc."}
  key-codes
  (merge
   {
    ;; lookup by code
    :backspace 8
    :tab 9
    :enter 13
    :shift 16
    :control 17
    :alt 18
    :pause 19
    :capslock 20
    :esc 27
    :space 32
    :pageup 33
    :pagedown 34
    :end 35
    :home 36
    :left 37
    :up 38
    :right 39
    :down 40
    :insert 45
    :delete 46
    :f1 112
    :f2 113
    :f3 114
    :f4 115
    :f5 116
    :f6 117
    :f7 118
    :f8 119
    :f9 120
    :f10 121
    :f11 122
    :f12 123
    :numlock 144
    :scrolllock 145
    :comma 188
    :. 190
    :/ 191
    :backtick 192
    :squareleft 219
    :backslash 220
    :squareright 221
    :quote 222
    }

   ;; lookup by keyword of char
   (for [c "0123456789abcdefghijklmnopqrstuvwxyz"]
     [(keyword (str c)) (- (ascii c) 32)])

   ;; lookup by char
   (for [c "0123456789abcdefghijklmnopqrstuvwxyz,.;'[]-=`/\\"]
     [c (- (ascii c) 32)])))

(defn handle-keydown-event
  "the base event handler for key down events. Takes the keycode
  and sets that key in the key-state dictionary to true"
  [ev]
  (swap! key-state (fn [old] (assoc old (.-keyCode ev) true)))

  ;; if debug, we should passthrough ctrl-shift keys for dev tools
  (if (and *devtools-passthrough* (.-ctrlKey ev) (.-shiftKey ev))
    ;; pass through keypress
    false

    ;; else prevent event propagation (cursor keys scroll body on mozilla)
    (.preventDefault ev)))

(defn handle-keyup-event
  "the basic event handler for key up events. Takes the keycode
  and removes it as a key from the key-state dictionary"
  [ev]
  (swap! key-state (fn [old] (dissoc old (.-keyCode ev))))

  ;; stop event propagation on mozilla
  (.preventDefault ev)

  true)

(defn install-key-handler!
  "install the keyup and keydown event handlers"
  []
  (.addEventListener js/window "keydown" handle-keydown-event)
  (.addEventListener js/window "keyup" handle-keyup-event))

(defn is-pressed?
  "returns true if the key is pressently down. code is a keyword,
  or a string of length 1. Examples:

  ```
  ;; test if keys are down by keyword
  (is-pressed? :backspace)
  (is-pressed? :f10)
  (is-pressed? :left)
  (is-pressed? :space)
  (is-pressed? :w)
  (is-pressed? :a)

  ;; test if keys are down by string
  (is-pressed? \" \")
  (is-pressed? \"w\")
  (is-pressed? \"a\")
  (is-pressed? \"d\")
  (is-pressed? \"s\")
  ```

  See key-codes for a list of keyword keys.
"
  [code]
  (@key-state (key-codes code)))

;;
;; Animation handler
;;
(defn make-request-animation-frame
  "compose a function that is the r-a-f func. returns a function. This returned function takes a callback and ensures
  its called next frame"
  []
  (cond
   (.-requestAnimationFrame js/window)
   #(.requestAnimationFrame js/window %)

   (.-webkitRequestAnimationFrame js/window)
   #(.webkitRequestAnimationFrame js/window %)

   (.-mozRequestAnimationFrame js/window)
   #(.mozRequestAnimationFrame js/window %)

   (.-oRequestAnimationFrame js/window)
   #(.oRequestAnimationFrame js/window %)

   (.-msRequestAnimationFrame js/window)
   #(.msRequestAnimationFrame js/window %)

   :else
   #(.setTimeout js/window % (/ 1000 *target-fps*))))

;; build the actual function
(def
  ^{:arglist '([callback])
    :doc "schedules the passed in callback to be fired once, next animation frame."}
  request-animation-frame (make-request-animation-frame))

(defn next-frame
  "returns a single use channel which closes on next frame callback.
  pulling from it waits exactly one frame. eg

  ```
  ;; wait one frame
  (<! (next-frame))
  ```"
  []
  (let [c (chan)]
    (request-animation-frame #(close! c))
    c))

(defn wait-frames
  "returns a channel which closes when a certain number
  of frames have passed. eg

  ```
  ;; wait 10 frames
  (<! (wait-frames 10))
  ```"
  [frames]
  (go
    (loop [i frames]
      (when (pos? i)
        (<! (next-frame))
        (recur (dec i))))))

(defn wait-time
  "returns a channel which closes when a certain amount of
  time in milliseconds has passed, but determines that time by counting
  the requestAnimationFrame callbacks, so that when tab focus is lost,
  the callback, and thus this wait is suspended.

  ```
  ;; wait one seconds worth of frames
  (<! (wait-time 1000))
  ```"
  [delay]
  (wait-frames (* 60 (/ delay 1000))))

move request-animation-frame stuff into utils. Its not pixi specific.


;; Copyright 2014-2015 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns immutant.web.async
  "Provides a common interface for WebSockets and HTTP streaming."
  (:require [immutant.internal.options :as o]
            [immutant.internal.util    :as u])
  (:import [org.projectodd.wunderboss.web.async Channel Channel$OnComplete HttpChannel]
           [org.projectodd.wunderboss.web.async.websocket WebsocketChannel]
           [java.io File FileInputStream InputStream]
           [java.util Arrays Map]
           clojure.lang.ISeq))

(defn ^:internal ^:no-doc streaming-body? [body]
  (instance? HttpChannel body))

(defn ^:internal ^:no-doc open-stream [^HttpChannel channel response-map
                                       set-status-fn set-headers-fn]
  (doto channel
    (.attach :response-map response-map)
    (.attach :set-status-fn set-status-fn)
    (.attach :set-headers-fn set-headers-fn)
    (.notifyOpen nil)))

(defmulti ^:internal ^:no-doc initialize-stream :handler-type)

(defmulti ^:internal ^:no-doc initialize-websocket :handler-type)

(defprotocol ^:private MessageDispatch
  (dispatch-message [from ch options-map]))

(defn ^:private notify
  ([ch callback]
   (notify ch callback nil))
  ([^Channel ch callback e]
   (if callback
     ;; catch the case where the callback itself throws,
     ;; and notify the channel callback instead of letting it
     ;; bubble up, since that may trigger the same callback
     ;; being called again
     (try
       (if e
         (callback e)
         (callback))
       (catch Throwable e'
         (.notifyError ch e')))
     (when e (.notifyError ch e)))
   ::notified))

(defmacro ^:private catch-and-notify [ch on-error & body]
  `(try
     ~@body
     (catch Throwable e#
       (notify ~ch ~on-error e#))))

(def ^:dynamic ^:private *dispatched?* nil)

(defmacro ^:private maybe-dispatch [& body]
  `(if *dispatched?*
     (do ~@body)
     (binding [*dispatched?* true]
       (future ~@body))))

(defn ^:private finalize-channel-response
  [^Channel ch status headers]
  (when (and (instance? HttpChannel ch)
          (not (.sendStarted ^HttpChannel ch)))
    (let [orig-response (.get ch :response-map)]
      ((.get ch :set-status-fn) (or status (:status orig-response)))
      ((.get ch :set-headers-fn) (or headers (:headers orig-response))))))

(defn ^:private wboss-send [^Channel ch message options]
  (let [{:keys [close? on-success on-error status headers]} options]
    (finalize-channel-response ch status headers)
    (.send ch message
      (boolean close?)
      (when (or on-success on-error)
        (reify Channel$OnComplete
          (handle [_ error]
            (if (and error on-error)
              (on-error error)
              (when on-success (on-success)))))))))

(defn originating-request
  "Returns the request map for the request that initiated the channel."
  [^Channel ch]
  (.get ch :originating-request))

(defn open?
  "Is the channel open?"
  [^Channel ch]
  (.isOpen ch))

(defn close
  "Gracefully close the channel.

   This will trigger the :on-close callback if one is registered. with
   [[as-channel]]."
  [^Channel ch]
  (finalize-channel-response ch nil nil)
  (.close ch))

(extend-protocol MessageDispatch
  Object
  (dispatch-message [message _ _]
    (throw (IllegalStateException. (str "Can't send message of type " (class message)))))

  nil
  (dispatch-message [_ ch options]
    (wboss-send ch nil options))

  Map
  (dispatch-message [message ch options]
    (when (not (instance? HttpChannel ch))
      (throw (IllegalArgumentException. "Can't send map: channel is not an HTTP stream channel")))
    (when (.sendStarted ^HttpChannel ch)
      (throw (IllegalArgumentException. "Can't send map: this is not the first send to the channel")))
    (dispatch-message (:body message) ch
      (merge options (select-keys message [:status :headers]))))

  String
  (dispatch-message [message ch options]
    (wboss-send ch message options))

  ISeq
  (dispatch-message [message ch {:keys [on-success on-error close?] :as options}]
    (maybe-dispatch
      (let [result (catch-and-notify ch on-error
                     (loop [item (first message)
                            items (rest message)]
                       (let [latch (promise)]
                         (dispatch-message item ch
                           (assoc options
                             :on-success #(deliver latch nil)
                             :on-error   (partial deliver latch)
                             :close?     false))
                         (if-let [err @latch]
                           (notify ch on-error err)
                           (when (seq items)
                             (recur (first items) (rest items)))))))]
        (when-not (= ::notified result)
          (notify ch on-success)))
      (when close?
        (close ch))))

  File
  (dispatch-message [message ch options]
    (dispatch-message (FileInputStream. message) ch options))

  InputStream
  (dispatch-message [message ch {:keys [on-success on-error close?] :as options}]
    (maybe-dispatch
      (let [buf-size (* 1024 16) ;; 16k is the undertow default if > 128M RAM is available
            buffer (byte-array buf-size)
            result (catch-and-notify ch on-error
                     (with-open [message message]
                       (loop []
                         (let [read-bytes (.read message buffer)]
                           (if (pos? read-bytes)
                             (let [latch (promise)]
                               (dispatch-message
                                 (if (< read-bytes buf-size)
                                   (Arrays/copyOfRange buffer 0 read-bytes)
                                   buffer)
                                 ch
                                 (assoc options
                                   :on-success #(deliver latch nil)
                                   :on-error   (partial deliver latch)
                                   :close?     false))
                               (if-let [err @latch]
                                 (notify ch on-error err)
                                 (recur))))))))]
        (when-not (= ::notified result)
          (notify ch on-success)))
      (when close?
        (close ch)))))

;; this has to be in a separate extend-protocol because we need to
;; extend Object first, and type looked up via Class/forName has to be
;; first in extend-protocol (see CLJ-1381)
(extend-protocol MessageDispatch
  (Class/forName "[B")
  (dispatch-message [message ch options]
    (wboss-send ch message options)))

(defn send!
  "Send a message to the channel, asynchronously.

  `message` can either be a `String`, `File`, `InputStream`, `ISeq`,
  `byte[]`, or map. If it is a `String`, it will be encoded to the
  character set of the response for HTTP streams, and as UTF-8 for
  WebSockets. `File`s and `InputStream`s will be sent as up to 16k
  chunks (each chunk being a `byte[]` message for WebSockets). Each
  item in an `ISeq` will pass through `send!`, and can be any of the
  valid message types.

  If `message` is a map, its :body entry must be one of the other
  valid message types, and its :status and :headers entries will be
  used to override the status or headers returned from the handler
  that called `as-channel` for HTTP streams. A map is *only* a valid
  message on the first send to an HTTP stream channel - an exception
  is thrown if it is passed on a subsequent send or passed to a
  WebSocket channel.

  The following options are supported [default]:

   * :close? - if `true`, the channel will be closed when the send completes.
     Setting this to `true` on the first send to an HTTP stream channel
     will cause it to behave like a standard HTTP response, and *not* chunk
     the response. [false]
   * :on-success - `(fn [] ...)` - called when the send attempt has completed
     successfully. If this callback throws an exception, it will be
     reported to the [[as-channel]] :on-error callback [nil]
   * :on-error - `(fn [throwable] ...)` - Called when an error occurs on the send.
     If the error requires the channel to be closed, the [[as-channel]] :on-close
     callback will also be invoked. If this callback throws an exception, it will be
     reported to the [[as-channel]] :on-error callback [`#(when % (throw %))`]

   Returns nil if the channel is closed when the send is initiated, true
   otherwise. If the channel is already closed, :on-success won't be
   invoked."
  [^Channel ch message & options]
  (dispatch-message message ch
    (-> options
      u/kwargs-or-map->raw-map
      (o/validate-options send!))))

(o/set-valid-options! send! #{:close? :on-success :on-error})

(defn as-channel
  "Converts the current ring `request` in to an asynchronous channel.

  The type of channel created depends on the request - if the request
  is a Websocket upgrade request, a Websocket channel will be created.
  Otherwise, an HTTP stream channel is created. You interact with both
  channel types using the other functions in this namespace, and
  through the given `callbacks`.

  The callbacks common to both channel types are:

  * :on-open - `(fn [ch] ...)` - called when the channel is
    available for sending. Will only be invoked once.
  * :on-error - `(fn [ch throwable] ...)` - Called for any error
    that occurs in relation to the channel. If the error
    requires the channel to be closed, :on-close will also be invoked.
    To handle [[send!]] errors separately, provide it a completion
    callback.
  * :on-close - `(fn [ch {:keys [code reason]}] ...)` -
    called for *any* close, including a call to [[close]], but will
    only be invoked once. `ch` will already be closed by the time
    this is invoked.

  `code` and `reason` will be the numeric closure code and text reason,
  respectively, if the channel is a WebSocket
  (see <http://tools.ietf.org/html/rfc6455#section-7.4>). Both will be nil
  for HTTP streams.

  If the channel is a Websocket, the following callback is also used:

  * :on-message - `(fn [ch message] ...)` - Called for each message
    from the client. `message` will be a `String` or `byte[]`

  When the ring handler is called during a WebSocket upgrade request,
  any headers returned in the response map are ignored, but any changes to
  the session are applied.

  Returns a ring response map, at least the :body of which *must* be
  returned in the response map from the calling ring handler."
  [request & callbacks]
  (let [callbacks (-> callbacks
                    u/kwargs-or-map->map
                    (o/validate-options as-channel))
        ch (if (:websocket? request)
             (initialize-websocket request callbacks)
             (initialize-stream request callbacks))]
    {:status 200
     :body ch}))

(o/set-valid-options! as-channel
  #{:on-open :on-close :on-message :on-error})

;; Copyright 2014-2015 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns immutant.web.async
  "Provides a common interface for WebSockets and HTTP streaming."
  (:require [immutant.internal.options :as o]
            [immutant.internal.util    :as u])
  (:import [org.projectodd.wunderboss.web.async Channel Channel$OnComplete HttpChannel]
           [org.projectodd.wunderboss.web.async.websocket WebsocketChannel]
           [java.io File FileInputStream InputStream]
           [java.util Arrays Map]
           clojure.lang.ISeq))

(defn ^:internal ^:no-doc streaming-body? [body]
  (instance? HttpChannel body))

(defn ^:internal ^:no-doc open-stream [^HttpChannel channel response-map
                                       set-status-fn set-headers-fn]
  (doto channel
    (.attach :response-map response-map)
    (.attach :set-status-fn set-status-fn)
    (.attach :set-headers-fn set-headers-fn)
    (.notifyOpen nil)))

(defmulti ^:internal ^:no-doc initialize-stream :handler-type)

(defmulti ^:internal ^:no-doc initialize-websocket :handler-type)

(defprotocol ^:private MessageDispatch
  (dispatch-message [from ch options-map]))

(defn ^:private notify
  ([ch callback]
   (notify ch callback nil))
  ([^Channel ch callback e]
   (if callback
     ;; catch the case where the callback itself throws,
     ;; and notify the channel callback instead of letting it
     ;; bubble up, since that may trigger the same callback
     ;; being called again
     (try
       (if e
         (callback e)
         (callback))
       (catch Throwable e'
         (.notifyError ch e')))
     (when e (.notifyError ch e)))
   ::notified))

(defmacro ^:private catch-and-notify [ch on-error & body]
  `(try
     ~@body
     (catch Throwable e#
       (notify ~ch ~on-error e#))))

(def ^:dynamic ^:private *dispatched?* nil)

(defmacro ^:private maybe-dispatch [& body]
  `(if *dispatched?*
     (do ~@body)
     (binding [*dispatched?* true]
       (future ~@body))))

(defn ^:private finalize-channel-response
  [^Channel ch status headers]
  (when (and (instance? HttpChannel ch)
          (not (.sendStarted ^HttpChannel ch)))
    (let [orig-response (.get ch :response-map)]
      ((.get ch :set-status-fn) (or status (:status orig-response)))
      ((.get ch :set-headers-fn) (or headers (:headers orig-response))))))

(defn ^:private wboss-send [^Channel ch message options]
  (let [{:keys [close? on-success on-error status headers]} options]
    (finalize-channel-response ch status headers)
    (.send ch message
      (boolean close?)
      (when (or on-success on-error)
        (reify Channel$OnComplete
          (handle [_ error]
            (if (and error on-error)
              (on-error error)
              (when on-success (on-success)))))))))

(defn originating-request
  "Returns the request map for the request that initiated the channel."
  [^Channel ch]
  (.get ch :originating-request))

(defn open?
  "Is the channel open?"
  [^Channel ch]
  (.isOpen ch))

(defn close
  "Gracefully close the channel.

   This will trigger the :on-close callback if one is registered. with
   [[as-channel]]."
  [^Channel ch]
  (finalize-channel-response ch nil nil)
  (.close ch))

(extend-protocol MessageDispatch
  Object
  (dispatch-message [message _ _]
    (throw (IllegalStateException. (str "Can't send message of type " (class message)))))

  nil
  (dispatch-message [_ ch options]
    (wboss-send ch nil options))

  Map
  (dispatch-message [message ch options]
    (when (not (instance? HttpChannel ch))
      (throw (IllegalArgumentException. "Can't send map: channel is not an HTTP stream channel")))
    (when (.sendStarted ^HttpChannel ch)
      (throw (IllegalArgumentException. "Can't send map: this is not the first send to the channel")))
    (dispatch-message (:body message) ch
      (merge options (select-keys message [:status :headers]))))

  String
  (dispatch-message [message ch options]
    (wboss-send ch message options))

  ISeq
  (dispatch-message [message ch {:keys [on-success on-error close?] :as options}]
    (maybe-dispatch
      (let [result (catch-and-notify ch on-error
                     (loop [item (first message)
                            items (rest message)]
                       (let [latch (promise)]
                         (dispatch-message item ch
                           (assoc options
                             :on-success #(deliver latch nil)
                             :on-error   (partial deliver latch)
                             :close?     false))
                         (if-let [err @latch]
                           (notify ch on-error err)
                           (when (seq items)
                             (recur (first items) (rest items)))))))]
        (when-not (= ::notified result)
          (notify ch on-success)))
      (when close?
        (close ch))))

  File
  (dispatch-message [message ch options]
    (dispatch-message (FileInputStream. message) ch options))

  InputStream
  (dispatch-message [message ch {:keys [on-success on-error close?] :as options}]
    (maybe-dispatch
      (let [buf-size (* 1024 16) ;; 16k is the undertow default if > 128M RAM is available
            buffer (byte-array buf-size)
            result (catch-and-notify ch on-error
                     (with-open [message message]
                       (loop []
                         (let [read-bytes (.read message buffer)]
                           (if (pos? read-bytes)
                             (let [latch (promise)]
                               (dispatch-message
                                 (if (< read-bytes buf-size)
                                   (Arrays/copyOfRange buffer 0 read-bytes)
                                   buffer)
                                 ch
                                 (assoc options
                                   :on-success #(deliver latch nil)
                                   :on-error   (partial deliver latch)
                                   :close?     false))
                               (if-let [err @latch]
                                 (notify ch on-error err)
                                 (recur))))))))]
        (when-not (= ::notified result)
          (notify ch on-success)))
      (when close?
        (close ch)))))

;; this has to be in a separate extend-protocol because we need to
;; extend Object first, and type looked up via Class/forName has to be
;; first in extend-protocol (see CLJ-1381)
(extend-protocol MessageDispatch
  (Class/forName "[B")
  (dispatch-message [message ch options]
    (wboss-send ch message options)))

(defn send!
  "Send a message to the channel, asynchronously.

  `message` can either be a `String`, `File`, `InputStream`, `ISeq`,
  `byte[]`, or map. If it is a `String`, it will be encoded to the
  character set of the response for HTTP streams, and as UTF-8 for
  WebSockets. `File`s and `InputStream`s will be sent as up to 16k
  chunks (each chunk being a `byte[]` message for WebSockets). Each
  item in an `ISeq` will pass through `send!`, and can be any of the
  valid message types.

  If `message` is a map, its :body entry must be one of the other
  valid message types, and its :status and :headers entries will be
  used to override the status or headers returned from the handler
  that called `as-channel` for HTTP streams. A map is *only* a valid
  message on the first send to an HTTP stream channel - an exception
  is thrown if it is passed on a subsequent send or passed to a
  WebSocket channel.

  The following options are supported [default]:

   * :close? - if `true`, the channel will be closed when the send completes.
     Setting this to `true` on the first send to an HTTP stream channel
     will cause it to behave like a standard HTTP response, and *not* chunk
     the response. [false]
   * :on-success - `(fn [] ...)` - called when the send attempt has completed
     successfully. If this callback throws an exception, it will be
     reported to the [[as-channel]] :on-error callback [nil]
   * :on-error - `(fn [throwable] ...)` - Called when an error occurs on the send.
     If the error requires the channel to be closed, the [[as-channel]] :on-close
     callback will also be invoked. If this callback throws an exception, it will be
     reported to the [[as-channel]] :on-error callback [`#(throw %)`]

   Returns nil if the channel is closed when the send is initiated, true
   otherwise. If the channel is already closed, :on-success won't be
   invoked."
  [^Channel ch message & options]
  (dispatch-message message ch
    (-> options
      u/kwargs-or-map->raw-map
      (o/validate-options send!))))

(o/set-valid-options! send! #{:close? :on-success :on-error})

(defn as-channel
  "Converts the current ring `request` in to an asynchronous channel.

  The type of channel created depends on the request - if the request
  is a Websocket upgrade request, a Websocket channel will be created.
  Otherwise, an HTTP stream channel is created. You interact with both
  channel types using the other functions in this namespace, and
  through the given `callbacks`.

  The callbacks common to both channel types are:

  * :on-open - `(fn [ch] ...)` - called when the channel is
    available for sending. Will only be invoked once.
  * :on-error - `(fn [ch throwable] ...)` - Called for any error
    that occurs in relation to the channel. If the error
    requires the channel to be closed, :on-close will also be invoked.
    To handle [[send!]] errors separately, provide it a completion
    callback.
  * :on-close - `(fn [ch {:keys [code reason]}] ...)` -
    called for *any* close, including a call to [[close]], but will
    only be invoked once. `ch` will already be closed by the time
    this is invoked.

  `code` and `reason` will be the numeric closure code and text reason,
  respectively, if the channel is a WebSocket
  (see <http://tools.ietf.org/html/rfc6455#section-7.4>). Both will be nil
  for HTTP streams.

  If the channel is a Websocket, the following callback is also used:

  * :on-message - `(fn [ch message] ...)` - Called for each message
    from the client. `message` will be a `String` or `byte[]`

  When the ring handler is called during a WebSocket upgrade request,
  any headers returned in the response map are ignored, but any changes to
  the session are applied.

  Returns a ring response map, at least the :body of which *must* be
  returned in the response map from the calling ring handler."
  [request & callbacks]
  (let [callbacks (-> callbacks
                    u/kwargs-or-map->map
                    (o/validate-options as-channel))
        ch (if (:websocket? request)
             (initialize-websocket request callbacks)
             (initialize-stream request callbacks))]
    {:status 200
     :body ch}))

(o/set-valid-options! as-channel
  #{:on-open :on-close :on-message :on-error})

Simplify default :on-error.

Simplify default :on-error.


;; Copyright 2008-2014 Red Hat, Inc, and individual contributors.
;;
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 2.1 of
;; the License, or (at your option) any later version.
;;
;; This software 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

(ns immutant.web.javax
  (:require [ring.util.servlet :as ring])
  (:import [javax.servlet.http HttpServlet HttpServletRequest]
           [javax.websocket Endpoint MessageHandler$Whole]
           [javax.websocket.server ServerEndpointConfig$Builder]))

(defn create-servlet
  "Encapsulate a ring handler within a servlet's service method"
  [handler]
  (ring/servlet handler))

(defn create-endpoint
  "Create a JSR-356 endpoint from a few functions"
  [{:keys [on-message on-open on-close on-error]}]
  (proxy [Endpoint] []
    (onOpen [session config]
      (when on-open (on-open session))
      (when on-message
        (.addMessageHandler session
          (reify MessageHandler$Whole
            (onMessage [_ message] (on-message session message))))))
    (onClose [session reason]
      (when on-close (on-close session
                       {:code (.. reason getReasonCode getCode)
                        :reason (.getReasonPhrase reason)})))
    (onError [session error]
      (when on-error (on-error session error)))))

(defn create-endpoint-servlet
  "Create a servlet for a JSR-356 endpoint"
  [{:keys [fallback] :as callbacks}]
  (proxy [HttpServlet] []
    (init [servlet-config]
      (proxy-super init servlet-config)
      (let [context (.getServletContext servlet-config)
            path (.getContextPath context)
            endpoint (create-endpoint callbacks)
            config (.build (ServerEndpointConfig$Builder/create (class endpoint) path))
            container (.getAttribute context "javax.websocket.server.ServerContainer")]
        (.addEndpoint container config)))
    (service [request response]
      (if-let [fallback (and fallback (ring/make-service-method fallback))]
        (fallback this request response)
        (proxy-super service request response)))))

(defn session
  "Returns the servlet session from the ring request"
  [request]
  (if-let [^HttpServletRequest hsr (:servlet-request request)]
    (.getSession hsr)))

(defn context
  "Returns the servlet context path from the ring request"
  [request]
  (if-let [^HttpServletRequest hsr (:servlet-request request)]
    (str (.getContextPath hsr) (.getServletPath hsr))))

(defn path-info
  "Returns the servlet path info from the ring request"
  [request]
  (if-let [^HttpServletRequest hsr (:servlet-request request)]
    (let [result (.substring (.getRequestURI hsr) (.length (context hsr)))]
      (if (.isEmpty result)
        "/"
        result))))

;; Copyright 2008-2014 Red Hat, Inc, and individual contributors.
;;
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 2.1 of
;; the License, or (at your option) any later version.
;;
;; This software 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

(ns immutant.web.javax
  (:require [ring.util.servlet :as ring])
  (:import [javax.servlet.http HttpServlet HttpServletRequest]
           [javax.websocket Endpoint MessageHandler$Whole]
           [javax.websocket.server ServerEndpointConfig$Builder ServerEndpointConfig$Configurator]))

(defn create-servlet
  "Encapsulate a ring handler within a servlet's service method"
  [handler]
  (ring/servlet handler))

(defn create-endpoint
  "Create a JSR-356 endpoint from a few functions"
  [{:keys [on-message on-open on-close on-error]}]
  (proxy [Endpoint] []
    (onOpen [session config]
      (when on-open (on-open session))
      (when on-message
        (.addMessageHandler session
          (reify MessageHandler$Whole
            (onMessage [_ message] (on-message session message))))))
    (onClose [session reason]
      (when on-close (on-close session
                       {:code (.. reason getReasonCode getCode)
                        :reason (.getReasonPhrase reason)})))
    (onError [session error]
      (when on-error (on-error session error)))))

(defn create-endpoint-servlet
  "Create a servlet for a JSR-356 endpoint"
  [{:keys [fallback] :as callbacks}]
  (proxy [HttpServlet] []
    (init [servlet-config]
      (proxy-super init servlet-config)
      (let [context (.getServletContext servlet-config)
            path (.getContextPath context)
            container (.getAttribute context "javax.websocket.server.ServerContainer")
            endpoint (create-endpoint callbacks)
            config (.. ServerEndpointConfig$Builder
                     (create (class endpoint) path)
                     (configurator (proxy [ServerEndpointConfig$Configurator] []
                                     (getEndpointInstance [c] endpoint)))
                     build)]
        (.addEndpoint container config)))
    (service [request response]
      (if-let [fallback (and fallback (ring/make-service-method fallback))]
        (fallback this request response)
        (proxy-super service request response)))))

(defn session
  "Returns the servlet session from the ring request"
  [request]
  (if-let [^HttpServletRequest hsr (:servlet-request request)]
    (.getSession hsr)))

(defn context
  "Returns the servlet context path from the ring request"
  [request]
  (if-let [^HttpServletRequest hsr (:servlet-request request)]
    (str (.getContextPath hsr) (.getServletPath hsr))))

(defn path-info
  "Returns the servlet path info from the ring request"
  [request]
  (if-let [^HttpServletRequest hsr (:servlet-request request)]
    (let [result (.substring (.getRequestURI hsr) (.length (context hsr)))]
      (if (.isEmpty result)
        "/"
        result))))

Use configurator to avoid AbstractMethodError, thx Ben/Toby


;;
;;       Copyright (c) 2017 Two Sigma Investments, LP.
;;       All Rights Reserved
;;
;;       THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF
;;       Two Sigma Investments, LP.
;;
;;       The copyright notice above does not evidence any
;;       actual or intended publication of such source code.
;;
(ns waiter.security
  (:require [clj-time.core :as t]
            [clojure.core.cache :as cache]
            [waiter.utils :as utils]))

(defprotocol EntitlementManager
  "Security related methods"
  (authorized? [this subject action resource]
               "Determines if a given subject can perform action on a given resource."))

(defrecord SimpleEntitlementManager [_]
  EntitlementManager
  (authorized? [_ subject _ resource]
    (= subject (:user resource))))

(defn make-service-resource
  "Creates a resource from a service description for use with an entitlement manager"
  [service-id {:strs [run-as-user]}]
  {:resource-type :service
   :user run-as-user
   :service-id service-id})

;;
;;       Copyright (c) 2017 Two Sigma Investments, LP.
;;       All Rights Reserved
;;
;;       THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF
;;       Two Sigma Investments, LP.
;;
;;       The copyright notice above does not evidence any
;;       actual or intended publication of such source code.
;;
(ns waiter.security)

(defprotocol EntitlementManager
  "Security related methods"
  (authorized? [this subject action resource]
               "Determines if a given subject can perform action on a given resource."))

(defrecord SimpleEntitlementManager [_]
  EntitlementManager
  (authorized? [_ subject _ resource]
    (= subject (:user resource))))

(defn make-service-resource
  "Creates a resource from a service description for use with an entitlement manager"
  [service-id {:strs [run-as-user]}]
  {:resource-type :service
   :user run-as-user
   :service-id service-id})

remove unused imports (#69)

remove unused imports (#69)


(set-env!
 :dependencies '[;; Boot deps
                 [adzerk/boot-cljs            "1.7.228-1" :scope "test"]
                 [pandeiro/boot-http          "0.7.2"     :scope "test"]
                 [adzerk/boot-reload          "0.4.4"     :scope "test"]
                 [degree9/boot-semver         "1.2.4"     :scope "test"]

                 ;; Repl
                 [adzerk/boot-cljs-repl       "0.3.0"  :scope "test"]
                 [com.cemerick/piggieback     "0.2.1"  :scope "test"]
                 [weasel                      "0.7.0"  :scope "test"]
                 [org.clojure/tools.nrepl     "0.2.12" :scope "test"]

                 ;; Tests
                 [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]

                 ;; App deps
                 [org.clojure/clojure         "1.7.0"]
                 [org.clojure/clojurescript   "1.7.228"]
                 [org.clojure/core.async      "0.2.374"]
                 [reagent                     "0.5.1"]
                 [re-frame                    "0.5.0"]
                 [replumb/replumb             "0.2.2-SNAPSHOT"]
                 [cljsjs/highlight            "8.4-0"]
                 [re-console                  "0.1.0"]
                 [re-com                      "0.7.0-alpha2"]
                 [cljs-ajax                   "0.5.1"]
                 [hickory                     "0.5.4"]
                 [cljsjs/showdown             "0.4.0-1"]
                 [org.clojure/tools.reader    "1.0.0-alpha3"]
                 [cljsjs/enquire              "2.1.2-0"]
                 [com.cemerick/piggieback     "0.2.1"]
                 [org.clojars.stumitchell/clairvoyant "0.2.0"]
                 [binaryage/devtools          "0.5.2"]
                 [day8/re-frame-tracer        "0.1.0-SNAPSHOT"]
                 [cljsjs/codemirror           "5.10.0-0"]
                 [adzerk/cljs-console "0.1.1"]])

(def generator-deps '[[org.clojure/clojure         "1.7.0"]
                      [org.clojure/tools.reader    "1.0.0-alpha3"]
                      [endophile                   "0.1.2"]
                      [markdown-clj                "0.9.78"]])

(require '[adzerk.boot-cljs            :refer [cljs]]
         '[adzerk.boot-reload          :refer [reload]]
         '[pandeiro.boot-http          :refer [serve]]
         '[crisptrutski.boot-cljs-test :refer [test-cljs exit!]]
         '[adzerk.boot-cljs-repl       :refer [cljs-repl start-repl]]
         '[boot-semver.core            :refer :all]
         '[boot.pod                    :as pod]
         '[clojure.pprint              :refer [pprint]])

(def +version+ (get-version))

(task-options! pom {:project "cljs-repl-web"
                    :version +version+}
               test-cljs {:js-env :phantom
                          :out-file "phantom-tests.js"})

;;;;;;;;;;;;;;;;;;;;;;
;;;    Options     ;;;
;;;;;;;;;;;;;;;;;;;;;;

(def dev-compiler-options
  {:source-map-timestamp true})

(def prod-compiler-options
  {:closure-defines {"goog.DEBUG" false}
   :optimize-constants true
   :static-fns true
   :elide-asserts true
   :pretty-print false
   :source-map-timestamp true})

(defmulti options
  "Return the correct option map for the build, dispatching on identity"
  identity)

(defmethod options :generator
  [selection]
  {:type :generator
   :env {:source-paths #{"src/clj"}
         :dependencies generator-deps
         :resource-paths #{"dev-resources"}}})

(defmethod options :dev
  [selection]
  {:type :dev
   :props {"CLJS_LOG_LEVEL" "DEBUG"}
   :env {:source-paths #{"src/clj" "src/cljs" "env/dev/cljs"}
         :resource-paths #{"resources/public/"}}
   :cljs {:source-map true
          :optimizations :none
          :compiler-options dev-compiler-options}
   :test-cljs {:optimizations :none
               :cljs-opts dev-compiler-options
               :suite-ns 'cljs-repl-web.suite}})

(defmethod options :prod
  [selection]
  {:type :prod
   :props {"CLJS_LOG_LEVEL" "WARN"}
   :env {:source-paths #{"src/clj" "src/cljs" "env/prod/cljs"}
         :resource-paths #{"resources/public/"}}
   :cljs {:source-map true
          :optimizations :simple
          :compiler-options prod-compiler-options}
   :test-cljs {:optimizations :simple
               :cljs-opts prod-compiler-options
               :suite-ns 'cljs-repl-web.suite}})

(defn set-system-properties!
  "Set a system property for each entry in the map m."
  [m]
  (doseq [kv m]
    (System/setProperty (key kv) (val kv))))

(deftask version-file
  "A task that includes the version.properties file in the fileset."
  []
  (with-pre-wrap [fileset]
    (boot.util/info "Add version.properties...\n")
    (-> fileset
        (add-resource (java.io.File. ".") :include #{#"^version\.properties$"})
        commit!)))

(deftask build
  "Build the final artifact, if no type is passed in, it builds production."
  [t type VAL kw "The build type, either prod or dev"]
  (let [options (options (or type :prod))]
    (boot.util/info "Building %s profile...\n" (:type options))
    (apply set-env! (reduce #(into %2 %1) [] (:env options)))
    (set-system-properties! (:props options))
    (comp (version-file)
          (apply cljs (reduce #(into %2 %1) [] (:cljs options)))
          (target))))

(deftask dev
  "Start the dev interactive environment."
  []
  (boot.util/info "Starting interactive dev...\n")
  (let [options (options :dev)]
    (apply set-env! (reduce #(into %2 %1) [] (:env options)))
    (set-system-properties! (:props options))
    (comp (version-file)
          (serve)
          (watch)
          (cljs-repl)
          (reload :on-jsload 'cljs-repl-web.core/main)
          (apply cljs (reduce #(into %2 %1) [] (:cljs options))))))

;; This prevents a name collision WARNING between the test task and
;; clojure.core/test, a function that nobody really uses or cares
;; about.
(ns-unmap 'boot.user 'test)

(defn test-cljs-opts
  [options namespaces exit?]
  (cond-> options
    namespaces (-> (update-in [:test-cljs :suite-ns] (fn [_] nil))
                   (assoc-in [:test-cljs :namespaces] namespaces))
    exit? (assoc-in [:test-cljs :exit?] exit?)))

(defn set-test-env!
  [options]
  (apply set-env! (reduce #(into %2 %1) [] (update-in (:env options) [:source-paths] conj "test/cljs"))))

(deftask test
  "Run tests once.

   If no type is passed in, it tests against the production build. It
   optionally accepts (a set of) regular expressions that are used for testing
   only some namespaces."
  [t type       VAL        kw       "The build type, either prod or dev"
   n namespace  NAMESPACE  #{regex} "Namespace regex to test against"]
  (let [options (-> (options (or type :prod))
                    (test-cljs-opts namespace true))]
    (boot.util/info "Testing options %s\n" (with-out-str (pprint options)))
    (set-test-env! options)
    (apply test-cljs (reduce #(into %2 %1) [] (:test-cljs options)))))

(deftask auto-test
  "Run tests watching for file changes.

  If no type is passed in, it tests against the production build. It optionally
  accepts (a set of) regular expressions that are used for testing only some
  namespaces."
  [t type      VAL       kw       "The build type, either prod or dev"
   n namespace NAMESPACE #{regex} "Namespace regex to test against"]
  (let [options (-> (options (or type :prod))
                    (test-cljs-opts namespace false))]
    (set-test-env! options)
    (comp (watch)
          (apply test-cljs (reduce #(into %2 %1) [] (:test-cljs options))))))

(deftask cljs-api
  "The task generates the Clojurescript API and the cljs-repl-web.cljs-api
  namespace. It does NOT add it to the fileset, but calls
  cljs-api.generator/-main and dump in src/cljs."
  []
  (with-pass-thru fs
    (boot.util/info "Generating...\n")
    (let [custom-env (:env (options :generator))
          source-paths (:source-paths custom-env)
          resource-paths (:resource-paths custom-env)
          pod-env (assoc-in (get-env) [:dependencies] (:dependencies custom-env))]
      (let [pod (future (pod/make-pod pod-env))]
        (pod/with-eval-in @pod
          (boot.util/dbug "Directories %s\n" (with-out-str (clojure.pprint/pprint boot.pod/env)))
          (doseq [src ~source-paths]
            (boot.pod/add-classpath src))
          (doseq [resource ~resource-paths]
            (boot.pod/add-classpath resource))
          (require 'cljs-api.generator)
          (cljs-api.generator/-main))
        (pod/destroy-pod @pod)))))

(set-env!
 :dependencies '[;; Boot deps
                 [adzerk/boot-cljs            "1.7.228-1" :scope "test"]
                 [pandeiro/boot-http          "0.7.2"     :scope "test"]
                 [adzerk/boot-reload          "0.4.4"     :scope "test"]
                 [degree9/boot-semver         "1.2.4"     :scope "test"]

                 ;; Repl
                 [adzerk/boot-cljs-repl       "0.3.0"  :scope "test"]
                 [com.cemerick/piggieback     "0.2.1"  :scope "test"]
                 [weasel                      "0.7.0"  :scope "test"]
                 [org.clojure/tools.nrepl     "0.2.12" :scope "test"]

                 ;; Tests
                 [crisptrutski/boot-cljs-test "0.2.2-SNAPSHOT" :scope "test"]

                 ;; App deps
                 [org.clojure/clojure         "1.7.0"]
                 [org.clojure/clojurescript   "1.7.228"]
                 [org.clojure/core.async      "0.2.374"]
                 [reagent                     "0.5.1"]
                 [re-frame                    "0.5.0"]
                 [replumb/replumb             "0.2.2-SNAPSHOT"]
                 [cljsjs/highlight            "8.4-0"]
                 [re-console                  "0.1.0-2"]
                 [re-com                      "0.7.0-alpha2"]
                 [cljs-ajax                   "0.5.1"]
                 [hickory                     "0.5.4"]
                 [cljsjs/showdown             "0.4.0-1"]
                 [org.clojure/tools.reader    "1.0.0-alpha3"]
                 [cljsjs/enquire              "2.1.2-0"]
                 [com.cemerick/piggieback     "0.2.1"]
                 [org.clojars.stumitchell/clairvoyant "0.2.0"]
                 [binaryage/devtools          "0.5.2"]
                 [day8/re-frame-tracer        "0.1.0-SNAPSHOT"]
                 [cljsjs/codemirror           "5.10.0-0"]
                 [adzerk/cljs-console "0.1.1"]])

(def generator-deps '[[org.clojure/clojure         "1.7.0"]
                      [org.clojure/tools.reader    "1.0.0-alpha3"]
                      [endophile                   "0.1.2"]
                      [markdown-clj                "0.9.78"]])

(require '[adzerk.boot-cljs            :refer [cljs]]
         '[adzerk.boot-reload          :refer [reload]]
         '[pandeiro.boot-http          :refer [serve]]
         '[crisptrutski.boot-cljs-test :refer [test-cljs exit!]]
         '[adzerk.boot-cljs-repl       :refer [cljs-repl start-repl]]
         '[boot-semver.core            :refer :all]
         '[boot.pod                    :as pod]
         '[clojure.pprint              :refer [pprint]])

(def +version+ (get-version))

(task-options! pom {:project "cljs-repl-web"
                    :version +version+}
               test-cljs {:js-env :phantom
                          :out-file "phantom-tests.js"})

;;;;;;;;;;;;;;;;;;;;;;
;;;    Options     ;;;
;;;;;;;;;;;;;;;;;;;;;;

(def dev-compiler-options
  {:source-map-timestamp true})

(def prod-compiler-options
  {:closure-defines {"goog.DEBUG" false}
   :optimize-constants true
   :static-fns true
   :elide-asserts true
   :pretty-print false
   :source-map-timestamp true})

(defmulti options
  "Return the correct option map for the build, dispatching on identity"
  identity)

(defmethod options :generator
  [selection]
  {:type :generator
   :env {:source-paths #{"src/clj"}
         :dependencies generator-deps
         :resource-paths #{"dev-resources"}}})

(defmethod options :dev
  [selection]
  {:type :dev
   :props {"CLJS_LOG_LEVEL" "DEBUG"}
   :env {:source-paths #{"src/clj" "src/cljs" "env/dev/cljs"}
         :resource-paths #{"resources/public/"}}
   :cljs {:source-map true
          :optimizations :none
          :compiler-options dev-compiler-options}
   :test-cljs {:optimizations :none
               :cljs-opts dev-compiler-options
               :suite-ns 'cljs-repl-web.suite}})

(defmethod options :prod
  [selection]
  {:type :prod
   :props {"CLJS_LOG_LEVEL" "WARN"}
   :env {:source-paths #{"src/clj" "src/cljs" "env/prod/cljs"}
         :resource-paths #{"resources/public/"}}
   :cljs {:source-map true
          :optimizations :simple
          :compiler-options prod-compiler-options}
   :test-cljs {:optimizations :simple
               :cljs-opts prod-compiler-options
               :suite-ns 'cljs-repl-web.suite}})

(defn set-system-properties!
  "Set a system property for each entry in the map m."
  [m]
  (doseq [kv m]
    (System/setProperty (key kv) (val kv))))

(deftask version-file
  "A task that includes the version.properties file in the fileset."
  []
  (with-pre-wrap [fileset]
    (boot.util/info "Add version.properties...\n")
    (-> fileset
        (add-resource (java.io.File. ".") :include #{#"^version\.properties$"})
        commit!)))

(deftask build
  "Build the final artifact, if no type is passed in, it builds production."
  [t type VAL kw "The build type, either prod or dev"]
  (let [options (options (or type :prod))]
    (boot.util/info "Building %s profile...\n" (:type options))
    (apply set-env! (reduce #(into %2 %1) [] (:env options)))
    (set-system-properties! (:props options))
    (comp (version-file)
          (apply cljs (reduce #(into %2 %1) [] (:cljs options)))
          (target))))

(deftask dev
  "Start the dev interactive environment."
  []
  (boot.util/info "Starting interactive dev...\n")
  (let [options (options :dev)]
    (apply set-env! (reduce #(into %2 %1) [] (:env options)))
    (set-system-properties! (:props options))
    (comp (version-file)
          (serve)
          (watch)
          (cljs-repl)
          (reload :on-jsload 'cljs-repl-web.core/main)
          (apply cljs (reduce #(into %2 %1) [] (:cljs options))))))

;; This prevents a name collision WARNING between the test task and
;; clojure.core/test, a function that nobody really uses or cares
;; about.
(ns-unmap 'boot.user 'test)

(defn test-cljs-opts
  [options namespaces exit?]
  (cond-> options
    namespaces (-> (update-in [:test-cljs :suite-ns] (fn [_] nil))
                   (assoc-in [:test-cljs :namespaces] namespaces))
    exit? (assoc-in [:test-cljs :exit?] exit?)))

(defn set-test-env!
  [options]
  (apply set-env! (reduce #(into %2 %1) [] (update-in (:env options) [:source-paths] conj "test/cljs"))))

(deftask test
  "Run tests once.

   If no type is passed in, it tests against the production build. It
   optionally accepts (a set of) regular expressions that are used for testing
   only some namespaces."
  [t type       VAL        kw       "The build type, either prod or dev"
   n namespace  NAMESPACE  #{regex} "Namespace regex to test against"]
  (let [options (-> (options (or type :prod))
                    (test-cljs-opts namespace true))]
    (boot.util/info "Testing options %s\n" (with-out-str (pprint options)))
    (set-test-env! options)
    (apply test-cljs (reduce #(into %2 %1) [] (:test-cljs options)))))

(deftask auto-test
  "Run tests watching for file changes.

  If no type is passed in, it tests against the production build. It optionally
  accepts (a set of) regular expressions that are used for testing only some
  namespaces."
  [t type      VAL       kw       "The build type, either prod or dev"
   n namespace NAMESPACE #{regex} "Namespace regex to test against"]
  (let [options (-> (options (or type :prod))
                    (test-cljs-opts namespace false))]
    (set-test-env! options)
    (comp (watch)
          (apply test-cljs (reduce #(into %2 %1) [] (:test-cljs options))))))

(deftask cljs-api
  "The task generates the Clojurescript API and the cljs-repl-web.cljs-api
  namespace. It does NOT add it to the fileset, but calls
  cljs-api.generator/-main and dump in src/cljs."
  []
  (with-pass-thru fs
    (boot.util/info "Generating...\n")
    (let [custom-env (:env (options :generator))
          source-paths (:source-paths custom-env)
          resource-paths (:resource-paths custom-env)
          pod-env (assoc-in (get-env) [:dependencies] (:dependencies custom-env))]
      (let [pod (future (pod/make-pod pod-env))]
        (pod/with-eval-in @pod
          (boot.util/dbug "Directories %s\n" (with-out-str (clojure.pprint/pprint boot.pod/env)))
          (doseq [src ~source-paths]
            (boot.pod/add-classpath src))
          (doseq [resource ~resource-paths]
            (boot.pod/add-classpath resource))
          (require 'cljs-api.generator)
          (cljs-api.generator/-main))
        (pod/destroy-pod @pod)))))

Update re-console - nil fix

Update re-console - nil fix


(set-env!
 :source-paths
 #{"src/clj" "src/cljs"}

 :dependencies
 '[[org.clojure/clojurescript "0.0-3308"]
   [pandeiro/boot-http        "0.6.3-SNAPSHOT"]
   [kovasb/gamma              "0.0-135"]
   [kovasb/gamma-driver       "0.0-49"]
   [adzerk/boot-cljs          "0.0-3308-0"]
   [adzerk/boot-cljs-repl     "0.1.10-SNAPSHOT"]
   [adzerk/boot-reload        "0.3.1"]])

(require '[adzerk.boot-cljs      :refer :all]
         '[adzerk.boot-cljs-repl :refer :all]
         '[adzerk.boot-reload    :refer :all]
         '[pandeiro.boot-http    :refer :all])

(deftask start-dev
  "Start all the things!"
  []
  (comp (watch)
        (serve :dir ".")
        (reload)
        (cljs-repl)
        (cljs :compiler-options {:source-map    true
                                 :optimizations :none})))

(set-env!
 :source-paths
 #{"src/clj" "src/cljs"}

 :dependencies
 '[[org.clojure/clojurescript "1.7.48"]
   [pandeiro/boot-http        "0.6.3"]
   [kovasb/gamma              "0.0-135"]
   [kovasb/gamma-driver       "0.0-49"]
   [adzerk/boot-cljs          "1.7.48-SNAPSHOT"]
   [adzerk/boot-cljs-repl     "0.1.10-SNAPSHOT"]
   [adzerk/boot-reload        "0.3.1"]])

(require '[adzerk.boot-cljs      :refer :all]
         '[adzerk.boot-cljs-repl :refer :all]
         '[adzerk.boot-reload    :refer :all]
         '[pandeiro.boot-http    :refer :all])

(deftask start-dev
  "Start all the things!"
  []
  (comp (watch)
        (serve :dir ".")
        (reload)
        (cljs-repl)
        (cljs :compiler-options {:source-map    true
                                 :optimizations :none})))

bump dep versions

bump dep versions


(defn get-cleartext [prompt]
  (print prompt)
  (read-line))

(defn get-password [prompt]
  (print prompt)
  (apply str (.readPassword (System/console))))

(require '[clojure.string :as str])

(defn get-env-or-prompt [prefix prompt-fmt word get-fn]
  (let [env-name (str prefix word)]
    (or (System/getenv env-name)
        (get-fn (format prompt-fmt env-name (str/capitalize word))))))

(let [[username password] (mapv #(get-env-or-prompt "DATOMIC_"
                                                    "%s was not defined.\n%s"
                                                    %1 %2)
                                ["USERNAME"    "PASSWORD"]
                                [get-cleartext get-password])]

  (set-env! :source-paths #{"src/clj" "src/cljs"}
            :resource-paths #{"resources"}
            :dependencies '[[org.clojure/clojure "1.8.0"]

                            ;; Core app dependencies
                            [com.stuartsierra/component "0.3.2"]
                            [prismatic/schema "1.1.3"]
                            [environ "1.1.0"]
                            [org.clojure/tools.logging "0.3.1" :exclusions
                             [[org.slf4j/slf4j-log4j12 :extension "jar"]]]
                            [ch.qos.logback/logback-classic "1.1.11"]
                            [org.clojure/core.async "0.3.441"]

                            ;; Web server
                            [ring "1.5.1"]
                            [http-kit "2.2.0"]
                            [compojure "1.5.2"]
                            [fogus/ring-edn "0.3.0"]
                            [hiccup "1.0.5"]
                            [garden "1.3.2"]

                            ;; Data storage
                            [com.datomic/datomic-pro "0.9.5404"
                             :exclusions [org.clojure/clojure
                                          com.google.guava/guava
                                          org.apache.httpcomponents/httpclient
                                          org.slf4j/slf4j-nop]]
                            [io.rkn/conformity "0.4.0"]

                            ;; Comic scraping
                            [clj-http "2.3.0"]
                            [tempfile "0.2.0"]
                            [enlive "1.1.6"]

                            ;; Clojurescript frontend
                            [org.clojure/clojurescript "1.9.495"]
                            [re-frame "0.9.2" :exclusions
                             [[org.clojure/clojurescript
                               :extension "jar"]]]
                            [cljsjs/waypoints "4.0.0-0"]
                            [secretary "1.2.3"]
                            [cljs-ajax "0.5.8"]

                            ;; Dev Dependencies
                            [org.clojure/tools.namespace "0.3.0-alpha3" :scope "test"]
                            [radicalzephyr/clansi "1.2.0" :scope "test"]
                            [aysylu/loom "1.0.0" :scope "test"]

                            [ring/ring-mock "0.3.0" :scope "test"]
                            [figwheel-sidecar "0.5.9" :scope "test"]
                            [devcards "0.2.1-7" :scope "test"]
                            [com.cemerick/piggieback "0.2.1" :scope "test"]
                            [weasel "0.7.0"     :scope "test"]
                            [org.clojure/tools.nrepl "0.2.12" :scope "test"]
                            [binaryage/devtools "0.9.2" :scope "test"]

                            ;; Boot Dependencies
                            [adzerk/boot-test "1.2.0" :scope "test"]
                            [adzerk/boot-cljs "1.7.228-2" :scope "test"]
                            [adzerk/boot-cljs-repl "0.3.3" :scope "test"]
                            [crisptrutski/boot-cljs-test   "0.3.0"     :scope "test"]
                            [pandeiro/boot-http "0.7.6" :scope "test"]
                            [adzerk/boot-reload "0.4.13" :scope "test"]
                            [powerlaces/boot-cljs-devtools "0.2.0" :scope "test"]]

            :repositories #(conj % ["my.datomic.com" {:url "https://my.datomic.com/repo" :username username :password password}])
            ))

(require
 '[adzerk.boot-test      :as boot-test]
 '[adzerk.boot-cljs      :refer [cljs]]
 '[adzerk.boot-cljs-repl :refer [cljs-repl-env start-repl]]
 '[adzerk.boot-reload    :refer [reload]]
 '[pandeiro.boot-http    :refer [serve]]
 '[crisptrutski.boot-cljs-test :refer [test-cljs]]
 '[powerlaces.boot-cljs-devtools :refer [cljs-devtools]]
 '[clojure.string :as str]
 '[boot.util :as util])

(deftask build []
  (comp (notify :visual true)
        (cljs)))

(deftask run-sym
  "Run vars as a pre- and post- tasks."
  [b before SYM sym "The symbol to run inside a pre-wrap task"
   a after  SYM sym "The symbol to run inside a post-wrap task"]
  (let [get-ns (fn [str] (let [[ns s] (str/split (name str) #"/" 2)] (when s (symbol ns))))
        run-symbol (fn [s]
                     (when s
                       (when-let [ns (get-ns s)]
                         (require ns))
                       (if-let [v (resolve s)]
                         (v)
                         (util/warn "Could not find var '%s\n" s))))
        [_ before-ns?] (when before (get-ns before))
        [_ after-ns?]  (when after  (get-ns after))]
    (if (or
         (and before (not before-ns?))
         (and after  (not after-ns?)))
      (util/warn "Symbols should be fully namespace qualified\n"))
    (comp
     (if before
       (with-pass-thru _
         (run-symbol before))
       identity)
     (if after
       (with-post-wrap _
         (run-symbol after))
       identity))))

(deftask run-server []
  (run-sym :before 'comic-reader.system/stop
           :after  'comic-reader.system/go))

(deftask run []
  (comp (watch)
        (cljs-repl-env)
        (cljs-devtools)
        (reload)
        (run-server)
        (build)))

(deftask production []
  (task-options! cljs {:optimizations :advanced
                       :compiler-options {:closure-defines {:goog.DEBUG false}}})
  identity)

(deftask development []
  (set-env! :source-paths #(conj % "dev-src/clj")
            :resource-paths #(conj %  "dev-resources"))
  (task-options! cljs {:optimizations :none}
                 reload {:on-jsload 'comic-reader.main/main})
  identity)

(deftask testing []
  (set-env! :source-paths #(conj %  "test/clj" "test/cljs"))
  identity)

(deftask dev
  "Simple alias to run application in development mode"
  []
  (comp (testing)
        (development)
        (run)))

;;; This prevents a name collision WARNING between the test task and
;;; clojure.core/test, a function that nobody really uses or cares
;;; about.
(ns-unmap 'boot.user 'test)

(deftask test []
  (comp (testing)
        (test-cljs :js-env :phantom
                   :exit?  true)))

(deftask auto-test []
  (comp (testing)
        (watch)
        (test-cljs :js-env :phantom)))

(defn get-cleartext [prompt]
  (print prompt)
  (read-line))

(defn get-password [prompt]
  (print prompt)
  (apply str (.readPassword (System/console))))

(require '[clojure.string :as str])

(defn get-env-or-prompt [prefix prompt-fmt word get-fn]
  (let [env-name (str prefix word)]
    (or (System/getenv env-name)
        (get-fn (format prompt-fmt env-name (str/capitalize word))))))

(let [[username password] (mapv #(get-env-or-prompt "DATOMIC_"
                                                    "%s was not defined.\n%s"
                                                    %1 %2)
                                ["USERNAME"    "PASSWORD"]
                                [get-cleartext get-password])]

  (set-env! :source-paths #{"src/clj" "src/cljs"}
            :resource-paths #{"resources"}
            :dependencies '[[org.clojure/clojure "1.8.0"]

                            ;; Core app dependencies
                            [com.stuartsierra/component "0.3.2"]
                            [prismatic/schema "1.1.3"]
                            [environ "1.1.0"]
                            [org.clojure/tools.logging "0.3.1" :exclusions
                             [[org.slf4j/slf4j-log4j12 :extension "jar"]]]
                            [ch.qos.logback/logback-classic "1.1.11"]
                            [org.clojure/core.async "0.3.441"]

                            ;; Web server
                            [ring "1.5.1"]
                            [http-kit "2.2.0"]
                            [compojure "1.5.2"]
                            [fogus/ring-edn "0.3.0"]
                            [hiccup "1.0.5"]
                            [garden "1.3.2"]

                            ;; Data storage
                            [com.datomic/datomic-pro "0.9.5404"
                             :exclusions [org.clojure/clojure
                                          com.google.guava/guava
                                          org.apache.httpcomponents/httpclient
                                          org.slf4j/slf4j-nop]]
                            [io.rkn/conformity "0.4.0"]

                            ;; Comic scraping
                            [clj-http "2.3.0"]
                            [tempfile "0.2.0"]
                            [enlive "1.1.6"]

                            ;; Clojurescript frontend
                            [org.clojure/clojurescript "1.9.495"]
                            [re-frame "0.9.2" :exclusions
                             [[org.clojure/clojurescript
                               :extension "jar"]]]
                            [cljsjs/waypoints "4.0.0-0"]
                            [secretary "1.2.3"]
                            [cljs-ajax "0.5.8"]

                            ;; Dev Dependencies
                            [org.clojure/tools.namespace "0.3.0-alpha3" :scope "test"]
                            [radicalzephyr/clansi "1.2.0" :scope "test"]
                            [aysylu/loom "1.0.0" :scope "test"]

                            [ring/ring-mock "0.3.0" :scope "test"]
                            [figwheel-sidecar "0.5.9" :scope "test"]
                            [devcards "0.2.1-7" :scope "test"]
                            [com.cemerick/piggieback "0.2.1" :scope "test"]
                            [weasel "0.7.0"     :scope "test"]
                            [org.clojure/tools.nrepl "0.2.12" :scope "test"]
                            [binaryage/devtools "0.9.2" :scope "test"]

                            ;; Boot Dependencies
                            [adzerk/boot-test "1.2.0" :scope "test"]
                            [adzerk/boot-cljs "1.7.228-2" :scope "test"]
                            [adzerk/boot-cljs-repl "0.3.3" :scope "test"]
                            [crisptrutski/boot-cljs-test   "0.3.0"     :scope "test"]
                            [pandeiro/boot-http "0.7.6" :scope "test"]
                            [adzerk/boot-reload "0.4.13" :scope "test"]
                            [powerlaces/boot-cljs-devtools "0.2.0" :scope "test"]]

            :repositories #(conj % ["my.datomic.com" {:url "https://my.datomic.com/repo" :username username :password password}])
            ))

(require
 '[adzerk.boot-test      :refer [test] :rename {test test-clj}]
 '[adzerk.boot-cljs      :refer [cljs]]
 '[adzerk.boot-cljs-repl :refer [cljs-repl-env start-repl]]
 '[adzerk.boot-reload    :refer [reload]]
 '[pandeiro.boot-http    :refer [serve]]
 '[crisptrutski.boot-cljs-test :refer [test-cljs]]
 '[powerlaces.boot-cljs-devtools :refer [cljs-devtools]]
 '[clojure.string :as str]
 '[boot.util :as util])

(deftask build []
  (comp (notify :visual true)
        (cljs)))

(deftask run-sym
  "Run vars as a pre- and post- tasks."
  [b before SYM sym "The symbol to run inside a pre-wrap task"
   a after  SYM sym "The symbol to run inside a post-wrap task"]
  (let [get-ns (fn [str] (let [[ns s] (str/split (name str) #"/" 2)] (when s (symbol ns))))
        run-symbol (fn [s]
                     (when s
                       (when-let [ns (get-ns s)]
                         (require ns))
                       (if-let [v (resolve s)]
                         (v)
                         (util/warn "Could not find var '%s\n" s))))
        [_ before-ns?] (when before (get-ns before))
        [_ after-ns?]  (when after  (get-ns after))]
    (if (or
         (and before (not before-ns?))
         (and after  (not after-ns?)))
      (util/warn "Symbols should be fully namespace qualified\n"))
    (comp
     (if before
       (with-pass-thru _
         (run-symbol before))
       identity)
     (if after
       (with-post-wrap _
         (run-symbol after))
       identity))))

(deftask run-server []
  (run-sym :before 'comic-reader.system/stop
           :after  'comic-reader.system/go))

(deftask run []
  (comp (watch)
        (cljs-repl-env)
        (cljs-devtools)
        (reload)
        (run-server)
        (build)))

(deftask production []
  (task-options! cljs {:optimizations :advanced
                       :compiler-options {:closure-defines {:goog.DEBUG false}}})
  identity)

(deftask development []
  (set-env! :source-paths #(conj % "dev-src/clj")
            :resource-paths #(conj %  "dev-resources"))
  (task-options! cljs {:optimizations :none}
                 reload {:on-jsload 'comic-reader.main/main})
  identity)

(deftask testing []
  (set-env! :source-paths #(conj %  "test/clj" "test/cljs"))
  identity)

(deftask dev
  "Simple alias to run application in development mode"
  []
  (comp (testing)
        (development)
        (run)))

;;; This prevents a name collision WARNING between the test task and
;;; clojure.core/test, a function that nobody really uses or cares
;;; about.
(ns-unmap 'boot.user 'test)

(deftask test []
  (comp (testing)
        (development)
        (test-clj)
        (test-cljs :js-env :phantom
                   :exit?  true)))

(deftask auto-test []
  (comp (testing)
        (development)
        (watch)
        (test-clj)
        (test-cljs :js-env :phantom)))

Integrate boot-test into build steps

Integrate boot-test into build steps


(ns sitetools.prerender
  (:require [reagentdemo.core :as demo]
            [clojure.string :as string]
            [goog.events :as evt]
            [reagent.core :as r]
            [reagent.dom.server :as server]
            [reagent.debug :refer-macros [dbg log dev?]]
            [reagent.interop :as i :refer-macros [$ $!]]
            [sitetools.core :as tools]

            ;; Node libs
            [path :as path]
            [md5-file :as md5-file]
            [path :as path]
            [fs :as fs]))

(defn base [page]
  (let [depth (->> page tools/to-relative (re-seq #"/") count)]
    (->> "../" (repeat depth) (apply str))))

(defn danger [t s]
  [t {:dangerouslySetInnerHTML {:__html s}}])

(defn add-cache-buster [resource-path path]
  (let [h (md5-file/sync (path/join resource-path path))]
    (str path "?" (subs h 0 6))))

(defn html-template [{:keys [title body-html page-conf
                             js-file css-file main-div
                             js-resource-path site-dir]}]
  (server/render-to-static-markup
    [:html
     [:head
      [:meta {:charset 'utf-8}]
      [:meta {:name 'viewport
              :content "width=device-width, initial-scale=1.0"}]
      [:base {:href (-> page-conf :page-path base)}]
      [:link {:href (add-cache-buster site-dir css-file)
              :rel "stylesheet"}]
      [:title title]]
     [:body
      [:div
       {:id main-div}
       (danger :div body-html)]
      (danger :script (str "var pageConfig = "
                           (-> page-conf clj->js js/JSON.stringify)))
      [:script {:src (add-cache-buster js-resource-path js-file)
                :type "text/javascript"}]]]))

(defn gen-page [page-path conf]
  (tools/emit [:set-page page-path])
  (let [conf (merge conf @tools/config)
        b (:body conf)
        bhtml (server/render-to-string b)]
    (str "<!doctype html>\n"
         (html-template (assoc conf
                               :page-conf {:page-path page-path}
                               :body-html bhtml)))))

(defn mkdirs [f]
  (doseq [d (reductions #(str %1 "/" %2)
                        (-> (path/normalize f)
                            (string/split #"/")))]
    (when-not (fs/existsSync d)
      (fs/mkdirSync d))))

(defn write-file [f content]
  (log "Write" f)
  (mkdirs (path/dirname f))
  (fs/writeFileSync f content))

(defn write-resources [dir {:keys [css-file css-infiles]}]
  (write-file (path/join dir css-file)
              (->> css-infiles
                   (map #(fs/readFileSync %))
                   (string/join "\n"))))

(defn -main [& args]
  (log "Generating site")
  (demo/init!)
  (let [[js-resource-path] args
        {:keys [site-dir pages] :as conf} (assoc @tools/config :js-resource-path js-resource-path)]
    (write-resources site-dir conf)
    (doseq [f (keys pages)]
      (write-file (->> f tools/to-relative (path/join site-dir))
                         (gen-page f conf))))
  (log "Wrote site")
  (js/process.exit 0))

(set! *main-cli-fn* -main)

(ns sitetools.prerender
  (:require [reagentdemo.core :as demo]
            [clojure.string :as string]
            [goog.events :as evt]
            [reagent.core :as r]
            [reagent.dom.server :as server]
            [reagent.debug :refer-macros [dbg log dev?]]
            [sitetools.core :as tools]

            ;; Node libs
            [path :as path]
            [md5-file :as md5-file]
            [path :as path]
            [fs :as fs]))

(defn base [page]
  (let [depth (->> page tools/to-relative (re-seq #"/") count)]
    (->> "../" (repeat depth) (apply str))))

(defn danger [t s]
  [t {:dangerouslySetInnerHTML {:__html s}}])

(defn add-cache-buster [resource-path path]
  (let [h (md5-file/sync (path/join resource-path path))]
    (str path "?" (subs h 0 6))))

(defn html-template [{:keys [title body-html page-conf
                             js-file css-file main-div
                             js-resource-path site-dir]}]
  (server/render-to-static-markup
    [:html
     [:head
      [:meta {:charset 'utf-8}]
      [:meta {:name 'viewport
              :content "width=device-width, initial-scale=1.0"}]
      [:base {:href (-> page-conf :page-path base)}]
      [:link {:href (add-cache-buster site-dir css-file)
              :rel "stylesheet"}]
      [:title title]]
     [:body
      [:div
       {:id main-div}
       (danger :div body-html)]
      (danger :script (str "var pageConfig = "
                           (-> page-conf clj->js js/JSON.stringify)))
      [:script {:src (add-cache-buster js-resource-path js-file)
                :type "text/javascript"}]]]))

(defn gen-page [page-path conf]
  (tools/emit [:set-page page-path])
  (let [conf (merge conf @tools/config)
        b (:body conf)
        bhtml (server/render-to-string b)]
    (str "<!doctype html>\n"
         (html-template (assoc conf
                               :page-conf {:page-path page-path}
                               :body-html bhtml)))))

(defn mkdirs [f]
  (doseq [d (reductions #(str %1 "/" %2)
                        (-> (path/normalize f)
                            (string/split #"/")))]
    (when-not (fs/existsSync d)
      (fs/mkdirSync d))))

(defn write-file [f content]
  (log "Write" f)
  (mkdirs (path/dirname f))
  (fs/writeFileSync f content))

(defn write-resources [dir {:keys [css-file css-infiles]}]
  (write-file (path/join dir css-file)
              (->> css-infiles
                   (map #(fs/readFileSync %))
                   (string/join "\n"))))

(defn -main [& args]
  (log "Generating site")
  (demo/init!)
  (let [[js-resource-path] args
        {:keys [site-dir pages] :as conf} (assoc @tools/config :js-resource-path js-resource-path)]
    (write-resources site-dir conf)
    (doseq [f (keys pages)]
      (write-file (->> f tools/to-relative (path/join site-dir))
                         (gen-page f conf))))
  (log "Wrote site")
  (js/process.exit 0))

(set! *main-cli-fn* -main)

Remove old require from demo site code

Remove old require from demo site code


(ns buzz.core

  "Asynchronous state management based on messages with pure functions."

  (:require [clojure.core.async :as a :refer [go-loop <! chan]]
            [clojure.pprint :as pp])
  (:import java.io.PrintWriter))

(defn default-update-ex
  "Default exception handler for update-fn."
  [msg ex]
  (let [err-msg (str
                 "Error occured while handling message.\n"
                 "  Event: " (with-out-str (pp/pprint msg) "\n")
                 "  Error: " (with-out-str (.printStackTrace ex (PrintWriter. *out*))))]
    (binding [*out* *err*]
      (.println *err* err-msg))))

(defn- handle-msg
  "Handles messages."
  [state-atom update-fn update-ex-fn msg]
  (try (let [res (update-fn @state-atom msg)]
         (reset! state-atom res))
       (catch Exception ex
         (update-ex-fn msg ex))))

(defn- start-message-processing
  "Starts message processing."
  [state-atom update-fn update-ex-fn msg-chan]
  (let [handle-msg (partial handle-msg state-atom update-fn update-ex-fn)]
    (go-loop []
      (if-let [msg (<! msg-chan)]
        (do (handle-msg msg)
            (recur))))))

(defn buzz
  "Creates buzz which manages given state-atom based on messages."
  [state-atom update-fn execute-fn & opts]
  (let [{:keys [update-ex-fn]
         :or   {update-ex-fn default-update-ex}} opts
        msg-chan (chan)]
    (start-message-processing state-atom update-fn update-ex-fn msg-chan)
    {:msg-chan msg-chan}))

(defn put!
  "Puts message into buzz."
  [buzz msg]
  (a/put! (:msg-chan buzz) msg))

(defn close!
  "Closes buzz."
  [buzz]
  (a/close! (:msg-chan buzz)))

(ns buzz.core

  "Asynchronous state management based on messages with pure functions."

  (:require [clojure.core.async :as a :refer [go-loop <! chan]]
            [clojure.pprint :as pp])
  (:import java.io.PrintWriter))

(defn default-update-ex
  "Default exception handler for update-fn."
  #_(try
      (throw (NullPointerException. "Oh no"))
      (catch Exception ex
        (default-update-ex "Msg" ex)))
  [msg ex]
  (let [err-msg (str
                 "Error occured while handling message.\n"
                 "  Event: " (with-out-str (pp/pprint msg) "\n")
                 "  Error: " (with-out-str (.printStackTrace ex (PrintWriter. *out*))))]
    (.println *err* err-msg)))

(defn- handle-msg
  "Handles messages."
  [state-atom update-fn update-ex-fn msg]
  (try (let [res (update-fn @state-atom msg)]
         (reset! state-atom res))
       (catch Exception ex
         (update-ex-fn msg ex))))

(defn- start-message-processing
  "Starts message processing."
  [state-atom update-fn update-ex-fn msg-chan]
  (let [handle-msg (partial handle-msg state-atom update-fn update-ex-fn)]
    (go-loop []
      (if-let [msg (<! msg-chan)]
        (do (handle-msg msg)
            (recur))))))

(defn buzz
  "Creates buzz which manages given state-atom based on messages."
  [state-atom update-fn execute-fn & opts]
  (let [{:keys [update-ex-fn]
         :or   {update-ex-fn default-update-ex}} opts
        msg-chan (chan)]
    (start-message-processing state-atom update-fn update-ex-fn msg-chan)
    {:msg-chan msg-chan}))

(defn put!
  "Puts message into buzz."
  [buzz msg]
  (a/put! (:msg-chan buzz) msg))

(defn close!
  "Closes buzz."
  [buzz]
  (a/close! (:msg-chan buzz)))

Remove unnecessary binding.

Remove unnecessary binding.