(ns control.core
  (:use [clojure.java.io :only [reader]]
        [clojure.string :only [join blank?]]
        [clojure.walk :only [walk]]
        [clojure.contrib.def :only [defvar- defvar]]))

(defvar  *enable-color* true)
(defvar-  *enable-logging* true)
(defvar-  *runtime* (Runtime/getRuntime))
(defvar- bash-reset "\033[0m")
(defvar- bash-bold "\033[1m")
(defvar- bash-redbold "\033[1;31m")
(defvar- bash-greenbold "\033[1;32m")

(defmacro cli-bash-bold [& content]
  `(if *enable-color*
     (str bash-bold ~@content bash-reset)
     (str ~@content)))

(defmacro cli-bash-redbold [& content]
  `(if *enable-color*
     (str bash-redbold ~@content bash-reset)
     (str ~@content)))

(defmacro cli-bash-greenbold [& content]
  `(if *enable-color*
     (str bash-greenbold ~@content bash-reset)
     (str ~@content)))

(defstruct ExecProcess :process :in :err :stdout :stderr :status)

(defn- spawn
  [cmdarray]
  (let [process (.exec *runtime* cmdarray)
        in (reader (.getInputStream process) :encoding "UTF-8")
        err (reader (.getErrorStream process) :encoding "UTF-8")
        execp (struct ExecProcess process in err)
        pagent (agent execp)]
    (send-off pagent
              (fn [exec-process]
                (assoc exec-process :stdout (str (:stdout exec-process)
                                                 (join "\r\n" (doall (line-seq in)))))))
    (send-off pagent
              (fn [exec-process]
                (assoc exec-process :stderr (str (:stderr exec-process)
                                                 (join "\r\n" (doall (line-seq err)))))))
    pagent))

(defn- await-process [pagent]
  (let [execp @pagent
        process (:process execp)
        in (:in execp)
        err (:err execp)]
    (await pagent)
    (.close in)
    (.close err)
    (.waitFor process)))

(defn gen-log [host tag content]
  (str (cli-bash-redbold host ":")
       (cli-bash-greenbold tag ": ")
       (join " " content)))

(defn log-with-tag [host tag & content]
  (if (and *enable-logging* (not (blank? (join " " content))))
    (println (gen-log host tag content))))

(defn- not-nil? [obj]
  (not (nil? obj)))

(defn  exec [host user cmdcol]
  (let [pagent (spawn (into-array String (filter not-nil? cmdcol)))
        status (await-process pagent)
        execp @pagent]
    (log-with-tag host "stdout" (:stdout execp))
    (log-with-tag host "stderr" (:stderr execp))
    (log-with-tag host "exit" status)
    (assoc execp :status status)))

(defn ssh-client [host user]
  (str user "@" host))

(defn- user-at-host? [host user]
  (fn [m]
    (and (= (:user m) user) (= (:host m) host))))

(defn- find-client-options [host user cluster sym]
  (let [m (first (filter (user-at-host? host user) (:clients cluster)))]
    (or (sym m) (sym cluster))))

(defn- make-cmd-array
  [cmd options others]
  (if (vector? options)
    (concat (cons cmd options) others)
    (cons cmd (cons options others))))

(defn ssh [host user cluster cmd]
  (let [ssh-options (find-client-options host user cluster :ssh-options)]
	(log-with-tag host "ssh" ssh-options cmd)
	(exec host
          user
          (make-cmd-array "ssh"
                          ssh-options
                          [(ssh-client host user) cmd]))))

(defn rsync [host user cluster src dst]
  (let [rsync-options (find-client-options host user cluster :rsync-options)]
    (log-with-tag host "rsync" rsync-options (str src " ==>" dst))
    (exec host
          user
          (make-cmd-array "rsync"
                          rsync-options
                          [src (str (ssh-client host user) ":" dst)]))))

(defn scp [host user cluster files remoteDir]
  (let [scp-options (find-client-options host user cluster :scp-options)]
    (log-with-tag host "scp" scp-options
      (join " " (concat files [ " ==> " remoteDir])))
    (exec host
          user
          (make-cmd-array "scp"
                          scp-options
                          (concat files [(str (ssh-client host user) ":" remoteDir)])))))

(defvar tasks (atom (hash-map)))
(defvar clusters (atom (hash-map)))

(defmacro deftask [name desc arguments & body]
  (let [new-body (map #(concat (list (first %) 'host 'user 'cluster) (rest %)) body)]
    `(swap! tasks
            assoc
            ~name
            ~(list 'fn
                   (vec (concat '[host user cluster] arguments))
                   (cons 'do new-body)))))

(defn- unquote-cluster [args]
  (walk (fn [item]
          (cond (and (seq? item) (= `unquote (first item)))
                ,(second item)
                (or (seq? item) (symbol? item))
                ,(list 'quote item)
                :else
                ,(unquote-cluster item)))
        identity
        args))

(defmacro defcluster [name & args]
  `(let [m# (apply hash-map ~(cons 'list (unquote-cluster args)))]
     (swap! clusters assoc ~name (assoc m# :name ~name))))

(defmacro when-exit
  ([test error]
     `(when-exit ~test ~error nil))
  ([test error else]
     `(if ~test
        (do (println ~error) (System/exit 1))
        ~else)))

(defn- perform [host user cluster task taskName arguments]
  (do (if *enable-logging* (println (cli-bash-bold "Performing " (name taskName) " for " host)))
      (apply task host user cluster arguments)))

(defn- arg-count [f]
  (let [m (first (.getDeclaredMethods (class f)))
        p (.getParameterTypes m)]
    (alength p)))

(defn do-begin [args]
  (when-exit (< (count args) 2)
             "Please offer cluster and task name"
             (let [clusterName (keyword (first args))
                   taskName (keyword (second args))
                   args (next (next args))
                   cluster (clusterName @clusters)
                   parallel (:parallel cluster)
                   user (:user cluster)
                   addresses (:addresses cluster)
                   clients (:clients cluster)
                   task (taskName @tasks)
                   log (:log cluster)]
               (when-exit (nil? task)
                          (str "No task named " (name taskName)))
               (when-exit (and (empty? addresses)
                               (empty? clients))
                          (str "Empty clients for cluster "
                               (name clusterName)))
               (let [task-arg-count (- (arg-count task) 3)]
                 (when-exit (not= task-arg-count (count args))
                            (str "Task "
                                 (name taskName)
                                 " just needs "
                                 task-arg-count
                                 " arguments")))
               (binding [*enable-logging* (if (nil? log) true log)]
                 (if *enable-logging*
                   (println  (str bash-bold
                                  "Performing "
                                  (name clusterName)
                                  bash-reset
                                  (if parallel
                                    " in parallel"))))
                 (let [map-fn (if parallel pmap map)
                       a (dorun (map-fn #(perform % user cluster task taskName args)
                                        addresses))
                       c (dorun (map-fn #(perform (:host %) (:user %) cluster task taskName args)
                                        clients))]
                   (shutdown-agents)
                   (concat a c))))))

(defn begin []
  (do-begin *command-line-args*))

(ns control.core
  (:use [clojure.java.io :only [reader]]
        [clojure.string :only [join blank?]]
        [clojure.walk :only [walk]]
        [clojure.contrib.def :only [defvar- defvar]]))

(defvar  *enable-color* true)
(defvar-  *enable-logging* true)
(defvar-  *runtime* (Runtime/getRuntime))
(defvar- bash-reset "\033[0m")
(defvar- bash-bold "\033[1m")
(defvar- bash-redbold "\033[1;31m")
(defvar- bash-greenbold "\033[1;32m")

(defmacro cli-bash-bold [& content]
  `(if *enable-color*
     (str bash-bold ~@content bash-reset)
     (str ~@content)))

(defmacro cli-bash-redbold [& content]
  `(if *enable-color*
     (str bash-redbold ~@content bash-reset)
     (str ~@content)))

(defmacro cli-bash-greenbold [& content]
  `(if *enable-color*
     (str bash-greenbold ~@content bash-reset)
     (str ~@content)))

(defstruct ExecProcess :process :in :err :stdout :stderr :status)

(defn- spawn
  [cmdarray]
  (let [process (.exec *runtime* cmdarray)
        in (reader (.getInputStream process) :encoding "UTF-8")
        err (reader (.getErrorStream process) :encoding "UTF-8")
        execp (struct ExecProcess process in err)
        pagent (agent execp)]
    (send-off pagent
              (fn [exec-process]
                (assoc exec-process :stdout (str (:stdout exec-process)
                                                 (join "\r\n" (doall (line-seq in)))))))
    (send-off pagent
              (fn [exec-process]
                (assoc exec-process :stderr (str (:stderr exec-process)
                                                 (join "\r\n" (doall (line-seq err)))))))
    pagent))

(defn- await-process [pagent]
  (let [execp @pagent
        process (:process execp)
        in (:in execp)
        err (:err execp)]
    (await pagent)
    (.close in)
    (.close err)
    (.waitFor process)))

(defn gen-log [host tag content]
  (str (cli-bash-redbold host ":")
       (cli-bash-greenbold tag ": ")
       (join " " content)))

(defn log-with-tag [host tag & content]
  (if (and *enable-logging* (not (blank? (join " " content))))
    (println (gen-log host tag content))))

(defn- not-nil? [obj]
  (not (nil? obj)))

(defn  exec [host user cmdcol]
  (let [pagent (spawn (into-array String (filter not-nil? cmdcol)))
        status (await-process pagent)
        execp @pagent]
    (log-with-tag host "stdout" (:stdout execp))
    (log-with-tag host "stderr" (:stderr execp))
    (log-with-tag host "exit" status)
    (assoc execp :status status)))

(defn ssh-client [host user]
  (str user "@" host))

(defn- user-at-host? [host user]
  (fn [m]
    (and (= (:user m) user) (= (:host m) host))))

(defn- find-client-options [host user cluster sym]
  (let [m (first (filter (user-at-host? host user) (:clients cluster)))]
    (or (sym m) (sym cluster))))

(defn- make-cmd-array
  [cmd options others]
  (if (vector? options)
    (concat (cons cmd options) others)
    (cons cmd (cons options others))))

(defn ssh [host user cluster cmd]
  (let [ssh-options (find-client-options host user cluster :ssh-options)]
	(log-with-tag host "ssh" ssh-options cmd)
	(exec host
          user
          (make-cmd-array "ssh"
                          ssh-options
                          [(ssh-client host user) cmd]))))

(defn rsync [host user cluster src dst]
  (let [rsync-options (find-client-options host user cluster :rsync-options)]
    (log-with-tag host "rsync" rsync-options (str src " ==>" dst))
    (exec host
          user
          (make-cmd-array "rsync"
                          rsync-options
                          [src (str (ssh-client host user) ":" dst)]))))

(defn scp [host user cluster files remoteDir]
  (let [scp-options (find-client-options host user cluster :scp-options)]
    (log-with-tag host "scp" scp-options
      (join " " (concat files [ " ==> " remoteDir])))
    (exec host
          user
          (make-cmd-array "scp"
                          scp-options
                          (concat files [(str (ssh-client host user) ":" remoteDir)])))))

(defvar tasks (atom (hash-map)))
(defvar clusters (atom (hash-map)))

(defmacro
  ^{:doc "Define a task for remote machines"
    :arglists '([name doc-string? [params*] body])
    :added "0.1"}
  deftask [name & decl ]
  (let [m (if (string? (first decl))
            (next decl)
            decl)
        arguments (first m)
        body (next m)
        new-body (map #(concat (list (first %) 'host 'user 'cluster) (rest %)) body)]
    `(swap! tasks
            assoc
            ~name
            ~(list 'fn
                   (vec (concat '[host user cluster] arguments))
                   (cons 'do new-body)))))

(defn- unquote-cluster [args]
  (walk (fn [item]
          (cond (and (seq? item) (= `unquote (first item)))
                ,(second item)
                (or (seq? item) (symbol? item))
                ,(list 'quote item)
                :else
                ,(unquote-cluster item)))
        identity
        args))

(defmacro
  ^{:doc "Define a cluster including some remote machines"
    :arglists '([name & options])
    :added "0.1"}
  defcluster [name & args]
  `(let [m# (apply hash-map ~(cons 'list (unquote-cluster args)))]
     (swap! clusters assoc ~name (assoc m# :name ~name))))

(defmacro when-exit
  ([test error]
     `(when-exit ~test ~error nil))
  ([test error else]
     `(if ~test
        (do (println ~error) (System/exit 1))
        ~else)))

(defn- perform [host user cluster task taskName arguments]
  (do (if *enable-logging* (println (cli-bash-bold "Performing " (name taskName) " for " host)))
      (apply task host user cluster arguments)))

(defn- arg-count [f]
  (let [m (first (.getDeclaredMethods (class f)))
        p (.getParameterTypes m)]
    (alength p)))

(defn do-begin [args]
  (when-exit (< (count args) 2)
             "Please offer cluster and task name"
             (let [clusterName (keyword (first args))
                   taskName (keyword (second args))
                   args (next (next args))
                   cluster (clusterName @clusters)
                   parallel (:parallel cluster)
                   user (:user cluster)
                   addresses (:addresses cluster)
                   clients (:clients cluster)
                   task (taskName @tasks)
                   log (:log cluster)]
               (when-exit (nil? task)
                          (str "No task named " (name taskName)))
               (when-exit (and (empty? addresses)
                               (empty? clients))
                          (str "Empty clients for cluster "
                               (name clusterName)))
               (let [task-arg-count (- (arg-count task) 3)]
                 (when-exit (not= task-arg-count (count args))
                            (str "Task "
                                 (name taskName)
                                 " just needs "
                                 task-arg-count
                                 " arguments")))
               (binding [*enable-logging* (if (nil? log) true log)]
                 (if *enable-logging*
                   (println  (str bash-bold
                                  "Performing "
                                  (name clusterName)
                                  bash-reset
                                  (if parallel
                                    " in parallel"))))
                 (let [map-fn (if parallel pmap map)
                       a (dorun (map-fn #(perform % user cluster task taskName args)
                                        addresses))
                       c (dorun (map-fn #(perform (:host %) (:user %) cluster task taskName args)
                                        clients))]
                   (shutdown-agents)
                   (concat a c))))))

(defn begin []
  (do-begin *command-line-args*))

Make doc-string optional for deftask

Make doc-string optional for deftask


(ns clj-tcp.client
   (:require [clojure.tools.logging :refer [info error]]
             [clj-tcp.codec :refer [byte-decoder default-encoder buffer->bytes]]
             [clojure.core.async :refer [chan >!! go >! <! <!! thread timeout alts!!]])
   (:import
            [java.net InetSocketAddress]
            [java.util.concurrent.atomic AtomicInteger AtomicBoolean]
            [io.netty.util CharsetUtil]
            [io.netty.buffer Unpooled ByteBuf ByteBufUtil]
            [io.netty.channel SimpleChannelInboundHandler ChannelPipeline ChannelFuture Channel ChannelHandler ChannelInboundHandlerAdapter ChannelInitializer ChannelInitializer ChannelHandlerContext ChannelFutureListener]
            [io.netty.channel.nio NioEventLoopGroup]
            [io.netty.util.concurrent GenericFutureListener Future EventExecutorGroup]
            [io.netty.bootstrap Bootstrap]
            [io.netty.channel.socket.nio NioSocketChannel]))

(defrecord Client [group channel-f write-ch read-ch error-ch ^AtomicInteger reconnect-count ^AtomicBoolean closed])

(defrecord Reconnected [^Client client cause])
(defrecord Pause [time])
(defrecord Stop [])
(defrecord Poison [])
(defrecord FailedWrite [v])

(defn close-client [{:keys [group channel-f]}]
  (if channel-f
    (-> ^ChannelFuture channel-f ^Channel .channel .closeFuture)))

(defn close-all [{:keys [group closed] :as conf}]
  (close-client conf)
  (if group
    (-> group .shutdownGracefully .sync))
  (if closed
    (.set ^AtomicBoolean closed true)))

(defn client-handler [{:keys [group read-ch error-ch write-ch]}]
  (proxy [SimpleChannelInboundHandler]
    []
    (channelActive [^ChannelHandlerContext ctx]
      ;(.writeAndFlush ctx (Unpooled/copiedBuffer "Netty Rocks1" CharsetUtil/UTF_8))
      )
    (channelRead0 [^ChannelHandlerContext ctx ^ByteBuf in]
      ;(info "Received")
      ;(info "Client received : " (ByteBufUtil/hexDump (.readBytes in (.readableBytes in))))
      (>!! read-ch (buffer->bytes in))
      )
    (exceptionCaught [^ChannelHandlerContext ctx cause]
      (error "Client-handler exception caught " cause)
      (error cause (>!! [cause ctx]) )
      (.close ctx))))

(defn ^ChannelInitializer client-channel-initializer [{:keys [group read-ch error-ch write-ch handlers] :as conf}]
  (let [group (NioEventLoopGroup.)]
	  (proxy [ChannelInitializer]
	    []
	    (initChannel [^Channel ch]
        (try
	        ;add the last default read handler that will send all read objects to the read-ch blocking if full
          (-> ch  ^ChannelPipeline (.pipeline) (.addLast ^EventExecutorGroup group (into-array ChannelHandler [(client-handler conf)])))
         ;add any extra handlers e.g. for encoding or deconding
          (if handlers
            (-> ch  ^ChannelPipeline (.pipeline) (.addLast group (into-array ChannelHandler (map #(%) handlers)))))
         (catch Exception e (do
                              (error (str "channel initializer error " e) e)
                              (go (>! error-ch [e nil]))
                              )))
	      ))))

(defn exception-listener [v {:keys [error-ch]}]
  "Returns a GenericFutureListener instance
   that on completion checks the Future, if any exception
   an error is sent to the error-ch"
  (reify GenericFutureListener
    (operationComplete [this f]
       (if (not (.isSuccess ^Future f))
         (if-let [cause (.cause ^Future f)]
               (do (error "operation complete cause " cause)
                   (go (>! error-ch [cause (->FailedWrite v)])))
           )))))

(defn close-listener [^Client client {:keys [error-ch]}]
  "Close a client after a write operation has been completed"
  (reify GenericFutureListener
    (operationComplete [this f]
       (thread
               (try
                  (close-client client)
                  (catch Exception e (do
                                       (error (str "Close listener error " e)  e)
                                       (>!! error-ch [e nil])
                                       )))))))

(defn write! [{:keys [write-ch]} v]
  "Writes and blocks if the write-ch is full"
  (>!! write-ch v))

(defn read!
  ([{:keys [read-ch]} timeout-ms]
    (first
      (alts!!
		     [read-ch
		     (timeout timeout-ms)])))
  ([{:keys [read-ch]}]
  "Reads from the read-ch and blocks if no data is available"
  (<!! read-ch)))

(defn read-error
   ([{:keys [error-ch]} timeout-ms]
    (first
      (alts!!
		     [error-ch
		     (timeout timeout-ms)])))

  ([{:keys [error-ch]}]
  "Reads from the error-ch and blocks if no data is available"
  (<!! error-ch)))

(defn- do-write [^Client client ^bytes v close-after-write {:keys [error-ch] :as conf}]
  "Writes to the channel, this operation is non blocking and a exception listener is added to the write's ChannelFuture
   to send any errors to the error-ch"
  (try
    (do
     (let [ch-f (-> client ^ChannelFuture (:channel-f) ^Channel (.channel) ^ChannelFuture (.writeAndFlush v) (.addListener ^ChannelFutureListener (exception-listener v conf)))]
       (if close-after-write
         (.addListener ch-f ^ChannelFutureListener (close-listener client conf)))))
     (catch Exception e (do
                          (error (str "Error in do-write " e) e)
                          (>!! error-ch [e v])
                          ))))

(defn start-client [host port {:keys [group read-ch error-ch write-ch handlers] :as conf
                                 :or {group (NioEventLoopGroup.) read-ch (chan 100) error-ch (chan 100) write-ch (chan 100)}}]
  "Start a Client instance with read-ch, write-ch and error-ch"
  (try
  (let [g (if group group (NioEventLoopGroup.))
        b (Bootstrap.)]
    (-> b (.group g)
      ^Bootstrap (.channel NioSocketChannel)
      ^Bootstrap (.remoteAddress (InetSocketAddress. (str host) (int port)))
      ^Bootstrap (.handler ^ChannelInitializer (client-channel-initializer conf)))
    (let [ch-f (.connect b)]
      (.sync ch-f)
      (->Client g ch-f write-ch read-ch error-ch (AtomicInteger.) (AtomicBoolean. false))))
  (catch Exception e (do
                       (.printStackTrace e)
                       (error (str "Error starting client " e) e)
                       (>!! error-ch [e nil])
                       ))))

(defn read-print-ch [n ch]
  (go
    (loop [ch1 ch]
      (let [c (<! ch1)]
         (if (instance? Reconnected c)
           (do
             ;(info "Reconnected " (:cause c) " ch1 " ch1 " new ch " (-> c :client :read-ch))
             (recur (-> c :client :read-ch)))
           (do
             (info n " = " c)
             (recur ch1)))))))

(defn read-print-in [{:keys [read-ch]}]
  (read-print-ch "read" read-ch))

(defn client [host port {:keys [handlers
                                  retry-limit
                                  write-buff read-buff error-buff
                                  write-timeout read-timeout]
                           :or {handlers [default-encoder] retry-limit 10
                                write-buff 100 read-buff 100 error-buff 1000 reuse-client false write-timeout 1500 read-timeout 1500} }]
  (let [ write-ch (chan write-buff)
         read-ch (chan read-buff)
         error-ch (chan error-buff)
         g (NioEventLoopGroup.)
         conf {:group g :write-ch write-ch :read-ch read-ch :error-ch error-ch :handlers handlers}
         client (start-client host port conf) ]

    (if (not client)
      (do
        (let [cause (read-error {:error-ch error-ch} 200)]
	        (close-all client)
	        (throw (RuntimeException. "Unable to create client" (first cause))))))

    ;async read off error-ch
    (go
      (loop [local-client client]
        (let [[v o] (<! error-ch)]
          (error "read error from error-ch " v)

          (if (instance? Poison v)
            (if local-client (close-client local-client)) ;poinson pill end loop
          (do
            ;on error, pause writing, and close client
	          (>! write-ch (->Pause 1000))
            (close-client local-client)

           (let [c
                 (loop [acc 0] ;reconnect in loop
				            (if (>= acc retry-limit)
				              (do
                        ;if limit reached send poinson to all channels and call close all on client, end loop
				                (error "Retry limit reached, closing all channels and connections")
				                (go (>! write-ch (->Poison) ))
				                (go (>! read-ch (->Poison) ))
				                (go (>! error-ch (->Poison) ))
				                (close-all local-client)
			                  nil
				              )
					            (let [v1
                             (try
									              (let [c (start-client host port conf)
									                    reconnected (->Reconnected c v)]
				                          ;if connected, send Reconnected instance to all channels and return c, this c is assigned to the loop using recur
											                (.getAndIncrement ^AtomicInteger (:reconnect-count c))
											                (>! read-ch reconnected)
											                (>! write-ch reconnected)
									                    c)
									              (catch Exception e (do
									                                   (error (str "Error while doing retry " e) e)
                                                     e ;return exception to v, due to a bug in core async http://dev.clojure.org/jira/browse/ASYNC-48, we cannot recur here
				                                             )))]
                            (if (instance? Exception v1) ;if v is an exception recur
                              (recur (inc acc))
                              v1) ;else return the value (this is c, the connection)
                            )))]

                      (if (and (instance? FailedWrite o) c)
                        (do
                            (info "retry failed write: ")
                            (<! (timeout 500))
                            (>! write-ch (:v o))))

                      (recur c))

	          )))))

     ;async read off write-ch
     (go
	      (loop [local-client client]
           (let [v (<! write-ch)]
		          (if (instance? Stop v) nil ;if stop exit loop
		             (do
                   (try
                      (cond (instance? Reconnected v) (do (recur (:client v))) ;if reconnect recur with the new client
					             (instance? Pause v) (do (<! (timeout (:time v))) (recur local-client)) ;if pause, wait :time millis, then recur loop
					             :else
				                (do ;else write the value to the client channel
                           (if (> (.get ^AtomicInteger (:reconnect-count local-client)) 0) (.set ^AtomicInteger (:reconnect-count local-client) 0))
						               (do-write local-client v false conf)))
							        (catch Exception e (do ;send any exception to the error-ch
								                            (error "!!!!! Error while writing " e)
								                            (go (>! error-ch [e nil]))
                                    )))
                      (if (not (instance? Stop v))
                         (recur local-client)) ;if not stop recur loop
                      )))))

		    client))

(ns clj-tcp.client
   (:require [clojure.tools.logging :refer [info error]]
             [clj-tcp.codec :refer [byte-decoder default-encoder buffer->bytes]]
             [clojure.core.async :refer [chan >!! go >! <! <!! thread timeout alts!!]])
   (:import
            [java.net InetSocketAddress]
            [java.util.concurrent.atomic AtomicInteger AtomicBoolean]
            [io.netty.util CharsetUtil]
            [io.netty.buffer Unpooled ByteBuf ByteBufUtil]
            [io.netty.channel SimpleChannelInboundHandler ChannelPipeline ChannelFuture Channel ChannelHandler ChannelInboundHandlerAdapter ChannelInitializer ChannelInitializer ChannelHandlerContext ChannelFutureListener]
            [io.netty.channel.nio NioEventLoopGroup]
            [io.netty.util.concurrent GenericFutureListener Future EventExecutorGroup]
            [io.netty.bootstrap Bootstrap]
            [io.netty.channel.socket.nio NioSocketChannel]))

(defrecord Client [group channel-f write-ch read-ch error-ch ^AtomicInteger reconnect-count ^AtomicBoolean closed])

(defrecord Reconnected [^Client client cause])
(defrecord Pause [time])
(defrecord Stop [])
(defrecord Poison [])
(defrecord FailedWrite [v])

(defn close-client [{:keys [group channel-f]}]
  (if channel-f
    (-> ^ChannelFuture channel-f ^Channel .channel .closeFuture)))

(defn close-all [{:keys [group closed] :as conf}]
  (close-client conf)
  (if group
    (-> group .shutdownGracefully .sync))
  (if closed
    (.set ^AtomicBoolean closed true)))

(defn client-handler [{:keys [group read-ch error-ch write-ch]}]
  (proxy [SimpleChannelInboundHandler]
    []
    (channelActive [^ChannelHandlerContext ctx]
      ;(.writeAndFlush ctx (Unpooled/copiedBuffer "Netty Rocks1" CharsetUtil/UTF_8))
      )
    (channelRead0 [^ChannelHandlerContext ctx ^ByteBuf in]
      ;(info "Received")
      ;(info "Client received : " (ByteBufUtil/hexDump (.readBytes in (.readableBytes in))))
      (>!! read-ch (buffer->bytes in))
      )
    (exceptionCaught [^ChannelHandlerContext ctx cause]
      (error "Client-handler exception caught " cause)
      (error cause (>!! [cause ctx]) )
      (.close ctx))))

(defn ^ChannelInitializer client-channel-initializer [{:keys [group read-ch error-ch write-ch handlers] :as conf}]
  (let [group (NioEventLoopGroup.)]
	  (proxy [ChannelInitializer]
	    []
	    (initChannel [^Channel ch]
        (try
	        ;add the last default read handler that will send all read objects to the read-ch blocking if full
          (-> ch  ^ChannelPipeline (.pipeline) (.addLast ^EventExecutorGroup group (into-array ChannelHandler [(client-handler conf)])))
         ;add any extra handlers e.g. for encoding or deconding
          (if handlers
            (-> ch  ^ChannelPipeline (.pipeline) (.addLast group (into-array ChannelHandler (map #(%) handlers)))))
         (catch Exception e (do
                              (error (str "channel initializer error " e) e)
                              (go (>! error-ch [e nil]))
                              )))
	      ))))

(defn exception-listener [v {:keys [error-ch]}]
  "Returns a GenericFutureListener instance
   that on completion checks the Future, if any exception
   an error is sent to the error-ch"
  (reify GenericFutureListener
    (operationComplete [this f]
       (if (not (.isSuccess ^Future f))
         (if-let [cause (.cause ^Future f)]
               (do (error "operation complete cause " cause)
                   (go (>! error-ch [cause (->FailedWrite v)])))
           )))))

(defn close-listener [^Client client {:keys [error-ch]}]
  "Close a client after a write operation has been completed"
  (reify GenericFutureListener
    (operationComplete [this f]
       (thread
               (try
                  (close-client client)
                  (catch Exception e (do
                                       (error (str "Close listener error " e)  e)
                                       (>!! error-ch [e nil])
                                       )))))))

(defn write! [{:keys [write-ch]} v]
  "Writes and blocks if the write-ch is full"
  (>!! write-ch v))

(defn read!
  ([{:keys [read-ch]} timeout-ms]
    (first
      (alts!!
		     [read-ch
		     (timeout timeout-ms)])))
  ([{:keys [read-ch]}]
  "Reads from the read-ch and blocks if no data is available"
  (<!! read-ch)))

(defn read-error
   ([{:keys [error-ch]} timeout-ms]
    (first
      (alts!!
		     [error-ch
		     (timeout timeout-ms)])))

  ([{:keys [error-ch]}]
  "Reads from the error-ch and blocks if no data is available"
  (<!! error-ch)))

(defn- do-write [^Client client ^bytes v close-after-write {:keys [error-ch] :as conf}]
  "Writes to the channel, this operation is non blocking and a exception listener is added to the write's ChannelFuture
   to send any errors to the error-ch"
  (try
    (do
     (let [ch-f (-> client ^ChannelFuture (:channel-f) ^Channel (.channel) ^ChannelFuture (.writeAndFlush v) (.addListener ^ChannelFutureListener (exception-listener v conf)))]
       (if close-after-write
         (.addListener ch-f ^ChannelFutureListener (close-listener client conf)))))
     (catch Exception e (do
                          (error (str "Error in do-write " e) e)
                          (>!! error-ch [e v])
                          ))))

(defn start-client [host port {:keys [group read-ch error-ch write-ch handlers] :as conf
                                 :or {group (NioEventLoopGroup.) read-ch (chan 100) error-ch (chan 100) write-ch (chan 100)}}]
  "Start a Client instance with read-ch, write-ch and error-ch"
  (try
  (let [g (if group group (NioEventLoopGroup.))
        b (Bootstrap.)]
    (-> b (.group g)
      ^Bootstrap (.channel NioSocketChannel)
      ^Bootstrap (.remoteAddress (InetSocketAddress. (str host) (int port)))
      ^Bootstrap (.handler ^ChannelInitializer (client-channel-initializer conf)))
    (let [ch-f (.connect b)]
      (.sync ch-f)
      (->Client g ch-f write-ch read-ch error-ch (AtomicInteger.) (AtomicBoolean. false))))
  (catch Exception e (do
                       (.printStackTrace e)
                       (error (str "Error starting client " e) e)
                       (>!! error-ch [e nil])
                       ))))

(defn read-print-ch [n ch]
  (go
    (loop [ch1 ch]
      (let [c (<! ch1)]
         (if (instance? Reconnected c)
           (do
             ;(info "Reconnected " (:cause c) " ch1 " ch1 " new ch " (-> c :client :read-ch))
             (recur (-> c :client :read-ch)))
           (do
             (info n " = " c)
             (recur ch1)))))))

(defn read-print-in [{:keys [read-ch]}]
  (read-print-ch "read" read-ch))

(defn client [host port {:keys [handlers
                                  retry-limit
                                  write-buff read-buff error-buff
                                  write-timeout read-timeout]
                           :or {handlers [default-encoder] retry-limit 10
                                write-buff 100 read-buff 100 error-buff 1000 reuse-client false write-timeout 1500 read-timeout 1500} }]
  (let [ write-ch (chan write-buff)
         read-ch (chan read-buff)
         error-ch (chan error-buff)
         g (NioEventLoopGroup.)
         conf {:group g :write-ch write-ch :read-ch read-ch :error-ch error-ch :handlers handlers}
         client (start-client host port conf) ]

    (if (not client)
      (do
        (let [cause (read-error {:error-ch error-ch} 200)]
	        (close-all client)
	        (throw (RuntimeException. "Unable to create client" (first cause))))))

    ;async read off error-ch
    (go
      (loop [local-client client]
        (let [[v o] (<! error-ch)]
          (error "read error from error-ch " v)

          (if (instance? Poison v)
            (if local-client (close-client local-client)) ;poinson pill end loop
          (do
            ;on error, pause writing, and close client
	          (>! write-ch (->Pause 1000))
            (close-client local-client)

           (let [c
                 (loop [acc 0] ;reconnect in loop
				            (if (>= acc retry-limit)
				              (do
                        ;if limit reached send poinson to all channels and call close all on client, end loop
				                (error "Retry limit reached, closing all channels and connections")
				                (go (>! write-ch [(->Poison) nil] ))
				                (go (>! read-ch (->Poison) ))
				                (go (>! error-ch [(->Poison) nil] ))
				                (close-all local-client)
			                  nil
				              )
					            (let [v1
                             (try
									              (let [c (start-client host port conf)
									                    reconnected (->Reconnected c v)]
				                          ;if connected, send Reconnected instance to all channels and return c, this c is assigned to the loop using recur
											                (.getAndIncrement ^AtomicInteger (:reconnect-count c))
											                (>! read-ch reconnected)
											                (>! write-ch reconnected)
									                    c)
									              (catch Exception e (do
									                                   (error (str "Error while doing retry " e) e)
                                                     e ;return exception to v, due to a bug in core async http://dev.clojure.org/jira/browse/ASYNC-48, we cannot recur here
				                                             )))]
                            (if (instance? Exception v1) ;if v is an exception recur
                              (recur (inc acc))
                              v1) ;else return the value (this is c, the connection)
                            )))]

                      (if (and (instance? FailedWrite o) c)
                        (do
                            (info "retry failed write: ")
                            (<! (timeout 500))
                            (>! write-ch (:v o))))

                      (recur c))

	          )))))

     ;async read off write-ch
     (go
	      (loop [local-client client]
           (let [v (<! write-ch)]
		          (if (instance? Stop v) nil ;if stop exit loop
		             (do
                   (try
                      (cond (instance? Reconnected v) (do (recur (:client v))) ;if reconnect recur with the new client
					             (instance? Pause v) (do (<! (timeout (:time v))) (recur local-client)) ;if pause, wait :time millis, then recur loop
					             :else
				                (do ;else write the value to the client channel
                           (if (> (.get ^AtomicInteger (:reconnect-count local-client)) 0) (.set ^AtomicInteger (:reconnect-count local-client) 0))
						               (do-write local-client v false conf)))
							        (catch Exception e (do ;send any exception to the error-ch
								                            (error "!!!!! Error while writing " e)
								                            (go (>! error-ch [e nil]))
                                    )))
                      (if (not (instance? Stop v))
                         (recur local-client)) ;if not stop recur loop
                      )))))

		    client))

fix poison error

fix poison error


(ns sormilla.gui
  (:require [metosin.system :as system]
            [sormilla.world :refer [world]]
            [sormilla.swing :refer [with-transforms] :as swing]
            [sormilla.task :as task])
  (:import [java.awt Graphics2D Canvas Color Toolkit RenderingHints Image]
           [javax.swing JFrame SwingUtilities]))

(set! *warn-on-reflection* true)

(def background-color     (Color.   32   32  32   255))
(def hud-color            (Color.   64  192  64    92))
(def hud-hi-color         (Color.   64  255  64   192))
(def hud-lo-color         (Color.   64  192  64    32))
(def leap-color           (Color.   64  255  64   192))
(def key-color            (Color.   64  128  64    32))
(def telemetry-color      (Color.  255   32  32   255))
(def alt-color            (Color.  255   32  32   192))
(def status-hi-color      (Color.  255  255   0   255))
(def status-lo-color      (Color.  192  192   0   255))

(def quality-colors [(Color.  255   64  64   192)
                     (Color.  255   64  64   192)
                     (Color.  255   64  64   192)
                     (Color.  192   64  64   128)
                     (Color.   64  192  64   128)
                     (Color.   64  192  64   255)])

(defn render [^Graphics2D g ^long w ^long h]
  (let [{:keys [leap telemetry keys intent ^Image image]} @world
        now    (System/currentTimeMillis)
        w2     (/ w 2.0)
        w6     (/ w 6.0)
        h2     (/ h 2.0)
        h6     (/ h 6.0)]

    ; setup
    (.setRenderingHint g RenderingHints/KEY_ANTIALIASING RenderingHints/VALUE_ANTIALIAS_ON)

    ; video feed
    (if image
      (doto g
        (.drawImage image 0 0 nil)
        (.setColor (Color. 0 0 0 96))
        (.fillRect 0 0 w h))
      (doto g
        (.setColor background-color)
        (.fillRect 0 0 w h)
        (.setColor Color/WHITE)
        (.drawString "no image feed" 25 75)))

    ; emergency background
    (when (= (:control-state telemetry) :emergency)
      (.setColor g (if (< (mod (System/currentTimeMillis) 400) 200) (Color. 128 16 16) (Color. 192 16 16)))
      (.fillRect g 0 0 w h))

    ; status
    (let [{:keys [control-state battery-percent]} telemetry
          {:keys [intent-state]} intent]
      (.setColor g status-lo-color)
      (.drawString g (str "trgt: " (name (or intent-state :init))) 10 20)
      (.setColor g (if (= control-state intent-state) status-lo-color status-hi-color))
      (.drawString g (str "stat: " (name (or control-state :init))) 10 35)
      (.setColor g status-lo-color)
      (.drawString g (str " bat: " battery-percent "%") 10 50))

    ; keys:
    (.setColor g key-color)
    (let [{:keys [left right up down space]} keys]
      (when left   (.fill g (swing/->shape w6 h2 (* 2 w6) (* 2 h6) (* 2 w6) (* 4 h6))))
      (when right  (.fill g (swing/->shape (* 5 w6) h2 (* 4 w6) (* 2 h6) (* 4 w6) (* 4 h6))))
      (when up     (.fill g (swing/->shape w2 h6 (* 4 w6) (* 2 h6) (* 2 w6) (* 2 h6))))
      (when down   (.fill g (swing/->shape w2 (* 5 h6) (* 4 w6) (* 4 h6) (* 2 w6) (* 4 h6))))
      (when space  (.fill g (swing/->shape 50 (- h 40) (- w 50) (- h 40) (- w 50) (- h 10) 50 (- h 10)))))

    ; draw grid
    ;(.setColor g hud-lo-color)
    ;(doseq [x (range (/ w 10) w (/ w 10))] (.drawLine g x 0 x h))
    ;(doseq [y (range (/ h 10) h (/ h 10))] (.drawLine g 0 y w y))

    ; draw zero axis
    (.setColor g hud-color)
    (.drawLine g w2 0 w2 h)
    (.drawLine g 0 h2 w h2)
    (doseq [x (range (/ w 50) w (/ w 50))] (.drawLine g x (- h2 5) x (+ h2 5)))
    (doseq [y (range (/ h 50) h (/ h 50))] (.drawLine g (- w2 5) y (+ w2 5) y))

    ; draw "aim"
    (when leap
      ; draw quality boxes
      (let [quality (:quality leap)]
        (.setColor g (nth quality-colors quality))
        (doseq [y (range 5)]
          (when (>= y quality) (.setColor g hud-lo-color))
          (.fillRect g 5 (- h (* y 10) 10) 30 5)))
      (let [pitch  (* (:pitch leap) (/ h2 100.0) -1.0)
            yaw    (* (:yaw leap) (/ w2 100.0))
            roll   (:roll leap)
            aim-w  (/ w 2.0)
            aim-h  (/ h 10.0)
            aim-x  (/ aim-w -2.0)
            aim-y  (/ aim-h -2.0)]
        (with-transforms g
          (.translate g (+ w2 yaw) (+ h2 pitch))
          (.rotate g roll)
          (.setColor g leap-color)
          (.fillOval g aim-x aim-y aim-w aim-h)
          (.drawOval g aim-x aim-y aim-w aim-h)
          (.drawLine g -2000 0 2000 0)
          (.drawLine g 0 -2000 0 2000))))

    ; draw telemetry
    (let [{:keys [pitch roll alt]} telemetry]
      (when (and pitch roll alt)
        (with-transforms g
          (.setColor g telemetry-color)
          (.translate g w2 (+ h2 (* h2 (/ pitch (/ Math/PI 4.0)))))
          (.rotate g roll)
          (swing/draw-circle g w6 0 20)
          (swing/draw-circle g (- w6) 0 20)
          (.drawLine g w6 0 (- w6) 0))
        (let [alt-box (* h (/ alt 3000.0))]
          (.setColor g alt-color)
          (.fillRect g (- w 40) (- h alt-box) 40 alt-box))))))

;;
;; Frame:
;;

(defprotocol IFrame
  (paint [this renderer])
  (close [this]))

(defrecord Frame [^JFrame frame ^Canvas canvas]
  IFrame
  (paint [this renderer]
    (let [strategy (.getBufferStrategy canvas)
          g (.getDrawGraphics strategy)]
      (try
        (renderer g (.getWidth canvas) (.getHeight canvas))
        (.show strategy)
        (finally
          (.dispose g)))))
  (close [this]
    (SwingUtilities/invokeLater
      (fn [] (.setVisible frame false)))))

(defn ^IFrame make-frame [& {:keys [max-size top exit-on-close]}]
  (let [frame (JFrame.)
        canvas (Canvas.)]
    (.setIgnoreRepaint frame true)
    (.setIgnoreRepaint canvas true)
    (.add frame canvas)
    (.setSize canvas 672 418)
    (.pack frame)
    (let [screen-size (.getScreenSize (Toolkit/getDefaultToolkit))]
      (.setLocation frame (- (.width screen-size) 672) 0))
    (when max-size
      (.setExtendedState frame JFrame/MAXIMIZED_BOTH))
    (when top
      (.setAlwaysOnTop frame true))
    (when exit-on-close
      (.setDefaultCloseOperation frame JFrame/EXIT_ON_CLOSE))
    (.setVisible frame true)
    (.createBufferStrategy canvas 2)
    (->Frame frame canvas)))

;;
;; =================================================================================
;; Lifecycle:
;; =================================================================================
;;

(def service (reify
               system/Service
               (start! [this config]
                 (let [frame (make-frame :top true)
                       task  (task/schedule :gui 50 paint frame render)]
                   (future
                     (try
                       (deref task)
                       (catch Exception _))
                     (close frame)))
                 config)
               (stop! [this config]
                 (task/cancel :gui)
                 config)))

(ns sormilla.gui
  (:require [metosin.system :as system]
            [sormilla.world :refer [world]]
            [sormilla.swing :refer [with-transforms] :as swing]
            [sormilla.task :as task])
  (:import [java.awt Graphics2D Canvas Color Toolkit RenderingHints Image]
           [javax.swing JFrame SwingUtilities]))

(set! *warn-on-reflection* true)

(def background-color     (Color.   32   32  32   255))
(def hud-color            (Color.   64  192  64    92))
(def hud-hi-color         (Color.   64  255  64   192))
(def hud-lo-color         (Color.   64  192  64    32))
(def leap-color           (Color.   64  255  64   192))
(def key-color            (Color.   64  128  64    32))
(def telemetry-color      (Color.  255   32  32   255))
(def alt-color            (Color.  255   32  32   192))
(def status-hi-color      (Color.  255  255   0   255))
(def status-lo-color      (Color.  192  192   0   255))

(def quality-colors [(Color.  255   64  64   192)
                     (Color.  255   64  64   192)
                     (Color.  255   64  64   192)
                     (Color.  192   64  64   128)
                     (Color.   64  192  64   128)
                     (Color.   64  192  64   255)])

(defn render [^Graphics2D g ^long w ^long h]
  (let [{:keys [leap telemetry keys intent ^Image image]} @world
        now    (System/currentTimeMillis)
        w2     (/ w 2.0)
        w6     (/ w 6.0)
        h2     (/ h 2.0)
        h6     (/ h 6.0)]

    ; setup
    (.setRenderingHint g RenderingHints/KEY_ANTIALIASING RenderingHints/VALUE_ANTIALIAS_ON)

    ; video feed
    (if image
      (doto g
        (.drawImage image 0 0 w h 0 0 (.getWidth image nil) (.getHeight image nil) nil)
        (.setColor (Color. 0 0 0 96))
        (.fillRect 0 0 w h))
      (doto g
        (.setColor background-color)
        (.fillRect 0 0 w h)
        (.setColor Color/WHITE)
        (.drawString "no image feed" 25 75)))

    ; emergency background
    (when (= (:control-state telemetry) :emergency)
      (.setColor g (if (< (mod (System/currentTimeMillis) 400) 200) (Color. 128 16 16) (Color. 192 16 16)))
      (.fillRect g 0 0 w h))

    ; status
    (let [{:keys [control-state battery-percent]} telemetry
          {:keys [intent-state]} intent]
      (.setColor g status-lo-color)
      (.drawString g (str "trgt: " (name (or intent-state :init))) 10 20)
      (.setColor g (if (= control-state intent-state) status-lo-color status-hi-color))
      (.drawString g (str "stat: " (name (or control-state :init))) 10 35)
      (.setColor g status-lo-color)
      (.drawString g (str " bat: " battery-percent "%") 10 50))

    ; keys:
    (.setColor g key-color)
    (let [{:keys [left right up down space]} keys]
      (when left   (.fill g (swing/->shape w6 h2 (* 2 w6) (* 2 h6) (* 2 w6) (* 4 h6))))
      (when right  (.fill g (swing/->shape (* 5 w6) h2 (* 4 w6) (* 2 h6) (* 4 w6) (* 4 h6))))
      (when up     (.fill g (swing/->shape w2 h6 (* 4 w6) (* 2 h6) (* 2 w6) (* 2 h6))))
      (when down   (.fill g (swing/->shape w2 (* 5 h6) (* 4 w6) (* 4 h6) (* 2 w6) (* 4 h6))))
      (when space  (.fill g (swing/->shape 50 (- h 40) (- w 50) (- h 40) (- w 50) (- h 10) 50 (- h 10)))))

    ; draw grid
    ;(.setColor g hud-lo-color)
    ;(doseq [x (range (/ w 10) w (/ w 10))] (.drawLine g x 0 x h))
    ;(doseq [y (range (/ h 10) h (/ h 10))] (.drawLine g 0 y w y))

    ; draw zero axis
    (.setColor g hud-color)
    (.drawLine g w2 0 w2 h)
    (.drawLine g 0 h2 w h2)
    (doseq [x (range (/ w 50) w (/ w 50))] (.drawLine g x (- h2 5) x (+ h2 5)))
    (doseq [y (range (/ h 50) h (/ h 50))] (.drawLine g (- w2 5) y (+ w2 5) y))

    ; draw "aim"
    (when leap
      ; draw quality boxes
      (let [quality (:quality leap)]
        (.setColor g (nth quality-colors quality))
        (doseq [y (range 5)]
          (when (>= y quality) (.setColor g hud-lo-color))
          (.fillRect g 5 (- h (* y 10) 10) 30 5)))
      (let [pitch  (* (:pitch leap) (/ h2 100.0) -1.0)
            yaw    (* (:yaw leap) (/ w2 100.0))
            roll   (:roll leap)
            aim-w  (/ w 2.0)
            aim-h  (/ h 10.0)
            aim-x  (/ aim-w -2.0)
            aim-y  (/ aim-h -2.0)]
        (with-transforms g
          (.translate g (+ w2 yaw) (+ h2 pitch))
          (.rotate g roll)
          (.setColor g leap-color)
          (.fillOval g aim-x aim-y aim-w aim-h)
          (.drawOval g aim-x aim-y aim-w aim-h)
          (.drawLine g -2000 0 2000 0)
          (.drawLine g 0 -2000 0 2000))))

    ; draw telemetry
    (let [{:keys [pitch roll alt]} telemetry]
      (when (and pitch roll alt)
        (with-transforms g
          (.setColor g telemetry-color)
          (.translate g w2 (+ h2 (* h2 (/ pitch (/ Math/PI 4.0)))))
          (.rotate g roll)
          (swing/draw-circle g w6 0 20)
          (swing/draw-circle g (- w6) 0 20)
          (.drawLine g w6 0 (- w6) 0))
        (let [alt-box (* h (/ alt 3000.0))]
          (.setColor g alt-color)
          (.fillRect g (- w 40) (- h alt-box) 40 alt-box))))))

;;
;; Frame:
;;

(defprotocol IFrame
  (paint [this renderer])
  (close [this]))

(defrecord Frame [^JFrame frame ^Canvas canvas]
  IFrame
  (paint [this renderer]
    (let [strategy (.getBufferStrategy canvas)
          g (.getDrawGraphics strategy)]
      (try
        (renderer g (.getWidth canvas) (.getHeight canvas))
        (.show strategy)
        (finally
          (.dispose g)))))
  (close [this]
    (SwingUtilities/invokeLater
      (fn [] (.setVisible frame false)))))

(defn ^IFrame make-frame [& {:keys [max-size top exit-on-close]}]
  (let [frame (JFrame.)
        canvas (Canvas.)]
    (.setIgnoreRepaint frame true)
    (.setIgnoreRepaint canvas true)
    (.add frame canvas)
    (.setSize canvas 672 418)
    (.pack frame)
    (let [screen-size (.getScreenSize (Toolkit/getDefaultToolkit))]
      (.setLocation frame (- (.width screen-size) 672) 0))
    (when max-size
      (.setExtendedState frame JFrame/MAXIMIZED_BOTH))
    (when top
      (.setAlwaysOnTop frame true))
    (when exit-on-close
      (.setDefaultCloseOperation frame JFrame/EXIT_ON_CLOSE))
    (.setVisible frame true)
    (.createBufferStrategy canvas 2)
    (->Frame frame canvas)))

;;
;; =================================================================================
;; Lifecycle:
;; =================================================================================
;;

(def service (reify
               system/Service
               (start! [this config]
                 (let [frame (make-frame :top true)
                       task  (task/schedule :gui 50 paint frame render)]
                   (future
                     (try
                       (deref task)
                       (catch Exception _))
                     (close frame)))
                 config)
               (stop! [this config]
                 (task/cancel :gui)
                 config)))

scale image with frame

scale image with frame


(ns vigil.heroku)

(defn convert-database-url [db-url]
  (let [[_ user password host port db] (re-matches #"postgres://(?:(.+):(.*)@)?([^:]+)(?::(\d+))?/(.+)" db-url)]
    {
      :user user
      :password password
      :host host
      :port (or port 80)
      :db db
    }))

(ns vigil.heroku)

(defn convert-database-url [db-url]
  "Turn a database URL into a JDBC-style connection spec. Heroku likes its DB
  specs as URL strings stored in environment variables, so that's how we'll do
  it."
  (let [[_ user password host port db] (re-matches #"postgres://(?:(.+):(.*)@)?([^:]+)(?::(\d+))?/(.+)" db-url)]
    {
      :user user
      :password password
      :host host
      :port (or port 80)
      :db db
    }))

document convert-database-url

document convert-database-url


{:leiningen {:name "Leiningen"
             :url "http://github.com/technomancy/leiningen"
             :description "A build tool for Clojure designed not to set your hair on fire."}

 :clojure-mode {:name "Clojure Mode"
                :url "http://github.com/technomancy/clojure-mode"
                :description "Emacs support for editing Clojure files."}

 :swank-clojure {:name "Swank Clojure"
                 :url "http://github.com/technomancy/swank-clojure"
                 :description "A SLIME adapter for communicating with Clojure subprocesses from Emacs."}

 :clojure-gem {:name "Clojure Gem"
               :url "http://github.com/technomancy/clojure-gem"
               :description "An adapter for using Clojure's immutable data structures and software transactional memory from JRuby."}

 :clojure-http-client {:name "Clojure HTTP Client"
                       :url "http://github.com/technomancy/clojure-http-client"
                       :description "What it says on the box."}
 :mire {:name "Mire"
        :url "http://github.com/technomancy/mire"
        :description "A multiplayer text adventure and learning project."}

 :clj-kdtree {:name "clj-kdtree"
              :url "http://github.com/abscondment/clj-kdtree"
              :description "kd-trees in Clojure."}

 :clojurebot {:name "clojurebot"
              :url "http://github.com/hiredman/clojurebot"
              :description "irc bot for #clojure"}

 :Repl {:name "Repl"
        :url "http://github.com/hiredman/Repl"
        :description "Gui repl"}

 :clojure-dependency-grapher
 {:name "clojure-dependency-grapher"
  :url "http://github.com/hiredman/clojure-dependency-grapher"
  :description "generate dot (graphviz) files describing dependencies"}

 :serializable-fn
 {:name "Serializable Fn"
  :url "http://github.com/technomancy/serializable-fn"
  :description "Make your functions print prettily!"}

 :robert-hooke
 {:name "Robert Hooke"
  :url "http://github.com/technomancy/robert-hooke"
  :description "A generalized function extensibility mechanism for plugins."}

 :amontillado
 {:name "Amontillado"
  :url "http://github.com/hiredman/Amontillado"
  :description "bitcask inspired storage for clojure"}

 :cellar
 {:name "cellar"
  :url "http://github.com/hiredman/cellar"
  :description "an abstraction over key value stores"}

 :Arkham
 {:name "Arkham"
  :url "http://github.com/hiredman/Arkham"
  :description "a lisp interpreter"}

 :graft
 {:name "graft"
  :url "http://github.com/hiredman/graft"
  :description "translate uris to functions for ring"}

 :chinese-democracy
 {:name "Chinese Democracy"
  :url "http://github.com/hiredman/chinese-democracy"
  :description "Master^H^H^H^H^H^HChairman Election"}

 :cabeza-de-vaca
 {:name "Cabeza de Vaca"
  :url "http://github.com/Seajure/cabeza-de-vaca"
  :description "Embark on a voyage of discovery… Local network discovery."}
 :radagast
 {:name "Radagast"
  :url "http://github.com/Seajure/radagast"
  :description "Simplistic test coverage"}

 :reducate
 {:name "Reducate"
  :url "http://github.com/Seajure/reducate"
  :description "A reduce-like macro."}}

{:leiningen {:name "Leiningen"
             :url "https://github.com/technomancy/leiningen"
             :description "A build tool for Clojure designed not to set your hair on fire."}

 :clojure-mode {:name "Clojure Mode"
                :url "https://github.com/technomancy/clojure-mode"
                :description "Emacs support for editing Clojure files."}

 :swank-clojure {:name "Swank Clojure"
                 :url "https://github.com/technomancy/swank-clojure"
                 :description "A SLIME adapter for communicating with Clojure subprocesses from Emacs."}

 :clojure-gem {:name "Clojure Gem"
               :url "https://github.com/technomancy/clojure-gem"
               :description "An adapter for using Clojure's immutable data structures and software transactional memory from JRuby."}

 :clojure-http-client {:name "Clojure HTTP Client"
                       :url "https://github.com/technomancy/clojure-http-client"
                       :description "What it says on the box."}
 :mire {:name "Mire"
        :url "https://github.com/technomancy/mire"
        :description "A multiplayer text adventure and learning project."}

 :clj-kdtree {:name "clj-kdtree"
              :url "https://github.com/abscondment/clj-kdtree"
              :description "kd-trees in Clojure."}

 :clojurebot {:name "clojurebot"
              :url "https://github.com/hiredman/clojurebot"
              :description "irc bot for #clojure"}

 :Repl {:name "Repl"
        :url "https://github.com/hiredman/Repl"
        :description "Gui repl"}

 :clojure-dependency-grapher
 {:name "clojure-dependency-grapher"
  :url "https://github.com/hiredman/clojure-dependency-grapher"
  :description "generate dot (graphviz) files describing dependencies"}

 :serializable-fn
 {:name "Serializable Fn"
  :url "https://github.com/technomancy/serializable-fn"
  :description "Make your functions print prettily!"}

 :robert-hooke
 {:name "Robert Hooke"
  :url "https://github.com/technomancy/robert-hooke"
  :description "A generalized function extensibility mechanism for plugins."}

 :amontillado
 {:name "Amontillado"
  :url "https://github.com/hiredman/Amontillado"
  :description "bitcask inspired storage for clojure"}

 :cellar
 {:name "cellar"
  :url "https://github.com/hiredman/cellar"
  :description "an abstraction over key value stores"}

 :Arkham
 {:name "Arkham"
  :url "https://github.com/hiredman/Arkham"
  :description "a lisp interpreter"}

 :graft
 {:name "graft"
  :url "https://github.com/hiredman/graft"
  :description "translate uris to functions for ring"}

 :chinese-democracy
 {:name "Chinese Democracy"
  :url "https://github.com/hiredman/chinese-democracy"
  :description "Master^H^H^H^H^H^HChairman Election"}

 :cabeza-de-vaca
 {:name "Cabeza de Vaca"
  :url "https://github.com/Seajure/cabeza-de-vaca"
  :description "Embark on a voyage of discovery… Local network discovery."}

 :radagast
 {:name "Radagast"
  :url "https://github.com/Seajure/radagast"
  :description "Simplistic test coverage"}

 :reducate
 {:name "Reducate"
  :url "https://github.com/Seajure/reducate"
  :description "A reduce-like macro."}}

Switch to https github URLs.

Switch to https github URLs.


(set-env!
  :source-paths #{"src"}
  :resource-paths #{"resources"}
  :dependencies '[[hiccup "1.0.5"]
                  [perun "0.4.2-SNAPSHOT"]
                  [confetti "0.1.2-SNAPSHOT"]
                  [deraen/boot-sass "0.2.1"]
                  [org.slf4j/slf4j-nop "1.7.13" :scope "test"]
                  [pandeiro/boot-http "0.7.3"]
                  [org.martinklepsch/boot-gzip "0.1.1"]])

(require '[io.perun :refer :all]
         '[deraen.boot-sass :refer [sass]]
         '[pandeiro.boot-http :refer [serve]]
         '[confetti.boot-confetti :refer [create-site sync-bucket]]
         '[org.martinklepsch.boot-gzip :refer [gzip]])

(task-options!
  pom {:project 'perun.io :version "0.2.0"})

(deftask build
  "Build dev version"
  []
  (let [guide? (fn [e] (= "guide" (:type e)))]
    (comp (sass)
          (global-metadata)
          (markdown :options {:extensions {:smarts true}})
          (slug
            :slug-fn (fn [_ m]
              (:short-filename m)
              )
            )
          (permalink)
          (print-meta)
          (render :renderer 'io.perun.site/guide-page :filterer guide?)
          (collection :renderer 'io.perun.site/render :page "index.html")
          (collection :renderer 'io.perun.site/guides :page "guides/index.html" :filterer guide?))))

(deftask dev
  []
  (comp (watch)
        (build)
        (target)
        (serve :resource-root "public")
        ))

;(def c (-> "perun-martinklepsch-org.confetti.edn" slurp read-string))

; (deftask deploy []
;   (comp (build)
;         (sift :include #{#"^public/.+"})
;         (sift :move {#"^public/" ""})
;         (sync-bucket :access-key (:access-key c)
;                      :secret-key (:secret-key c)
;                      :bucket (:bucket-name c)
;                      :cloudfront-id (:cloudfront-id c))))

(set-env!
  :source-paths #{"src"}
  :resource-paths #{"resources"}
  :dependencies '[[hiccup "1.0.5"]
                  [perun "0.4.2-SNAPSHOT"]
                  [confetti "0.1.2-SNAPSHOT"]
                  [hashobject/boot-s3 "0.1.2-SNAPSHOT"]
                  [deraen/boot-sass "0.2.1"]
                  [org.slf4j/slf4j-nop "1.7.13" :scope "test"]
                  [pandeiro/boot-http "0.7.3"]
                  [org.martinklepsch/boot-gzip "0.1.1"]])

(require '[io.perun :refer :all]
         '[deraen.boot-sass :refer [sass]]
         '[pandeiro.boot-http :refer [serve]]
         '[confetti.boot-confetti :refer [create-site sync-bucket]]
         '[hashobject.boot-s3 :refer :all]
         '[org.martinklepsch.boot-gzip :refer [gzip]])

(task-options!
  pom {:project 'perun.io :version "0.2.0"}
  s3-sync {
    :bucket "perun.io"
    :access-key (System/getenv "AWS_ACCESS_KEY")
    :secret-key (System/getenv "AWS_SECRET_KEY")
    :source "public"
    :options {"Cache-Control" "max-age=315360000, no-transform, public"}})

(deftask build
  "Build dev version"
  []
  (let [guide? (fn [e] (= "guide" (:type e)))]
    (comp (sass)
          (global-metadata)
          (markdown :options {:extensions {:smarts true}})
          (slug
            :slug-fn (fn [_ m]
              (:short-filename m)))
          (permalink)
          (print-meta)
          (render :renderer 'io.perun.site/guide-page :filterer guide?)
          (collection :renderer 'io.perun.site/render :page "index.html")
          (collection :renderer 'io.perun.site/guides :page "guides/index.html" :filterer guide?))))

(deftask dev
  []
  (comp (watch)
        (build)
        (serve :resource-root "public")
        ))

(deftask deploy []
  (comp (build)
        (target)
        (s3-sync)))

change deploy

change deploy


#!/usr/bin/env boot

(set-env!
 :resource-paths #{"resources" "src/main" "src/docs"}
 :dependencies '[;; Boot setup
                 [adzerk/boot-cljs "1.7.228-1"]
                 [adzerk/boot-reload "0.4.12"]
                 [adzerk/boot-test "1.1.2"]
                 [adzerk/bootlaces "0.1.13"]
                 [boot-codox "0.10.0" :scope "test"]
                 [pandeiro/boot-http "0.7.3"]
                 [crisptrutski/boot-cljs-test "0.2.1"]
                 [com.cemerick/piggieback "0.2.1"
                  :exclusions [com.google.guava/guava]]

                 ;; Testing
                 [org.clojure/test.check "0.9.0" :scope "test"]

                 ;; Library dependencies
                 [bidi "2.0.10"]
                 [com.datomic/datomic-free "0.9.5394" :scope "test"
                  :exclusions [com.google.guava/guava]]
                 [com.stuartsierra/component "0.3.1"]
                 [datomic-schema "1.3.0"]
                 [inflections "0.12.2"]
                 [org.clojure/clojure "1.9.0-alpha11"]
                 [org.clojure/clojurescript "1.9.229"]
                 [org.omcljs/om "1.0.0-alpha45"]
                 [org.clojure/data.json "0.2.6"]

                 ;; Development dependencies
                 [devcards "0.2.1-7"]
                 [datascript "0.15.3"]])

(require '[adzerk.boot-cljs :refer [cljs]]
         '[adzerk.boot-reload :refer [reload]]
         '[adzerk.boot-test :refer :all]
         '[adzerk.bootlaces :refer :all]
         '[boot.git :refer [last-commit]]
         '[codox.boot :refer [codox]]
         '[crisptrutski.boot-cljs-test :refer [test-cljs exit!]]
         '[pandeiro.boot-http :refer [serve]])

(def version "0.2.14")

(bootlaces! version :dont-modify-paths? true)

(task-options!
 test-cljs {:js-env :phantom
            :update-fs? true
            :optimizations :none}
 push      {:repo "deploy-clojars"
            :ensure-branch "master"
            :ensure-clean true
            :ensure-tag (last-commit)
            :ensure-version version}
 pom       {:project 'workflo/macros
            :version version
            :description "Clojure macros for web and mobile development"
            :url "https://github.com/workfloapp/macros"
            :scm {:url "https://github.com/workfloapp/macros"}
            :license {"MIT License"
                      "https://opensource.org/licenses/MIT"}}
 repl      {:middleware '[cemerick.piggieback/wrap-cljs-repl]})

(deftask examples
  []
  (merge-env! :source-paths #{"src/examples"})
  identity)

(deftask build-dev
  []
  (comp
    (cljs :source-map true
          :optimizations :none
          :compiler-options {:devcards true
                             :parallel-build true})))

(deftask dev
  []
  (comp
    (examples)
    (watch)
    (reload :on-jsload 'workflo.macros.examples.screen-app/reload)
    (build-dev)
    (target)
    (serve :dir "target")
    (repl :server true)))

(deftask testing
  []
  (merge-env! :source-paths #{"src/test"})
  identity)

(deftask docs
  []
  (comp
   (codox :name "workflo/macros"
          :source-paths #{"src/main"}
          :output-path "api-docs"
          :metadata {:doc/format :markdown})
   (target)))

(deftask test-once
  []
  (comp
    (testing)
    (test-cljs)
    (test)
    (exit!)))

(deftask test-auto
  []
  (comp
    (testing)
    (watch)
    (test-cljs)
    (test)))

(deftask install-local
  []
  (comp
    (pom)
    (jar)
    (install)))

(deftask deploy-snapshot
  []
  (comp
    (pom)
    (jar)
    (build-jar)
    (target)
    (push-snapshot)))

(deftask deploy-release
  []
  (comp
    (pom)
    (jar)
    (build-jar)
    (target)
    (push-release)))

#!/usr/bin/env boot

(set-env!
 :resource-paths #{"resources" "src/main" "src/docs"}
 :dependencies '[;; Boot setup
                 [adzerk/boot-cljs "1.7.228-1"]
                 [adzerk/boot-reload "0.4.12"]
                 [adzerk/boot-test "1.1.2"]
                 [adzerk/bootlaces "0.1.13"]
                 [boot-codox "0.10.0" :scope "test"]
                 [pandeiro/boot-http "0.7.3"]
                 [crisptrutski/boot-cljs-test "0.2.1"]
                 [com.cemerick/piggieback "0.2.1"
                  :exclusions [com.google.guava/guava]]

                 ;; Testing
                 [org.clojure/test.check "0.9.0" :scope "test"]

                 ;; Library dependencies
                 [bidi "2.0.10"]
                 [com.datomic/datomic-free "0.9.5394" :scope "test"
                  :exclusions [com.google.guava/guava]]
                 [com.stuartsierra/component "0.3.1"]
                 [datomic-schema "1.3.0"]
                 [inflections "0.12.2"]
                 [org.clojure/clojure "1.9.0-alpha11"]
                 [org.clojure/clojurescript "1.9.229"]
                 [org.omcljs/om "1.0.0-alpha45"]
                 [org.clojure/data.json "0.2.6"]

                 ;; Development dependencies
                 [devcards "0.2.1-7"]
                 [datascript "0.15.3"]])

(require '[adzerk.boot-cljs :refer [cljs]]
         '[adzerk.boot-reload :refer [reload]]
         '[adzerk.boot-test :refer :all]
         '[adzerk.bootlaces :refer :all]
         '[boot.git :refer [last-commit]]
         '[codox.boot :refer [codox]]
         '[crisptrutski.boot-cljs-test :refer [test-cljs exit!]]
         '[pandeiro.boot-http :refer [serve]])

(def version "0.2.14")

(bootlaces! version :dont-modify-paths? true)

(task-options!
 test-cljs {:js-env :phantom
            :update-fs? true
            :optimizations :none}
 push      {:repo "deploy-clojars"
            :ensure-branch "master"
            :ensure-clean true
            :ensure-tag (last-commit)
            :ensure-version version}
 pom       {:project 'workflo/macros
            :version version
            :description "Clojure macros for web and mobile development"
            :url "https://github.com/workfloapp/macros"
            :scm {:url "https://github.com/workfloapp/macros"}
            :license {"MIT License"
                      "https://opensource.org/licenses/MIT"}}
 repl      {:middleware '[cemerick.piggieback/wrap-cljs-repl]})

(deftask examples
  []
  (merge-env! :source-paths #{"src/examples"})
  identity)

(deftask build-dev
  []
  (comp
    (cljs :source-map true
          :optimizations :none
          :compiler-options {:devcards true
                             :parallel-build true})))

(deftask build-production
  []
  (comp
   (cljs :optimizations :advanced
         :compiler-options {:devcards true
                            :parallel-build true})))

(deftask dev
  []
  (comp
    (examples)
    (watch)
    (reload :on-jsload 'workflo.macros.examples.screen-app/reload)
    (build-dev)
    (target)
    (serve :dir "target")
    (repl :server true)))

(deftask production
  []
  (comp
   (examples)
   (watch)
   (build-production)
   (serve)))

(deftask testing
  []
  (merge-env! :source-paths #{"src/test"})
  identity)

(deftask docs
  []
  (comp
   (codox :name "workflo/macros"
          :source-paths #{"src/main"}
          :output-path "api-docs"
          :metadata {:doc/format :markdown})
   (target)))

(deftask test-once
  []
  (comp
    (testing)
    (test-cljs)
    (test)
    (exit!)))

(deftask test-auto
  []
  (comp
    (testing)
    (watch)
    (test-cljs)
    (test)))

(deftask install-local
  []
  (comp
    (pom)
    (jar)
    (install)))

(deftask deploy-snapshot
  []
  (comp
    (pom)
    (jar)
    (build-jar)
    (target)
    (push-snapshot)))

(deftask deploy-release
  []
  (comp
    (pom)
    (jar)
    (build-jar)
    (target)
    (push-release)))

Add a boot production task for and testing advanced optimizations


(set-env!
  :resource-paths #{"src/cljc"}
  :dependencies   '[[org.clojure/clojure         "1.9.0-alpha14"]
                    [org.clojure/clojurescript   "1.9.456"]

                    [adzerk/boot-test            "1.2.0"     :scope "test"]
                    [pandeiro/boot-http          "0.7.6"     :scope "test"]
                    [adzerk/boot-reload          "0.5.1"     :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"]
                    [boot-codox                  "0.10.3"    :scope "test"]

                    [me.raynes/conch             "0.8.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"]
                    [viebel/codox-klipse-theme   "0.0.4"     :scope "test"]])

(task-options!
  pom {:project 'moxaj/mikron
       :version "0.5.0"})

(require '[clojure.java.io :as io]
         '[clojure.pprint :as pprint]
         '[clojure.string :as string]

         '[boot.util :as util]
         '[adzerk.boot-test :as boot-test]
         '[pandeiro.boot-http :as boot-http]
         '[adzerk.boot-reload :as boot-reload]
         '[adzerk.boot-cljs :as boot-cljs]
         '[adzerk.boot-cljs-repl :as boot-cljs-repl]
         '[crisptrutski.boot-cljs-test :as boot-cljs-test]
         '[me.raynes.conch.low-level :as conch]
         '[codox.boot :as boot-codox]

         '[mikron.core :as mikron])

;; Util

(def windows?
  (.. (System/getProperty "os.name") (toLowerCase) (startsWith "windows")))

(defn fix-slashes
  [^String s]
  (if windows?
    (.replaceAll s "/" "\\\\")
    s))

(defn host-process
  "Connects the stdin and stdout to a process."
  [process]
  (future (conch/feed-from process System/in))
  (future (while true (conch/flush process) (Thread/sleep 100)))
  (conch/stream-to-out process :out))

;; Tasks

(deftask build
  "Builds the project."
  []
  (comp (pom)
        (jar)
        (install)))

(deftask testing
  "Adds the test files to the fileset."
  []
  (merge-env! :resource-paths #{"test/cljc" "test/cljs" "resources/test"})
  identity)

(deftask benchmarking
  "Adds the benchmark files to the fileset."
  []
  (merge-env! :resource-paths #{"benchmark/cljc" "benchmark/java" "resources/benchmark"}
              :dependencies   '[[com.cognitect/transit-clj "0.8.297"]
                                [com.cognitect/transit-cljs "0.8.239"]
                                [com.damballa/abracad "0.4.13"]
                                [gloss "0.2.6"]
                                [cheshire "5.7.0"]
                                [funcool/octet "1.0.1"]
                                [com.google.protobuf/protobuf-java "3.2.0"]
                                [com.taoensso/nippy "2.12.2"]
                                [criterium "0.4.4"]
                                [proto-repl-charts "0.3.2"]])
  identity)

(deftask benchmark-clj
  "Runs the benchmarks on JVM."
  [s stats  VAL #{kw} "The stat(s) to measure."
   S schema VAL kw    "The schema to benchmark. One of #{:doubles :quartet :snapshot :snapshot2}"]
  (let [stats  (or stats (do (util/info "No :stats specified, using [:pack-time :unpack-time].\n")
                             [:pack-time :unpack-time]))
        schema (keyword "mikron.benchmark.schema"
                        (name (or schema (do (util/info "No :schema specified, using :snapshot.\n")
                                             :snapshot))))
        tmp    (tmp-dir!)]
    (comp (benchmarking)
          (javac)
          (with-pre-wrap fileset
            (let [in-file (->> (output-files fileset) (by-name ["results.edn"]) (first))]
              (spit (io/file tmp (tmp-path in-file))
                    (str (slurp (tmp-file in-file))
                         "\r\n\r\n"
                         "Stats: " (vec stats) "\r\n"
                         "Schema: " schema "\r\n"
                         (do (require '[mikron.benchmark.core :as benchmark])
                             (let [results ((resolve 'benchmark/benchmark) :stats stats :schema schema)]
                               (with-out-str (pprint/pprint results))))))
              (-> fileset
                  (add-resource tmp)
                  (commit!))))
          (sift :move {#"results.edn" "../resources/benchmark/results.edn"})
          (target))))

(deftask test-clj
  "Runs the tests on JVM."
  []
  (comp (testing)
        (boot-test/test)))

(deftask test-node
  "Runs the tests in a Node.js environment."
  [o opt          VAL kw   "The optimization level for the cljs compiler."
   s self-hosted?     bool "True if self-hosted."]
  (comp (testing)
        (if self-hosted?
          (comp (target)
                (with-pass-thru _
                  (host-process
                    (conch/proc
                      "lumo"
                      "-c" (System/getProperty "fake.class.path")
                      "-k" "lumo_cache"
                      "target/mikron/node.cljs"))))
          (boot-cljs-test/test-cljs :js-env        :node
                                    :namespaces    '[mikron.test]
                                    :optimizations (or opt :none)))))

(deftask test-browser
  "Runs the tests in a browser environment."
  [o opt    VAL kw   "The optimization level for the cljs compiler."
   e js-env VAL kw "The js environment."]
  (comp (testing)
        (boot-cljs-test/test-cljs :js-env        js-env
                                  :namespaces    '[mikron.test]
                                  :optimizations (or opt :none))))

(deftask test
  "Runs the specified tests."
  [p platform     VAL kw   "The platform to run on."
   t target       VAL kw   "The target for the cljs compiler."
   o opt          VAL kw   "The optimization level for the cljs compiler."
   s self-hosted?     bool "True if self-hosted."]
  (comp (testing)
        (case platform
          :clj  (test-clj)
          :cljs (case target
                  :nodejs  (test-node :opt          opt
                                      :self-hosted? self-hosted?)
                  :browser (test-browser :opt    opt
                                         :js-env :slimer)))))

(deftask compile-cljs
  "Compiles the cljs source files."
  [o opt VAL kw  "The compiler optimization level."
   i id  VAL str "The id of the build."]
  (boot-cljs/cljs
    :ids              (when id [(fix-slashes id)])
    :compiler-options {:static-fns     true
                       :optimizations  (or opt :none)
                       :parallel-build false
                       :infer-externs  false}))

(deftask run-browser-repl
  "Compiles the cljs sources, serves them on localhost:3000, and sets up
   an nrepl listener.
   Terminal A
     - boot run-browser-repl
   Terminal B
     - boot repl -c
     - (boot-cljs-repl/start-repl)
   localhost:3000"
  [o opt VAL kw  "The compiler optimization level."]
  (comp (benchmarking)
        (testing)
        (boot-http/serve :dir "target/browser")
        (watch)
        (boot-reload/reload)
        (boot-cljs-repl/cljs-repl)
        (compile-cljs :id "browser/index" :opt opt)
        (target)
        (speak)))

(deftask run-node-repl
  "Runs a node repl."
  []
  (comp (testing)
        (benchmarking)
        (target)
        (with-pass-thru _
          (host-process
            (conch/proc
              "lumo"
              "-c" (str "\"" (System/getProperty "fake.class.path") "\"")
              "-k" "lumo_cache"
              "-e" (str "\"(require '[mikron.core :as mikron "
                        ":refer [schema defschema pack unpack gen valid?]])\"")
              "-r")))))

(deftask generate-docs
  "Generates documentation."
  []
  (let [ns-str "(ns mikron.codox
                  (:require [mikron.core :as mikron
                             :refer-macros [schema defschema]
                             :refer [pack unpack gen valid? diff diff* undiff undiff* interp]]))"]
    (comp (with-pass-thru _
            (host-process
              (conch/proc
                "lumo"
                "-c" (System/getProperty "fake.class.path")
                "-k" "docs/cache-cljs"
                "-e" ns-str)))
          (boot-codox/codox
            :name         "moxaj/mikron"
            :metadata     {:doc/format :markdown}
            :output-path  "docs"
            ;:namespaces   [#"^mikron\.(?!codegen)"]
            :exclude-vars #"^((map)?->\p{Upper}|[?!].*\*)"
            :themes       [:default
                           [:klipse
                            #:klipse{:cached-macro-ns-regexp #"/mikron\..*/"
                                     :cached-ns-regexp       #"/mikron\..*/"
                                     :cached-ns-root         "cache-cljs"
                                     :require-statement      ns-str}]])
          (sift :move {#"docs" "../docs"})
          (target))))

(set-env!
  :resource-paths #{"src/cljc"}
  :dependencies   '[[org.clojure/clojure         "1.9.0-alpha14"]
                    [org.clojure/clojurescript   "1.9.456"]

                    [adzerk/boot-test            "1.2.0"     :scope "test"]
                    [pandeiro/boot-http          "0.7.6"     :scope "test"]
                    [adzerk/boot-reload          "0.5.1"     :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"]
                    [boot-codox                  "0.10.3"    :scope "test"]

                    [me.raynes/conch             "0.8.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"]
                    [viebel/codox-klipse-theme   "0.0.4"     :scope "test"]])

(task-options!
  pom {:project 'moxaj/mikron
       :version "0.5.0"})

(require '[clojure.java.io :as io]
         '[clojure.pprint :as pprint]
         '[clojure.string :as string]

         '[boot.util :as util]
         '[adzerk.boot-test :as boot-test]
         '[pandeiro.boot-http :as boot-http]
         '[adzerk.boot-reload :as boot-reload]
         '[adzerk.boot-cljs :as boot-cljs]
         '[adzerk.boot-cljs-repl :as boot-cljs-repl]
         '[crisptrutski.boot-cljs-test :as boot-cljs-test]
         '[me.raynes.conch.low-level :as conch]
         '[codox.boot :as boot-codox]

         '[mikron.core :as mikron])

;; Util

(def windows?
  (.. (System/getProperty "os.name") (toLowerCase) (startsWith "windows")))

(defn fix-slashes
  [^String s]
  (if windows?
    (.replaceAll s "/" "\\\\")
    s))

(defn host-process
  "Connects the stdin and stdout to a process."
  [process]
  (future (conch/feed-from process System/in))
  (future (while true (conch/flush process) (Thread/sleep 100)))
  (conch/stream-to-out process :out))

;; Tasks

(deftask build
  "Builds the project."
  []
  (comp (pom)
        (jar)
        (install)))

(deftask testing
  "Adds the test files to the fileset."
  []
  (merge-env! :resource-paths #{"test/cljc" "test/cljs" "resources/test"})
  identity)

(deftask benchmarking
  "Adds the benchmark files to the fileset."
  []
  (merge-env! :resource-paths #{"benchmark/cljc" "benchmark/java" "resources/benchmark"}
              :dependencies   '[[com.cognitect/transit-clj "0.8.297"]
                                [com.cognitect/transit-cljs "0.8.239"]
                                [com.damballa/abracad "0.4.13"]
                                [gloss "0.2.6"]
                                [cheshire "5.7.0"]
                                [funcool/octet "1.0.1"]
                                [com.google.protobuf/protobuf-java "3.2.0"]
                                [com.taoensso/nippy "2.12.2"]
                                [criterium "0.4.4"]
                                [proto-repl-charts "0.3.2"]])
  identity)

(deftask benchmark-clj
  "Runs the benchmarks on JVM."
  [s stats  VAL #{kw} "The stat(s) to measure."
   S schema VAL kw    "The schema to benchmark. One of #{:doubles :quartet :snapshot :snapshot2}"]
  (let [stats  (or stats (do (util/info "No :stats specified, using [:pack-time :unpack-time].\n")
                             [:pack-time :unpack-time]))
        schema (keyword "mikron.benchmark.schema"
                        (name (or schema (do (util/info "No :schema specified, using :snapshot.\n")
                                             :snapshot))))
        tmp    (tmp-dir!)]
    (comp (benchmarking)
          (javac)
          (with-pre-wrap fileset
            (let [in-file (->> (output-files fileset) (by-name ["results.edn"]) (first))]
              (spit (io/file tmp (tmp-path in-file))
                    (str (slurp (tmp-file in-file))
                         "\r\n\r\n"
                         "Stats: " (vec stats) "\r\n"
                         "Schema: " schema "\r\n"
                         (do (require '[mikron.benchmark.core :as benchmark])
                             (let [results ((resolve 'benchmark/benchmark) :stats stats :schema schema)]
                               (with-out-str (pprint/pprint results))))))
              (-> fileset
                  (add-resource tmp)
                  (commit!))))
          (sift :move {#"results.edn" "../resources/benchmark/results.edn"})
          (target))))

(deftask test-clj
  "Runs the tests on JVM."
  []
  (comp (testing)
        (boot-test/test)))

(deftask test-node
  "Runs the tests in a Node.js environment."
  [o opt          VAL kw   "The optimization level for the cljs compiler."
   s self-hosted?     bool "True if self-hosted."]
  (comp (testing)
        (if self-hosted?
          (comp (target)
                (with-pass-thru _
                  (host-process
                    (conch/proc
                      "lumo"
                      "-c" (System/getProperty "fake.class.path")
                      "-k" "lumo_cache"
                      "target/mikron/node.cljs"))))
          (boot-cljs-test/test-cljs :js-env        :node
                                    :namespaces    '[mikron.test]
                                    :optimizations (or opt :none)))))

(deftask test-browser
  "Runs the tests in a browser environment."
  [o opt    VAL kw   "The optimization level for the cljs compiler."
   e js-env VAL kw "The js environment."]
  (comp (testing)
        (boot-cljs-test/test-cljs :js-env        js-env
                                  :namespaces    '[mikron.test]
                                  :optimizations (or opt :none))))

(deftask test
  "Runs the specified tests."
  [p platform     VAL kw   "The platform to run on."
   t target       VAL kw   "The target for the cljs compiler."
   o opt          VAL kw   "The optimization level for the cljs compiler."
   s self-hosted?     bool "True if self-hosted."]
  (comp (testing)
        (case platform
          :clj  (test-clj)
          :cljs (case target
                  :nodejs  (test-node :opt          opt
                                      :self-hosted? self-hosted?)
                  :browser (test-browser :opt    opt
                                         :js-env :slimer)))))

(deftask compile-cljs
  "Compiles the cljs source files."
  [o opt VAL kw  "The compiler optimization level."
   i id  VAL str "The id of the build."]
  (boot-cljs/cljs
    :ids              (when id [(fix-slashes id)])
    :compiler-options {:static-fns     true
                       :optimizations  (or opt :none)
                       :parallel-build false
                       :infer-externs  false}))

(deftask run-browser-repl
  "Compiles the cljs sources, serves them on localhost:3000, and sets up
   an nrepl listener.
   Terminal A
     - boot run-browser-repl
   Terminal B
     - boot repl -c
     - (boot-cljs-repl/start-repl)
   localhost:3000"
  [o opt VAL kw  "The compiler optimization level."]
  (comp (benchmarking)
        (testing)
        (boot-http/serve :dir "target/browser")
        (watch)
        (boot-reload/reload)
        (boot-cljs-repl/cljs-repl)
        (compile-cljs :id "browser/index" :opt opt)
        (target)
        (speak)))

(deftask run-node-repl
  "Runs a node repl."
  []
  (comp (testing)
        (benchmarking)
        (target)
        (with-pass-thru _
          (host-process
            (conch/proc
              "lumo"
              "-c" (str "\"" (System/getProperty "fake.class.path") "\"")
              "-k" "lumo_cache"
              "-e" (str "\"(require '[mikron.core :as mikron "
                        ":refer [schema defschema pack unpack gen valid?]])\"")
              "-r")))))

(deftask generate-docs
  "Generates documentation."
  []
  (let [ns-str "(ns mikron.codox
                  (:require [mikron.core :as mikron
                             :refer-macros [schema defschema]
                             :refer [pack unpack gen valid? diff diff* undiff undiff* interp]]))"]
    (comp (with-pass-thru _
            (host-process
              (conch/proc
                "lumo"
                "-c" (System/getProperty "fake.class.path")
                "-k" "docs/cache-cljs"
                "-e" ns-str)))
          (boot-codox/codox
            :name         "moxaj/mikron"
            :metadata     {:doc/format :markdown}
            :output-path  "docs"
            ;:namespaces   [#"^mikron\.(?!codegen)"]
            :exclude-vars #"^((map)?->\p{Upper}|[?!].*\*)"
            :themes       [:default
                           [:klipse
                            #:klipse{:cached-macro-ns-regexp #"mikron\..*"
                                     :cached-ns-regexp       #"mikron\..*"
                                     :cached-ns-root         "cache-cljs"
                                     :require-statement      ns-str}]])
          (sift :move {#"docs" "../docs"})
          (target))))

Fix klipse regex [skip ci]

Fix klipse regex [skip ci]