(ns beicon.core
  (:require [beicon.extern.rxjs]
            [cats.protocols :as p]
            [cats.context :as ctx])
  (:refer-clojure :exclude [true? map filter reduce merge repeat repeatedly zip
                            dedupe drop take take-while concat partition]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn observable?
  "Return true if `ob` is a instance
  of Rx.Observable."
  [ob]
  (instance? js/Rx.Observable ob))

(defn connectable?
  "Return true if `ob` is a instance
  of Rx.ConnectableObservable."
  [ob]
  (instance? js/Rx.ConnectableObservable ob))

(defn bus?
  "Return true if `b` is a Subject instance."
  [b]
  (instance? js/Rx.Subject b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Observables Constructors
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol IObservableValue
  (-end? [_] "Returns true if is end value.")
  (-error? [_] "Returns true if is end value.")
  (-next? [_] "Returns true if is end value."))

(extend-type default
  IObservableValue
  (-next? [_] true)
  (-error? [_] false)
  (-end? [_] false))

(extend-type nil
  IObservableValue
  (-next? [_] false)
  (-error? [_] false)
  (-end? [_] true))

(extend-type js/Error
  IObservableValue
  (-next? [_] false)
  (-error? [_] true)
  (-end? [_] false))

(extend-type cljs.core.ExceptionInfo
  IObservableValue
  (-next? [_] false)
  (-error? [_] true)
  (-end? [_] false))

(defn create
  "Creates an observable sequence from a specified
  subscribe method implementation."
  [sf]
  {:pre [(fn? sf)]}
  (js/Rx.Observable.create
   (fn [ob]
     (letfn [(callback [v]
               (cond
                 (-next? v)
                 (.onNext ob v)

                 (-end? v)
                 (.onCompleted ob)

                 (-error? v)
                 (.onError ob v)))]
       (try
         (sf callback)
         (catch js/Error e
           (.onError ob e)))))))

(defn repeat
  "Generates an observable sequence that repeats the
  given element."
  ([v]
   (repeat v -1))
  ([v n]
   {:pre [(number? v)]}
   (js/Rx.Observable.repeat v n)))

(defn publish
  "Create a connectable (hot) observable
  from other observable."
  ([ob]
   (publish ob true))
  ([ob connect?]
   {:pre [(observable? ob)]}
   (let [ob' (.publish ob)]
     (when connect?
       (.connect ob'))
     ob')))

(defn connect!
  "Connect the connectable observable."
  [ob]
  {:pre [(connectable? ob)]}
  (.connect ob))

(defn from-coll
  "Generates an observable sequence from collection."
  [coll]
  (let [array (into-array coll)]
    (js/Rx.Observable.fromArray array)))

(defn from-callback
  [f & args]
  {:pre [(fn? f)]}
  (create (fn [sink]
            (apply f sink args)
            (sink nil))))

(defn from-poll
  "Creates an observable sequence polling given
  function with given interval."
  [ms f]
  (create (fn [sick]
            (let [semholder (volatile! nil)
                  sem (js/setInterval
                       (fn []
                         (let [v (f)]
                           (when (or (-end? v) (-error? v))
                             (js/clearInterval @semholder))
                           (sick v)))
                       ms)]
              (vreset! semholder sem)))))

(defn from-atom
  [atm]
  (create (fn [sink]
            (let [key (keyword (gensym "beicon"))]
              (add-watch atm key (fn [_ _ _ val]
                                   (sink val)))
              (fn []
                (remove-watch atm key))))))

(defn once
  "Returns an observable sequence that contains
  a single element."
  [v]
  (js/Rx.Observable.just v))

(defn never
  "Returns an observable sequence that is already
  in end state."
  []
  (create (fn [sink]
            (sink nil))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Bus
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn bus
  "Bus is an observable sequence that allows you to push
  values into the stream."
  []
  (js/Rx.Subject.))

(defn push!
  "Pushes the given value to the bus stream."
  [b v]
  {:pre [(bus? b)]}
  (.onNext b v))

(defn error!
  "Pushes the given error to the bus stream."
  [b e]
  {:pre [(bus? b)]}
  (.onError b e))

(defn end!
  "Ends the given bus stream."
  [b]
  {:pre [(bus? b)]}
  (.onCompleted b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Observable Subscription
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn on-value
  "Subscribes a function to invoke for each element
  in the observable sequence."
  [ob f]
  {:pre [(observable? ob) (fn? f)]}
  (let [disposable (.subscribeOnNext ob f)]
    #(.dispose disposable)))

(defn on-error
  "Subscribes a function to invoke upon exceptional termination
  of the observable sequence."
  [ob f]
  {:pre [(observable? ob) (fn? f)]}
  (let [disposable (.subscribeOnError ob f)]
    #(.dispose disposable)))

(defn on-end
  "Subscribes a function to invoke upon graceful termination
  of the observable sequence."
  [ob f]
  {:pre [(observable? ob) (fn? f)]}
  (let [disposable (.subscribeOnCompleted ob f)]
    #(.dispose disposable)))

(defn subscribe
  "Subscribes an observer to the observable sequence."
  [ob nf ef cf]
  {:pre [(observable? ob)]}
  (let [disposable (.subscribe ob nf ef cf)]
    #(.dispose disposable)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Observable Transformations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn choice
  "Create an observable that surfaces any of the given
  sequences, whichever reacted first."
  ([a b]
   {:pre [(observable? a)
          (observable? b)]}
   (.amb a b))
  ([a b & more]
   (cljs.core/reduce choice (choice a b) more)))

(defn zip
  "Merges the specified observable sequences or Promises
  into one observable sequence."
  [a b]
  {:pre [(observable? a)
         (observable? b)]}
  (.zip a b vector))

(defn concat
  "Concatenates all of the specified observable
  sequences, as long as the previous observable
  sequence terminated successfully."
  ([a b]
   {:pre [(observable? a)
          (observable? b)]}
   (.concat a b))
  ([a b & more]
   (cljs.core/reduce concat (concat a b) more)))

(defn merge
  "Merges all the observable sequences and Promises
  into a single observable sequence."
  ([a b]
   {:pre [(observable? a)
          (observable? b)]}
   (.merge a b))
  ([a b & more]
   (cljs.core/reduce merge (merge a b) more)))

(defn filter
  "Filters the elements of an observable sequence
  based on a predicate."
  [f ob]
  {:pre [(observable? ob)]}
  (.filter ob #(boolean (f %))))

(defn map
  "Apply a function to each element of an observable
  sequence."
  [f ob]
  {:pre [(observable? ob)]}
  (.map ob #(f %)))

(defn flat-map
  "Projects each element of an observable sequence to
  an observable sequence and merges the resulting
  observable sequences or Promises or array/iterable
  into one observable sequence."
  [f ob]
  {:pre [(observable? ob)]}
  (.flatMap ob #(f %)))

(defn skip
  "Bypasses a specified number of elements in an
  observable sequence and then returns the remaining
  elements."
  [n ob]
  {:pre [(observable? ob) (number? n)]}
  (.skip ob n))

(defn skip-while
  "Bypasses elements in an observable sequence as long
  as a specified condition is true and then returns the
  remaining elements."
  [f ob]
  {:pre [(observable? ob) (fn? f)]}
  (.skipWhile ob #(boolean (f %))))

(defn skip-until
  "Returns the values from the source observable sequence
  only after the other observable sequence produces a value."
  [pob ob]
  {:pre [(observable? ob) (observable? pob)]}
  (.skipUntil ob pob))

(defn take
  "Bypasses a specified number of elements in an
  observable sequence and then returns the remaining
  elements."
  [n ob]
  {:pre [(observable? ob) (number? n)]}
  (.take ob n))

(defn slice
  "Returns a shallow copy of a portion of an Observable
  into a new Observable object."
  ([begin ob]
   {:pre [(observable? ob) (number? begin)]}
   (.slice ob begin))
  ([begin end ob]
   {:pre [(observable? ob) (number? begin) (number? end)]}
   (.slice ob begin end)))

(defn take-while
  "Returns elements from an observable sequence as long as a
  specified predicate returns true."
  [f ob]
  {:pre [(observable? ob) (fn? f)]}
  (.takeWhile ob f))

(defn reduce
  "Applies an accumulator function over an observable
  sequence, returning the result of the aggregation as a
  single element in the result sequence."
  ([f ob]
   {:pre [(observable? ob) (fn? f)]}
   (.reduce ob f))
  ([f seed ob]
   {:pre [(observable? ob) (fn? f)]}
   (.reduce ob f seed)))

(defn tap
  "Invokes an action for each element in the
  observable sequence."
  [f ob]
  {:pre [(observable? ob) (fn? f)]}
  (.tap ob f))

(defn throttle
  "Returns an Observable that emits only the first item
  emitted by the source Observable during sequential
  time windows of a specified duration."
  [ms ob]
  {:pre [(observable? ob) (number? ms)]}
  (.throttle ob ms))

(defn ignore
  "Ignores all elements in an observable sequence leaving
  only the termination messages."
  [ob]
  {:pre [(observable? ob)]}
  (.ignoreElements ob))

(defn pausable
  [pauser ob]
  {:pre [(observable? ob) (observable? pauser)]}
  (.pausable ob pauser))

(defn dedupe
  "Returns an observable sequence that contains only
  distinct contiguous elements."
  ([ob]
   (.distinctUntilChanged ob))
  ([f ob]
   (.distinctUntilChanged ob f)))

(defn dedupe'
  "Returns an observable sequence that contains only d
  istinct elements.
  Usage of this operator should be considered carefully
  due to the maintenance of an internal lookup structure
  which can grow large."
  ([ob]
   (.distinct ob))
  ([f ob]
   (.distinct ob f)))

(defn buffer
  "Projects each element of an observable sequence into zero
  or more buffers which are produced based on element count
  information."
  ([n ob]
   (.bufferWithCount ob n))
  ([n skip ob]
   (.bufferWithCount ob n skip)))

(defn to-atom
  ([ob]
   (let [a (atom nil)]
     (to-atom a ob)))
  ([a ob]
   {:pre [(observable? ob)]}
   (on-value ob #(reset! a %))
   a)
  ([a ob f]
   {:pre [(observable? ob)]}
   (on-value ob #(swap! a f %))
   a))

(defn- sink-step
  [sink]
  (fn
    ([r]
     (sink nil)
     r)
    ([_ input]
     (sink input)
     input)))

(defn transform
  [xform stream]
  (let [ns (create (fn [sink]
                     (let [xsink (xform (sink-step sink))
                           step (fn [input]
                                  (let [v (xsink nil input)]
                                    (when (reduced? v)
                                      (xsink @v))))
                           unsub (on-value stream step)]
                       (on-end stream #(do (xsink nil)
                                           (sink nil)))
                       (fn []
                         (unsub)))))]
    ns))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cats Integration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def observable-context
  (reify
    p/Context
    (-get-level [_] ctx/+level-default+)

    p/Functor
    (-fmap [_ f obs]
      (map f obs))

    p/Applicative
    (-pure [_ v]
      (once v))

    (-fapply [_ pf pv]
      (.zip pf pv #(%1 %2)))

    p/Monad
    (-mreturn [_ v]
      (once v))

    (-mbind [_ mv f]
      (flat-map f mv))))

(extend-protocol p/Contextual
  js/Rx.Observable
  (-get-context [_] observable-context)

  js/Rx.Subject
  (-get-context [_] observable-context))

(ns beicon.core
  (:require [beicon.extern.rxjs]
            [cats.protocols :as p]
            [cats.context :as ctx])
  (:refer-clojure :exclude [true? map filter reduce merge repeat repeatedly zip
                            dedupe drop take take-while concat partition]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn observable?
  "Return true if `ob` is a instance
  of Rx.Observable."
  [ob]
  (instance? js/Rx.Observable ob))

(defn connectable?
  "Return true if `ob` is a instance
  of Rx.ConnectableObservable."
  [ob]
  (instance? js/Rx.ConnectableObservable ob))

(defn bus?
  "Return true if `b` is a Subject instance."
  [b]
  (instance? js/Rx.Subject b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Observables Constructors
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol IObservableValue
  (-end? [_] "Returns true if is end value.")
  (-error? [_] "Returns true if is end value.")
  (-next? [_] "Returns true if is end value."))

(extend-type default
  IObservableValue
  (-next? [_] true)
  (-error? [_] false)
  (-end? [_] false))

(extend-type nil
  IObservableValue
  (-next? [_] false)
  (-error? [_] false)
  (-end? [_] true))

(extend-type js/Error
  IObservableValue
  (-next? [_] false)
  (-error? [_] true)
  (-end? [_] false))

(extend-type cljs.core.ExceptionInfo
  IObservableValue
  (-next? [_] false)
  (-error? [_] true)
  (-end? [_] false))

(defn create
  "Creates an observable sequence from a specified
  subscribe method implementation."
  [sf]
  {:pre [(fn? sf)]}
  (js/Rx.Observable.create
   (fn [ob]
     (letfn [(callback [v]
               (cond
                 (-next? v)
                 (.onNext ob v)

                 (-end? v)
                 (.onCompleted ob)

                 (-error? v)
                 (.onError ob v)))]
       (try
         (sf callback)
         (catch js/Error e
           (.onError ob e)))))))

(defn repeat
  "Generates an observable sequence that repeats the
  given element."
  ([v]
   (repeat v -1))
  ([v n]
   {:pre [(number? v)]}
   (js/Rx.Observable.repeat v n)))

(defn publish
  "Create a connectable (hot) observable
  from other observable."
  ([ob]
   (publish ob true))
  ([ob connect?]
   {:pre [(observable? ob)]}
   (let [ob' (.publish ob)]
     (when connect?
       (.connect ob'))
     ob')))

(defn connect!
  "Connect the connectable observable."
  [ob]
  {:pre [(connectable? ob)]}
  (.connect ob))

(defn from-coll
  "Generates an observable sequence from collection."
  [coll]
  (let [array (into-array coll)]
    (js/Rx.Observable.fromArray array)))

(defn from-callback
  [f & args]
  {:pre [(fn? f)]}
  (create (fn [sink]
            (apply f sink args)
            (sink nil))))

(defn from-poll
  "Creates an observable sequence polling given
  function with given interval."
  [ms f]
  (create (fn [sick]
            (let [semholder (volatile! nil)
                  sem (js/setInterval
                       (fn []
                         (let [v (f)]
                           (when (or (-end? v) (-error? v))
                             (js/clearInterval @semholder))
                           (sick v)))
                       ms)]
              (vreset! semholder sem)))))

(defn from-atom
  [atm]
  (create (fn [sink]
            (let [key (keyword (gensym "beicon"))]
              (add-watch atm key (fn [_ _ _ val]
                                   (sink val)))
              (fn []
                (remove-watch atm key))))))

(defn once
  "Returns an observable sequence that contains
  a single element."
  [v]
  (js/Rx.Observable.just v))

(defn never
  "Returns an observable sequence that is already
  in end state."
  []
  (create (fn [sink]
            (sink nil))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Bus
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn bus
  "Bus is an observable sequence that allows you to push
  values into the stream."
  []
  (js/Rx.Subject.))

(defn push!
  "Pushes the given value to the bus stream."
  [b v]
  {:pre [(bus? b)]}
  (.onNext b v))

(defn error!
  "Pushes the given error to the bus stream."
  [b e]
  {:pre [(bus? b)]}
  (.onError b e))

(defn end!
  "Ends the given bus stream."
  [b]
  {:pre [(bus? b)]}
  (.onCompleted b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Observable Subscription
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn on-value
  "Subscribes a function to invoke for each element
  in the observable sequence."
  [ob f]
  {:pre [(observable? ob) (fn? f)]}
  (let [disposable (.subscribeOnNext ob f)]
    #(.dispose disposable)))

(defn on-error
  "Subscribes a function to invoke upon exceptional termination
  of the observable sequence."
  [ob f]
  {:pre [(observable? ob) (fn? f)]}
  (let [disposable (.subscribeOnError ob f)]
    #(.dispose disposable)))

(defn on-end
  "Subscribes a function to invoke upon graceful termination
  of the observable sequence."
  [ob f]
  {:pre [(observable? ob) (fn? f)]}
  (let [disposable (.subscribeOnCompleted ob f)]
    #(.dispose disposable)))

(defn subscribe
  "Subscribes an observer to the observable sequence."
  [ob nf ef cf]
  {:pre [(observable? ob)]}
  (let [disposable (.subscribe ob nf ef cf)]
    #(.dispose disposable)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Observable Transformations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn choice
  "Create an observable that surfaces any of the given
  sequences, whichever reacted first."
  ([a b]
   {:pre [(observable? a)
          (observable? b)]}
   (.amb a b))
  ([a b & more]
   (cljs.core/reduce choice (choice a b) more)))

(defn zip
  "Merges the specified observable sequences or Promises
  into one observable sequence."
  [a b]
  {:pre [(observable? a)
         (observable? b)]}
  (.zip a b vector))

(defn concat
  "Concatenates all of the specified observable
  sequences, as long as the previous observable
  sequence terminated successfully."
  ([a b]
   {:pre [(observable? a)
          (observable? b)]}
   (.concat a b))
  ([a b & more]
   (cljs.core/reduce concat (concat a b) more)))

(defn merge
  "Merges all the observable sequences and Promises
  into a single observable sequence."
  ([a b]
   {:pre [(observable? a)
          (observable? b)]}
   (.merge a b))
  ([a b & more]
   (cljs.core/reduce merge (merge a b) more)))

(defn filter
  "Filters the elements of an observable sequence
  based on a predicate."
  [f ob]
  {:pre [(observable? ob)]}
  (.filter ob #(boolean (f %))))

(defn map
  "Apply a function to each element of an observable
  sequence."
  [f ob]
  {:pre [(observable? ob)]}
  (.map ob #(f %)))

(defn flat-map
  "Projects each element of an observable sequence to
  an observable sequence and merges the resulting
  observable sequences or Promises or array/iterable
  into one observable sequence."
  [f ob]
  {:pre [(observable? ob)]}
  (.flatMap ob #(f %)))

(defn skip
  "Bypasses a specified number of elements in an
  observable sequence and then returns the remaining
  elements."
  [n ob]
  {:pre [(observable? ob) (number? n)]}
  (.skip ob n))

(defn skip-while
  "Bypasses elements in an observable sequence as long
  as a specified condition is true and then returns the
  remaining elements."
  [f ob]
  {:pre [(observable? ob) (fn? f)]}
  (.skipWhile ob #(boolean (f %))))

(defn skip-until
  "Returns the values from the source observable sequence
  only after the other observable sequence produces a value."
  [pob ob]
  {:pre [(observable? ob) (observable? pob)]}
  (.skipUntil ob pob))

(defn take
  "Bypasses a specified number of elements in an
  observable sequence and then returns the remaining
  elements."
  [n ob]
  {:pre [(observable? ob) (number? n)]}
  (.take ob n))

(defn slice
  "Returns a shallow copy of a portion of an Observable
  into a new Observable object."
  ([begin ob]
   {:pre [(observable? ob) (number? begin)]}
   (.slice ob begin))
  ([begin end ob]
   {:pre [(observable? ob) (number? begin) (number? end)]}
   (.slice ob begin end)))

(defn take-while
  "Returns elements from an observable sequence as long as a
  specified predicate returns true."
  [f ob]
  {:pre [(observable? ob) (fn? f)]}
  (.takeWhile ob f))

(defn reduce
  "Applies an accumulator function over an observable
  sequence, returning the result of the aggregation as a
  single element in the result sequence."
  ([f ob]
   {:pre [(observable? ob) (fn? f)]}
   (.reduce ob f))
  ([f seed ob]
   {:pre [(observable? ob) (fn? f)]}
   (.reduce ob f seed)))

(defn tap
  "Invokes an action for each element in the
  observable sequence."
  [f ob]
  {:pre [(observable? ob) (fn? f)]}
  (.tap ob f))

(defn throttle
  "Returns an Observable that emits only the first item
  emitted by the source Observable during sequential
  time windows of a specified duration."
  [ms ob]
  {:pre [(observable? ob) (number? ms)]}
  (.throttle ob ms))

(defn ignore
  "Ignores all elements in an observable sequence leaving
  only the termination messages."
  [ob]
  {:pre [(observable? ob)]}
  (.ignoreElements ob))

(defn pausable
  [pauser ob]
  {:pre [(observable? ob) (observable? pauser)]}
  (.pausable ob pauser))

(defn dedupe
  "Returns an observable sequence that contains only
  distinct contiguous elements."
  ([ob]
   (.distinctUntilChanged ob))
  ([f ob]
   (.distinctUntilChanged ob f)))

(defn dedupe'
  "Returns an observable sequence that contains only d
  istinct elements.
  Usage of this operator should be considered carefully
  due to the maintenance of an internal lookup structure
  which can grow large."
  ([ob]
   (.distinct ob))
  ([f ob]
   (.distinct ob f)))

(defn buffer
  "Projects each element of an observable sequence into zero
  or more buffers which are produced based on element count
  information."
  ([n ob]
   (.bufferWithCount ob n))
  ([n skip ob]
   (.bufferWithCount ob n skip)))

(defn to-atom
  ([ob]
   (let [a (atom nil)]
     (to-atom a ob)))
  ([a ob]
   {:pre [(observable? ob)]}
   (on-value ob #(reset! a %))
   a)
  ([a ob f]
   {:pre [(observable? ob)]}
   (on-value ob #(swap! a f %))
   a))

(defn to-observable
  [b]
  {:pre [(bus? b)]}
  (.asObservable b))

(defn- sink-step
  [sink]
  (fn
    ([r]
     (sink nil)
     r)
    ([_ input]
     (sink input)
     input)))

(defn transform
  [xform stream]
  (let [ns (create (fn [sink]
                     (let [xsink (xform (sink-step sink))
                           step (fn [input]
                                  (let [v (xsink nil input)]
                                    (when (reduced? v)
                                      (xsink @v))))
                           unsub (on-value stream step)]
                       (on-end stream #(do (xsink nil)
                                           (sink nil)))
                       (fn []
                         (unsub)))))]
    ns))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Cats Integration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def observable-context
  (reify
    p/Context
    (-get-level [_] ctx/+level-default+)

    p/Functor
    (-fmap [_ f obs]
      (map f obs))

    p/Applicative
    (-pure [_ v]
      (once v))

    (-fapply [_ pf pv]
      (.zip pf pv #(%1 %2)))

    p/Monad
    (-mreturn [_ v]
      (once v))

    (-mbind [_ mv f]
      (flat-map f mv))))

(extend-protocol p/Contextual
  js/Rx.Observable
  (-get-context [_] observable-context)

  js/Rx.Subject
  (-get-context [_] observable-context))

Add to-observable function.

Add to-observable function.


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "cli4clj allows to create simple interactive command line interfaces for Clojure applications.
          For an example usage scenario please see the namespace cli4clj.example."}
  cli4clj.cli
  (:use [clojure.main :only [repl skip-if-eol skip-whitespace]]
        [clojure.string :only [blank? split]]
        clj-assorted-utils.util)
  (:import (jline.console ConsoleReader)))

(defn cli-repl-print
  [arg]
  (if (not (nil? arg))
    (prn arg)))

(defn cli-repl-prompt
  []
  (print "cli# "))

(defn create-cli-repl-read-fn
  []
  (let [rdr (doto (ConsoleReader.))]
    (fn [request-prompt request-exit]
      (let [in (.readLine rdr)]
        (if (not (blank? in))
          (let [split-in (split in #"\s")]
            (if (symbol? (read-string (first split-in)))
              (reduce (fn [v in-part] (conj v (read-string in-part))) [] split-in)
              (read-string in))))))))

;  "The created read function is largely based on the exisiting repl read function:
;   http://clojure.github.io/clojure/clojure.main-api.html#clojure.main/repl-read
;   The main difference is that if the first argument on a line is a keyword,
;   all elements on that line will be forwarded in a vector instead of being
;   forwarded seperately."
;  (fn [request-prompt request-exit]
;    (or ({:line-start request-prompt :stream-end request-exit}
;         (skip-whitespace *in*))
;        (loop [v []]
;          (let [input (read {:read-cond :allow} *in*)]
;            (if (and (not (symbol? input)) (empty? v))
;              (do
;                (skip-if-eol *in*)
;                input)
;              (if (= :line-start (skip-whitespace *in*))
;                (conj v input)
;                (recur (conj v input)))))))))

(defn resolve-cmd-alias
  [input-cmd cmds]
  (if (keyword? (cmds input-cmd))
    (cmds input-cmd)
    input-cmd))

(defn create-cli-eval-fn
  [cmds allow-eval print-err]
  (fn [arg]
;    (println "Eval arg:" arg)
    (if (and (vector? arg) (contains? cmds (keyword (first arg))))
      (let [cmd (resolve-cmd-alias (keyword (first arg)) cmds)]
        (try
          (apply
            (get-in cmds [cmd :fn])
            (rest arg))
          (catch Exception e
            (print-err (.getMessage e)))))
      (if allow-eval
        (eval arg)
        (print-err (str "Invalid command: \"" arg "\". Please type \"help\" to get an overview of commands."))))))

(defn create-cli-help-fn
  [cmds]
  (fn []
    (let [command-names (sort (keys cmds))]
      (doseq [c command-names]
        (if (map? (cmds c))
          (do
            (println (str (name c) "\t" (get-in cmds [c :short-info])))
            (when-let [li (get-in cmds [c :long-info])]
              (println (str "\t" (get-in cmds [c :long-info])))))
          (println (str (name c) "\tSee: " (name (cmds c)))))))))

(def cli-mandatory-default-options
  {:cmds {:exit {:fn (fn [] (System/exit 0))
                 :short-info "Exit the CLI."
                 :long-info "Terminate and close the command line interface."}
          :help {:short-info "Show help."
                 :long-info "Display a help text that lists all available commands including further detailed information about these commands."}}})

(defmulti print-err-fn (fn [arg] (= (type arg) Exception)))
(defmethod print-err-fn true [arg]
  (println-err (.getMessage arg)))
(defmethod print-err-fn false [arg]
  (println-err (str arg)))

(def cli-default-options
  {:allow-eval false
   :cmds {:e :exit
          :h :help
          :? :help
          :quit :exit
          :q :exit}
   :eval-factory create-cli-eval-fn
   :help-factory create-cli-help-fn
   :print cli-repl-print
   :print-err print-err-fn
   :prompt cli-repl-prompt
   :read-factory create-cli-repl-read-fn})

(defn merge-options
  [defaults user-options mandatory-defaults]
  (merge-with (fn [a b] (if (and (map? a) (map? b))
                          (merge a b)
                          b))
              defaults user-options mandatory-defaults))

(defn get-cli-opts
  [user-options]
  (let [merged-opts (merge-options cli-default-options user-options cli-mandatory-default-options)]
    (assoc-in merged-opts [:cmds :help :fn] ((merged-opts :help-factory) (merged-opts :cmds)))))

(defn start-cli
  ([]
    (start-cli {}))
  ([user-options]
    (let [options (get-cli-opts user-options)]
      (repl
        :eval ((options :eval-factory) (options :cmds) (options :allow-eval) (options :print-err))
        :print (options :print)
        :prompt (options :prompt)
        :read ((options :read-factory))))))

(defn cmd-vector-to-test-input-string
  [cmd-vec]
  (reduce (fn [s c] (str s c "\n")) "" cmd-vec))

(defn get-prompt-string
  [cli-opts]
  (with-out-str (((get-cli-opts cli-opts) :prompt))))

(defn test-cli-stdout
  [cli-opts in-cmds]
  (let [out-str (with-out-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (start-cli cli-opts)))]
    (.trim (.replaceAll out-str (get-prompt-string cli-opts) ""))))

(defn test-cli-stderr
  [cli-opts in-cmds]
  (with-err-str (with-out-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (start-cli cli-opts)))))

;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "cli4clj allows to create simple interactive command line interfaces for Clojure applications.
          For an example usage scenario please see the namespace cli4clj.example."}
  cli4clj.cli
  (:use [clojure.main :only [repl skip-if-eol skip-whitespace]]
        [clojure.string :only [blank? split]]
        clj-assorted-utils.util)
  (:import (jline.console ConsoleReader)))

(defn cli-repl-print
  [arg]
  (if (not (nil? arg))
    (prn arg)))

(defn cli-repl-prompt
  []
  (print "cli# "))

(defn create-cli-repl-read-fn
  []
  (let [rdr (doto (ConsoleReader.))]
    (fn [request-prompt request-exit]
      (let [in-line (.readLine rdr)]
        (if (not (blank? in-line))
          (let [split-in (split in-line #"\s")]
            (if (symbol? (read-string (first split-in)))
              (reduce (fn [v in-part] (conj v (read-string in-part))) [] split-in)
              (read-string in-line))))))))

;  "The created read function is largely based on the exisiting repl read function:
;   http://clojure.github.io/clojure/clojure.main-api.html#clojure.main/repl-read
;   The main difference is that if the first argument on a line is a keyword,
;   all elements on that line will be forwarded in a vector instead of being
;   forwarded seperately."
;  (fn [request-prompt request-exit]
;    (or ({:line-start request-prompt :stream-end request-exit}
;         (skip-whitespace *in*))
;        (loop [v []]
;          (let [input (read {:read-cond :allow} *in*)]
;            (if (and (not (symbol? input)) (empty? v))
;              (do
;                (skip-if-eol *in*)
;                input)
;              (if (= :line-start (skip-whitespace *in*))
;                (conj v input)
;                (recur (conj v input)))))))))

(defn resolve-cmd-alias
  [input-cmd cmds]
  (if (keyword? (cmds input-cmd))
    (cmds input-cmd)
    input-cmd))

(defn create-cli-eval-fn
  [cmds allow-eval print-err]
  (fn [arg]
;    (println "Eval arg:" arg)
    (if (and (vector? arg) (contains? cmds (keyword (first arg))))
      (let [cmd (resolve-cmd-alias (keyword (first arg)) cmds)]
        (try
          (apply
            (get-in cmds [cmd :fn])
            (rest arg))
          (catch Exception e
            (print-err (.getMessage e)))))
      (if allow-eval
        (eval arg)
        (print-err (str "Invalid command: \"" arg "\". Please type \"help\" to get an overview of commands."))))))

(defn create-cli-help-fn
  [cmds]
  (fn []
    (let [command-names (sort (keys cmds))]
      (doseq [c command-names]
        (if (map? (cmds c))
          (do
            (println (str (name c) "\t" (get-in cmds [c :short-info])))
            (when-let [li (get-in cmds [c :long-info])]
              (println (str "\t" (get-in cmds [c :long-info])))))
          (println (str (name c) "\tSee: " (name (cmds c)))))))))

(def cli-mandatory-default-options
  {:cmds {:exit {:fn (fn [] (System/exit 0))
                 :short-info "Exit the CLI."
                 :long-info "Terminate and close the command line interface."}
          :help {:short-info "Show help."
                 :long-info "Display a help text that lists all available commands including further detailed information about these commands."}}})

(defmulti print-err-fn (fn [arg] (= (type arg) Exception)))
(defmethod print-err-fn true [arg]
  (println-err (.getMessage arg)))
(defmethod print-err-fn false [arg]
  (println-err (str arg)))

(def cli-default-options
  {:allow-eval false
   :cmds {:e :exit
          :h :help
          :? :help
          :quit :exit
          :q :exit}
   :eval-factory create-cli-eval-fn
   :help-factory create-cli-help-fn
   :print cli-repl-print
   :print-err print-err-fn
   :prompt cli-repl-prompt
   :read-factory create-cli-repl-read-fn})

(defn merge-options
  [defaults user-options mandatory-defaults]
  (merge-with (fn [a b] (if (and (map? a) (map? b))
                          (merge a b)
                          b))
              defaults user-options mandatory-defaults))

(defn get-cli-opts
  [user-options]
  (let [merged-opts (merge-options cli-default-options user-options cli-mandatory-default-options)]
    (assoc-in merged-opts [:cmds :help :fn] ((merged-opts :help-factory) (merged-opts :cmds)))))

(defn start-cli
  ([]
    (start-cli {}))
  ([user-options]
    (let [options (get-cli-opts user-options)]
      (repl
        :eval ((options :eval-factory) (options :cmds) (options :allow-eval) (options :print-err))
        :print (options :print)
        :prompt (options :prompt)
        :read ((options :read-factory))))))

(defn cmd-vector-to-test-input-string
  [cmd-vec]
  (reduce (fn [s c] (str s c "\n")) "" cmd-vec))

(defn get-prompt-string
  [cli-opts]
  (with-out-str (((get-cli-opts cli-opts) :prompt))))

(defn test-cli-stdout
  [cli-opts in-cmds]
  (let [out-str (with-out-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (start-cli cli-opts)))]
    (.trim (.replaceAll out-str (get-prompt-string cli-opts) ""))))

(defn test-cli-stderr
  [cli-opts in-cmds]
  (with-err-str (with-out-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (start-cli cli-opts)))))

Rename var for input line.

Rename var for input line.


(ns cake.project
  (:use cake classlojure
        [bake.core :only [debug?]]
        [cake.file :only [file global-file]]
        [uncle.core :only [fileset-seq]]
        [clojure.string :only [join]]
        [cake.utils.useful :only [update merge-in tap]])
  (:import [java.io File]))

(defn- make-url [file]
  (str "file:" (.getPath file) (if (.isDirectory file) "/" "")))

(defn classpath []
  (map make-url
       (concat (map file [(System/getProperty "bake.path")
                          "src/" "src/clj/" "classes/" "resources/" "dev/" "test/" "test/classes/"])
               (fileset-seq {:dir (file "lib")            :includes "*.jar"})
               (fileset-seq {:dir (file "lib/dev")        :includes "*.jar"})
               (fileset-seq {:dir (global-file "lib/dev") :includes "*.jar"}))))

(defn ext-classpath []
  (map make-url
       (fileset-seq {:dir "lib/ext" :includes "*.jar"})))

(defonce classloader nil)

(defn make-classloader []
  (when (:ext-dependencies *project*)
    (wrap-ext-classloader (ext-classpath)))
  (when-let [cl (classlojure (classpath))]
    (eval-in cl '(do (require 'cake)
                     (require 'bake.io)
                     (require 'bake.reload)
                     (require 'clojure.main)))
    cl))

(defn reload! []
  (alter-var-root #'classloader
    (fn [cl]
      (when cl (eval-in cl '(shutdown-agents)))
      (make-classloader))))

(defn reload []
  (alter-var-root #'classloader
    (fn [cl]
      (if cl
        (do (eval-in cl '(bake.reload/reload)) cl)
        (make-classloader)))))

(defn- quote-if
  "We need to quote the binding keys so they are not evaluated within the bake
   syntax-quote and the binding values so they are not evaluated in the
   project/project-eval syntax-quote. This function makes that possible."
  [pred bindings]
  (reduce
   (fn [v form]
     (if (pred (count v))
       (conj v (list 'quote form))
       (conj v form)))
   [] bindings))

(defn- separate-bindings
  "Separate bindings based on whether their value is a Java core type or not, because Java types
   should be passed directly to the project classloader, while other values should be serialized."
  [bindings]
  (reduce (fn [b [sym val]]
            (if (and (class val) (.getClassLoader (class val)))
              (update b 0 conj  sym val)
              (update b 1 assoc sym val)))
          [[] {}]
          (partition 2 bindings)))

(defn- shared-bindings []
  `[~'cake/*current-task* '~*current-task*
    ~'cake/*project-root* '~*project-root*
    ~'cake/*project*      '~*project*
    ~'cake/*context*      '~*context*
    ~'cake/*script*       '~*script*
    ~'cake/*opts*         '~*opts*
    ~'cake/*pwd*          '~*pwd*
    ~'cake/*env*          '~*env*
    ~'cake/*vars*         '~*vars*])

(defn project-eval [ns-forms bindings body]
  (reload)
  (when classloader
    (let [[let-bindings object-bindings] (separate-bindings bindings)
          temp-ns (gensym "bake")
          form
          `(do (ns ~temp-ns
                 (:use ~'cake)
                 ~@ns-forms)
               (fn [ins# outs# ~@(keys object-bindings)]
                 (try
                   (clojure.main/with-bindings
                     (bake.io/with-streams ins# outs#
                       (binding ~(shared-bindings)
                         (let ~(quote-if odd? let-bindings)
                           ~@body))))
                   (finally
                    (remove-ns '~temp-ns)))))]
      (try (apply eval-in classloader
                  `(clojure.main/with-bindings (eval '~form))
                  *ins* *outs* (vals object-bindings))
           (catch Throwable e
             (println "error evaluating:")
             (prn body)
             (throw e))))))

(defmacro bake
  "Execute code in a your project classloader. Bindings allow passing state to the project
   classloader. Namespace forms like use and require must be specified before bindings."
  {:arglists '([ns-forms* bindings body*])}
  [& forms]
  (let [[ns-forms [bindings & body]] (split-with (complement vector?) forms)]
    `(project-eval '~ns-forms ~(quote-if even? bindings) '~body)))

(defn group [project]
  (if ('#{clojure clojure-contrib} project)
    "org.clojure"
    (some #(% project) [namespace name])))

(defn dep-map [deps]
  (into {}
    (for [[dep version & opts] deps]
      [dep (apply hash-map :version version opts)])))

(defn create [project-name version opts]
  (let [artifact (name project-name)
        artifact-version (str artifact "-" version)]
    (-> opts
        (assoc :artifact-id      artifact
               :group-id         (group project-name)
               :version          version
               :name             (or (:name opts) artifact)
               :aot              (or (:aot opts) (:namespaces opts))
               :context          (symbol (or (:context opts) "dev"))
               :jar-name         (or (:jar-name opts) artifact-version)
               :war-name         (or (:war-name opts) artifact-version)
               :uberjar-name     (or (:uberjar-name opts) (str artifact-version "-standalone"))
               :dependencies     (dep-map (concat (:dependencies        opts) (:deps        opts)
                                                  (:native-dependencies opts) (:native-deps opts)))
               :dev-dependencies (dep-map (concat (:dev-dependencies    opts) (:dev-deps    opts)))
               :ext-dependencies (dep-map (concat (:ext-dependencies    opts) (:ext-deps    opts)))))))

(ns cake.project
  (:use cake classlojure
        [bake.core :only [debug?]]
        [cake.file :only [file global-file]]
        [uncle.core :only [fileset-seq]]
        [clojure.string :only [join]]
        [cake.utils.useful :only [update merge-in tap]])
  (:import [java.io File]))

(defn- make-url [file]
  (str "file:" (.getPath file) (if (.isDirectory file) "/" "")))

(defn classpath []
  (map make-url
       (concat (map file [(System/getProperty "bake.path")
                          "src/" "src/clj/" "classes/" "resources/" "dev/" "test/" "test/classes/"])
               (fileset-seq {:dir (file "lib")            :includes "*.jar"})
               (fileset-seq {:dir (file "lib/dev")        :includes "*.jar"})
               (fileset-seq {:dir (global-file "lib/dev") :includes "*.jar"}))))

(defn ext-classpath []
  (map make-url
       (fileset-seq {:dir "lib/ext" :includes "*.jar"})))

(defonce classloader nil)

(defn make-classloader []
  (when (:ext-dependencies *project*)
    (wrap-ext-classloader (ext-classpath)))
  (when-let [cl (classlojure (classpath))]
    (eval-in cl '(do (require 'cake)
                     (require 'bake.io)
                     (require 'bake.reload)
                     (require 'clojure.main)))
    cl))

(defn reload! []
  (alter-var-root #'classloader
    (fn [cl]
      (when cl (eval-in cl '(shutdown-agents)))
      (make-classloader))))

(defn reload []
  (alter-var-root #'classloader
    (fn [cl]
      (if cl
        (do (eval-in cl '(bake.reload/reload)) cl)
        (make-classloader)))))

(defn- quote-if
  "We need to quote the binding keys so they are not evaluated within the bake
   syntax-quote and the binding values so they are not evaluated in the
   project/project-eval syntax-quote. This function makes that possible."
  [pred bindings]
  (reduce
   (fn [v form]
     (if (pred (count v))
       (conj v (list 'quote form))
       (conj v form)))
   [] bindings))

(defn- separate-bindings
  "Separate bindings based on whether their value is a Java core type or not, because Java types
   should be passed directly to the project classloader, while other values should be serialized."
  [bindings]
  (reduce (fn [b [sym val]]
            (if (and (class val) (.getClassLoader (class val)))
              (update b 0 conj  sym val)
              (update b 1 assoc sym val)))
          [[] {}]
          (partition 2 bindings)))

(defn- shared-bindings []
  `[~'cake/*current-task* '~*current-task*
    ~'cake/*project-root* '~*project-root*
    ~'cake/*project*      '~*project*
    ~'cake/*context*      '~*context*
    ~'cake/*script*       '~*script*
    ~'cake/*opts*         '~*opts*
    ~'cake/*pwd*          '~*pwd*
    ~'cake/*env*          '~*env*
    ~'cake/*vars*         '~*vars*])

(defn project-eval [ns-forms bindings body]
  (reload)
  (when classloader
    (let [[let-bindings object-bindings] (separate-bindings bindings)
          temp-ns (gensym "bake")
          form
          `(do (ns ~temp-ns
                 (:use ~'cake)
                 ~@ns-forms)
               (fn [ins# outs# ~@(keys object-bindings)]
                 (try
                   (clojure.main/with-bindings
                     (bake.io/with-streams ins# outs#
                       (binding ~(shared-bindings)
                         (let ~(quote-if odd? let-bindings)
                           ~@body))))
                   (finally
                    (remove-ns '~temp-ns)))))]
      (try (apply eval-in classloader
                  `(clojure.main/with-bindings (eval '~form))
                  *ins* *outs* (vals object-bindings))
           (catch Throwable e
             (println "error evaluating:")
             (prn body)
             (throw e))))))

(defmacro bake
  "Execute code in a your project classloader. Bindings allow passing state to the project
   classloader. Namespace forms like use and require must be specified before bindings."
  {:arglists '([ns-forms* bindings body*])}
  [& forms]
  (let [[ns-forms [bindings & body]] (split-with (complement vector?) forms)]
    `(project-eval '~ns-forms ~(quote-if even? bindings) '~body)))

(defn group [project]
  (if ('#{clojure clojure-contrib} project)
    "org.clojure"
    (some #(% project) [namespace name])))

(defn dep-map [deps]
  (into {}
    (for [[dep version & opts] deps]
      [dep (apply hash-map :version version opts)])))

(defn create [project-name version opts]
  (let [artifact (name project-name)
        artifact-version (str artifact "-" version)]
    (-> opts
        (assoc :artifact-id      artifact
               :group-id         (group project-name)
               :version          version
               :name             (or (:name opts) artifact)
               :aot              (or (:aot opts) (:namespaces opts))
               :context          (symbol (or (get *config* "project.context")
                                             (:context opts)
                                             "dev"))
               :jar-name         (or (:jar-name opts) artifact-version)
               :war-name         (or (:war-name opts) artifact-version)
               :uberjar-name     (or (:uberjar-name opts) (str artifact-version "-standalone"))
               :dependencies     (dep-map (concat (:dependencies        opts) (:deps        opts)
                                                  (:native-dependencies opts) (:native-deps opts)))
               :dev-dependencies (dep-map (concat (:dev-dependencies    opts) (:dev-deps    opts)))
               :ext-dependencies (dep-map (concat (:ext-dependencies    opts) (:ext-deps    opts)))))))

add project.context config option for overriding the default context


(ns ufo.ping
  (:require
   [clojure.java.io :as io]
   [dk.ative.docjure.spreadsheet :as excl]
   [utils.core :as ut :refer [in? not-empty? dbgv]]))

(defn timed-ping
  "Time an .isReachable ping to a given domain. Doesn't work for hosts in DMZ
  unix ping sends ICMP (Internet Control Message Protocol) ECHO_REQUEST"
  [domain timeout]
  (let [addr (java.net.InetAddress/getByName domain)
        start (. System (nanoTime))
        result (.isReachable addr timeout)
        total (/ (double (- (. System (nanoTime)) start)) 1000000.0)]
    {:time total :result result}))

(defn host-up?
  ";; parallel execution FTW!
  (pmap (fn [{:keys [host port] :as prm}]
                        (host-up? (conj prm {:timeout 500}))))"
  [{:keys [host timeout port] :as prm}]
  (conj prm
        (let [sock-addr (java.net.InetSocketAddress. host (Integer. port))
              start (. System (nanoTime))]
          (try
            (with-open [sock (java.net.Socket.)]
              (. sock connect sock-addr timeout)
              {:res true :time (/ (double (- (. System (nanoTime)) start))
                                  1000000.0)})
            (catch java.io.IOException e
              {:res false :time nil})
            (catch java.net.SocketTimeoutException e
              {:res false :time nil})
            (catch java.net.UnknownHostException e
              {:res false :time nil})))))

(defn read-cell [{:keys [file sheet cell] :as prm}]
  (let [v (->> (excl/load-workbook file)
               (excl/select-sheet sheet)
               (excl/select-cell cell)
               #_(.getRawValue)
               #_(.getCellFormula)
               #_(.getCellType)
               #_(.getCachedFormulaResultType))]
    (conj prm
          {:cell-val (->> v excl/read-cell)}
          {:raw-val (->> v .getRawValue)}
          {:formula (->> v .getCellFormula)})))

(ns ufo.ping
  (:require
   [clojure.java.io :as io]
   [dk.ative.docjure.spreadsheet :as excl]
   [utils.core :as ut :refer [in? not-empty? dbgv]]))

(defn timed-ping
  "Time an .isReachable ping to a given domain. Doesn't work for hosts in DMZ
  unix ping sends ICMP (Internet Control Message Protocol) ECHO_REQUEST"
  [domain timeout]
  (let [addr (java.net.InetAddress/getByName domain)
        start (. System (nanoTime))
        result (.isReachable addr timeout)
        total (/ (double (- (. System (nanoTime)) start)) 1000000.0)]
    {:time total :result result}))

(defn host-up?
  ";; parallel execution FTW!
  (pmap (fn [{:keys [host port] :as prm}]
                        (host-up? (conj prm {:timeout 500})))
  [{:host \"www.google.com\" :port 80}
])"
  [{:keys [host timeout port] :as prm}]
  (conj prm
        (let [sock-addr (java.net.InetSocketAddress. host (Integer. port))
              start (. System (nanoTime))]
          (try
            (with-open [sock (java.net.Socket.)]
              (. sock connect sock-addr timeout)
              {:res true :time (/ (double (- (. System (nanoTime)) start))
                                  1000000.0)})
            (catch java.io.IOException e
              {:res false :time nil})
            (catch java.net.SocketTimeoutException e
              {:res false :time nil})
            (catch java.net.UnknownHostException e
              {:res false :time nil})))))

(defn read-cell [{:keys [file sheet cell] :as prm}]
  (let [v (->> (excl/load-workbook file)
               (excl/select-sheet sheet)
               (excl/select-cell cell)
               #_(.getRawValue)
               #_(.getCellFormula)
               #_(.getCellType)
               #_(.getCachedFormulaResultType))]
    (conj prm
          {:cell-val (->> v excl/read-cell)}
          {:raw-val (->> v .getRawValue)}
          {:formula (->> v .getCellFormula)})))

Improve docstring of host-up?

Improve docstring of host-up?


(ns cljam.io.bed
  "Functions to read and write the BED (Browser Extensible Data) format. See
  http://genome.ucsc.edu/FAQ/FAQformat#format1 for the detail BED specifications."
  (:require [clojure.java.io :as cio]
            [clojure.string :as cstr]
            [proton.core :refer [as-int as-long]]
            [cljam.io.protocols :as protocols]
            [cljam.util :as util]
            [cljam.util.chromosome :as chr]
            [cljam.util.region :as region]
            [clojure.tools.logging :as logging])
  (:import [java.io BufferedReader BufferedWriter Closeable]))

(declare read-fields write-fields)

(defrecord BEDReader [^BufferedReader reader ^String f]
  Closeable
  (close [this]
    (.close ^Closeable (.reader this)))
  protocols/IReader
  (reader-path [this] (.f this))
  (read [this] (protocols/read this {}))
  (read [this option] (read-fields this))
  (indexed? [_] false)
  protocols/IRegionReader
  (read-in-region [this region]
    (protocols/read-in-region this region {}))
  (read-in-region [this {:keys [chr start end]} option]
    (logging/warn "May cause degradation of performance.")
    (filter (fn [m] (and (or (not chr) (= (:chr m) chr))
                         (or (not start) (<= start (:start m)))
                         (or (not end) (<= (:end m) end))))
            (read-fields this))))

(defrecord BEDWriter [^BufferedWriter writer ^String f]
  Closeable
  (close [this]
    (.close ^Closeable (.writer this)))
  protocols/IWriter
  (writer-path [this] (.getAbsolutePath (cio/file (.f this)))))

(defn ^BEDReader reader
  "Returns an open cljam.io.bed.BEDReader of f. Should be used inside with-open
  to ensure the reader is properly closed."
  [f]
  (let [abs (.getAbsolutePath (cio/file f))]
    (BEDReader. (cio/reader (util/compressor-input-stream abs)) abs)))

(defn ^BEDWriter writer
  "Returns an open cljam.io.bed.BEDWriter of f. Should be used inside with-open
  to ensure the writer is properly closed."
  [f]
  (let [abs (.getAbsolutePath (cio/file f))]
  (BEDWriter. (cio/writer (util/compressor-output-stream abs)) abs)))

(def ^:const bed-columns
  [:chr :start :end :name :score :strand :thick-start :thick-end :item-rgb :block-count :block-sizes :block-starts])

(defn- str->long-list
  "Convert string of comma-separated long values into list of longs.
  Comma at the end of input string will be ignored.
  Returns nil if input is nil."
  [^String s]
  (when-not (nil? s)
    (map as-long (cstr/split s #","))))

(defn- long-list->str
  "Inverse function of str->long-list."
  [xs]
  (when (seq xs)
    (cstr/join "," xs)))

(defn- update-some
  "Same as update if map 'm' contains key 'k'. Otherwise returns the original map 'm'."
  [m k f & args]
  (if (get m k)
    (apply update m k f args)
    m))

(defn- deserialize-bed
  "Parse BED fields string and returns a map.
  Based on information at https://genome.ucsc.edu/FAQ/FAQformat#format1."
  [^String s]
  {:post [;; First 3 fields are required.
          (:chr %) (:start %) (:end %)
          ;; The chromEnd base is not included in the display of the feature.
          (< (:start %) (:end %))
          ;; Lower-numbered fields must be populated if higher-numbered fields are used.
          (every? true? (drop-while false? (map nil? ((apply juxt bed-columns) %))))
          ;; A score between 0 and 1000.
          (if-let [s (:score %)] (<= 0 s 1000) true)
          ;; The number of items in this list should correspond to blockCount.
          (if-let [xs (:block-sizes %)] (= (count xs) (:block-count %)) true)
          ;; The number of items in this list should correspond to blockCount.
          (if-let [xs (:block-starts %)] (= (count xs) (:block-count %)) true)
          ;; The first blockStart value must be 0.
          (if-let [[f] (:block-starts %)] (= 0 f) true)
          ;; The final blockStart position plus the final blockSize value must equal chromEnd.
          (if-let [xs (:block-starts %)] (= (+ (last xs) (last (:block-sizes %))) (- (:end %) (:start %))) true)
          ;; Blocks may not overlap.
          (if-let [xs (:block-starts %)] (apply <= (mapcat (fn [a b] [a (+ a b)]) xs (:block-sizes %))) true)]}
  (reduce
   (fn deserialize-bed-reduce-fn [m [k f]] (update-some m k f))
   (zipmap bed-columns (cstr/split s #"\s+"))
   {:start as-long
    :end as-long
    :score as-long
    :strand #(case % "." :no-strand "+" :plus "-" :minus)
    :thick-start as-long
    :thick-end as-long
    :block-count as-long
    :block-sizes str->long-list
    :block-starts str->long-list}))

(defn- serialize-bed
  "Serialize bed fields into string."
  [m]
  {:pre [;; First 3 fields are required.
         (:chr m) (:start m) (:end m)
         ;; The chromEnd base is not included in the display of the feature.
         (< (:start m) (:end m))
         ;; Lower-numbered fields must be populated if higher-numbered fields are used.
         (every? true? (drop-while false? (map nil? ((apply juxt bed-columns) m))))
         ;; A score between 0 and 1000.
         (if-let [s (:score m)] (<= 0 s 1000) true)
         ;; The number of items in this list should correspond to blockCount.
         (if-let [xs (:block-sizes m)] (= (count xs) (:block-count m)) true)
         ;; The number of items in this list should correspond to blockCount.
         (if-let [xs (:block-starts m)] (= (count xs) (:block-count m)) true)
         ;; The first blockStart value must be 0.
         (if-let [[f] (:block-starts m)] (= 0 f) true)
         ;; The final blockStart position plus the final blockSize value must equal chromEnd.
         (if-let [xs (:block-starts m)] (= (+ (last xs) (last (:block-sizes m))) (- (:end m) (:start m))) true)
         ;; Blocks may not overlap.
         (if-let [xs (:block-starts m)] (apply <= (mapcat (fn [a b] [a (+ a b)]) xs (:block-sizes m))) true)]}
  (->> (-> m
           (update-some :strand #(case % :plus "+" :minus "-" :no-strand "."))
           (update-some :block-sizes long-list->str)
           (update-some :block-starts long-list->str))
       ((apply juxt bed-columns))
       (take-while identity)
       (cstr/join \tab)))

(defn- header-or-comment?
  "Checks if given string is neither a header nor a comment line."
  [^String s]
  (or (empty? s)
      (.startsWith s "browser")
      (.startsWith s "track")
      (.startsWith s "#")))

(defn- normalize
  "Normalize BED fields.
  BED fields are stored in format: 0-origin and inclusive-start / exclusive-end.
  This function converts the coordinate into cljam style: 1-origin and inclusice-start / inclusive-end."
  [m]
  (-> m
      (update :chr chr/normalize-chromosome-key)
      (update :start inc)
      (update-some :thick-start inc)))

(defn- denormalize
  "De-normalize BED fields.
  This is an inverse function of normalize."
  [m]
  (-> m
      (update :start dec)
      (update-some :thick-start dec)))

(defn read-raw-fields
  "Returns a lazy sequence of unnormalized BED fields."
  [^BEDReader rdr]
  (sequence
   (comp (remove header-or-comment?)
         (map deserialize-bed))
   (line-seq (.reader rdr))))

(defn read-fields
  "Returns a lazy sequence of normalized BED fields."
  [^BEDReader rdr]
  (sequence
   (comp (remove header-or-comment?)
         (map deserialize-bed)
         (map normalize))
   (line-seq (.reader rdr))))

(defn sort-fields
  "Sort BED fields based on :chr, :start and :end.
  :chr with common names come first, in order of (chr1, chr2, ..., chrX, chrY, chrM).
  Other chromosomes follow after in lexicographic order."
  [xs]
  (sort-by
   (fn [m]
     [(chr/chromosome-order-key (:chr m))
      (:start m)
      (:end m)])
   xs))

(defn merge-fields
  "Sort and merge overlapped regions.
  Currently, this function affects only :end and :name fields."
  [xs]
  (region/merge-regions-with
   (fn [x {:keys [name end]}]
     (-> x
         (update :end max end)
         (update-some :name str "+" name)))
   0
   (sort-fields xs)))

(defn write-raw-fields
  "Write sequence of BED fields to writer without converting :start and :thick-start values."
  [^BEDWriter wtr xs]
  (let [w ^BufferedWriter (.writer wtr)]
    (->> xs
         (map serialize-bed)
         (cstr/join \newline)
         (.write w))))

(defn write-fields
  "Write sequence of BED fields to writer."
  [^BEDWriter wtr xs]
  (let [w ^BufferedWriter (.writer wtr)]
    (->> xs
         (map (comp serialize-bed denormalize))
         (cstr/join \newline)
         (.write w))))

(ns cljam.io.bed
  "Functions to read and write the BED (Browser Extensible Data) format. See
  http://genome.ucsc.edu/FAQ/FAQformat#format1 for the detail BED specifications."
  (:require [clojure.java.io :as cio]
            [clojure.string :as cstr]
            [proton.core :refer [as-int as-long]]
            [cljam.io.protocols :as protocols]
            [cljam.util :as util]
            [cljam.util.chromosome :as chr]
            [cljam.util.region :as region]
            [clojure.tools.logging :as logging])
  (:import [java.io BufferedReader BufferedWriter Closeable]))

(declare read-fields write-fields)

(defrecord BEDReader [^BufferedReader reader ^String f]
  Closeable
  (close [this]
    (.close ^Closeable (.reader this)))
  protocols/IReader
  (reader-path [this] (.f this))
  (read [this] (protocols/read this {}))
  (read [this option] (read-fields this))
  (indexed? [_] false)
  protocols/IRegionReader
  (read-in-region [this region]
    (protocols/read-in-region this region {}))
  (read-in-region [this {:keys [chr start end]} option]
    (logging/warn "May cause degradation of performance.")
    (filter (fn [m] (and (or (not chr) (= (:chr m) chr))
                         (or (not start) (<= start (:start m)))
                         (or (not end) (<= (:end m) end))))
            (read-fields this))))

(defrecord BEDWriter [^BufferedWriter writer ^String f]
  Closeable
  (close [this]
    (.close ^Closeable (.writer this)))
  protocols/IWriter
  (writer-path [this] (.getAbsolutePath (cio/file (.f this)))))

(defn ^BEDReader reader
  "Returns an open cljam.io.bed.BEDReader of f. Should be used inside with-open
  to ensure the reader is properly closed."
  [f]
  (let [abs (.getAbsolutePath (cio/file f))]
    (BEDReader. (cio/reader (util/compressor-input-stream abs)) abs)))

(defn ^BEDWriter writer
  "Returns an open cljam.io.bed.BEDWriter of f. Should be used inside with-open
  to ensure the writer is properly closed."
  [f]
  (let [abs (.getAbsolutePath (cio/file f))]
  (BEDWriter. (cio/writer (util/compressor-output-stream abs)) abs)))

(def ^:const bed-columns
  [:chr :start :end :name :score :strand :thick-start :thick-end :item-rgb :block-count :block-sizes :block-starts])

(defn- str->long-list
  "Convert string of comma-separated long values into list of longs.
  Comma at the end of input string will be ignored.
  Returns nil if input is nil."
  [^String s]
  (when-not (nil? s)
    (map as-long (cstr/split s #","))))

(defn- long-list->str
  "Inverse function of str->long-list."
  [xs]
  (when (seq xs)
    (cstr/join "," xs)))

(defn- update-some
  "Same as update if map 'm' contains key 'k'. Otherwise returns the original map 'm'."
  [m k f & args]
  (if (get m k)
    (apply update m k f args)
    m))

(defn- deserialize-bed
  "Parse BED fields string and returns a map.
  Based on information at https://genome.ucsc.edu/FAQ/FAQformat#format1."
  [^String s]
  {:post [;; First 3 fields are required.
          (:chr %) (:start %) (:end %)
          ;; The chromEnd base is not included in the display of the feature.
          (< (:start %) (:end %))
          ;; Lower-numbered fields must be populated if higher-numbered fields are used.
          (every? true? (drop-while false? (map nil? ((apply juxt bed-columns) %))))
          ;; A score between 0 and 1000.
          (if-let [s (:score %)] (<= 0 s 1000) true)
          ;; The number of items in this list should correspond to blockCount.
          (if-let [xs (:block-sizes %)] (= (count xs) (:block-count %)) true)
          ;; The number of items in this list should correspond to blockCount.
          (if-let [xs (:block-starts %)] (= (count xs) (:block-count %)) true)
          ;; The first blockStart value must be 0.
          (if-let [[f] (:block-starts %)] (= 0 f) true)
          ;; The final blockStart position plus the final blockSize value must equal chromEnd.
          (if-let [xs (:block-starts %)] (= (+ (last xs) (last (:block-sizes %))) (- (:end %) (:start %))) true)
          ;; Blocks may not overlap.
          (if-let [xs (:block-starts %)] (apply <= (mapcat (fn [a b] [a (+ a b)]) xs (:block-sizes %))) true)]}
  (reduce
   (fn deserialize-bed-reduce-fn [m [k f]] (update-some m k f))
   (zipmap bed-columns (cstr/split s #"\s+"))
   {:start as-long
    :end as-long
    :score as-long
    :strand #(case % "." :no-strand "+" :plus "-" :minus)
    :thick-start as-long
    :thick-end as-long
    :block-count as-long
    :block-sizes str->long-list
    :block-starts str->long-list}))

(defn- serialize-bed
  "Serialize bed fields into string."
  [m]
  {:pre [;; First 3 fields are required.
         (:chr m) (:start m) (:end m)
         ;; The chromEnd base is not included in the display of the feature.
         (< (:start m) (:end m))
         ;; Lower-numbered fields must be populated if higher-numbered fields are used.
         (every? true? (drop-while false? (map nil? ((apply juxt bed-columns) m))))
         ;; A score between 0 and 1000.
         (if-let [s (:score m)] (<= 0 s 1000) true)
         ;; The number of items in this list should correspond to blockCount.
         (if-let [xs (:block-sizes m)] (= (count xs) (:block-count m)) true)
         ;; The number of items in this list should correspond to blockCount.
         (if-let [xs (:block-starts m)] (= (count xs) (:block-count m)) true)
         ;; The first blockStart value must be 0.
         (if-let [[f] (:block-starts m)] (= 0 f) true)
         ;; The final blockStart position plus the final blockSize value must equal chromEnd.
         (if-let [xs (:block-starts m)] (= (+ (last xs) (last (:block-sizes m))) (- (:end m) (:start m))) true)
         ;; Blocks may not overlap.
         (if-let [xs (:block-starts m)] (apply <= (mapcat (fn [a b] [a (+ a b)]) xs (:block-sizes m))) true)]}
  (->> (-> m
           (update-some :strand #(case % :plus "+" :minus "-" :no-strand "."))
           (update-some :block-sizes long-list->str)
           (update-some :block-starts long-list->str))
       ((apply juxt bed-columns))
       (take-while identity)
       (cstr/join \tab)))

(defn- header-or-comment?
  "Checks if given string is neither a header nor a comment line."
  [^String s]
  (or (empty? s)
      (.startsWith s "browser")
      (.startsWith s "track")
      (.startsWith s "#")))

(defn- normalize
  "Normalize BED fields.
  BED fields are stored in format: 0-origin and inclusive-start / exclusive-end.
  This function converts the coordinate into cljam style: 1-origin and inclusive-start / inclusive-end."
  [m]
  (-> m
      (update :chr chr/normalize-chromosome-key)
      (update :start inc)
      (update-some :thick-start inc)))

(defn- denormalize
  "De-normalize BED fields.
  This is an inverse function of normalize."
  [m]
  (-> m
      (update :start dec)
      (update-some :thick-start dec)))

(defn read-raw-fields
  "Returns a lazy sequence of unnormalized BED fields."
  [^BEDReader rdr]
  (sequence
   (comp (remove header-or-comment?)
         (map deserialize-bed))
   (line-seq (.reader rdr))))

(defn read-fields
  "Returns a lazy sequence of normalized BED fields."
  [^BEDReader rdr]
  (sequence
   (comp (remove header-or-comment?)
         (map deserialize-bed)
         (map normalize))
   (line-seq (.reader rdr))))

(defn sort-fields
  "Sort BED fields based on :chr, :start and :end.
  :chr with common names come first, in order of (chr1, chr2, ..., chrX, chrY, chrM).
  Other chromosomes follow after in lexicographic order."
  [xs]
  (sort-by
   (fn [m]
     [(chr/chromosome-order-key (:chr m))
      (:start m)
      (:end m)])
   xs))

(defn merge-fields
  "Sort and merge overlapped regions.
  Currently, this function affects only :end and :name fields."
  [xs]
  (region/merge-regions-with
   (fn [x {:keys [name end]}]
     (-> x
         (update :end max end)
         (update-some :name str "+" name)))
   0
   (sort-fields xs)))

(defn write-raw-fields
  "Write sequence of BED fields to writer without converting :start and :thick-start values."
  [^BEDWriter wtr xs]
  (let [w ^BufferedWriter (.writer wtr)]
    (->> xs
         (map serialize-bed)
         (cstr/join \newline)
         (.write w))))

(defn write-fields
  "Write sequence of BED fields to writer."
  [^BEDWriter wtr xs]
  (let [w ^BufferedWriter (.writer wtr)]
    (->> xs
         (map (comp serialize-bed denormalize))
         (cstr/join \newline)
         (.write w))))

fix typo

fix typo


(ns invadm.core
  (:require [clojure.tools.cli :refer [parse-opts]]
            [clojure.data.json :as json]
            [clojure.java.io :as io]
            [clojure.string :as string])
  (:gen-class))

(def cli-options
  ;; TODO: add clever currency default
  [["-c" "--currency CURRENCY" "Invoice currency"]
   ["-r" "--client CLIENT" "Client"]
   ["-f" "--filename FILENAME" "Attached file"]
   ["-d" "--issue-date ISSUE_DATE" "Issue data"]
   ["-a" "--amount AMOUNT" "Total amount"
    :parse-fn #(Integer/parseInt %)]])

(defn usage [options-summary]
  (->> ["invadm - an invoice manager"
        ""
        "Usage: invadm [options] action"
        ""
        "  invadm create -c CURRENCY -r CLIENT -a AMOUNT [-d ISSUE_DATE] [-f FILENAME] ID"
        "    Creates an invoice."
        ""
        "  invadm list {-c CURRENCY, -r CLIENT, -f FILENAME}"
        "    Lists invoices."
        ""
        "  invadm data {-c CURRENCY, -r CLIENT, -f FILENAME}"
        "    Dump all the data in a JSON array."]
       (string/join \newline)))

(defn error-msg [errors]
  (str (string/join \newline errors)))

(defn exit [status msg]
  (println msg)
  (System/exit status))

(defn read-json [file]
  (json/read-str (slurp file)))

(defn write-json [file value]
  (with-open [w (io/writer file)]
    (.write w (json/write-str value))))

(defn id-to-filename [id]
  (str id ".json"))

(defn create [options arguments]
  (cond
    (not (:currency options)) (exit 1 (error-msg ["-c CURRENCY is required"]))
    (not (:client options)) (exit 1 (error-msg ["-r CLIENT is required"]))
    (not (:amount options)) (exit 1 (error-msg ["-a AMOUNT is required"]))
    (not (get arguments 1)) (exit 1 (error-msg ["invoice id is required"])))
  (write-json (id-to-filename (get arguments 1)) (assoc options "id" (get arguments 1))))

(defn cwd []
  (System/getProperty "user.dir"))

(defn get-invoice-filenames []
  (filter #(.endsWith % ".json") (map #(.getName %) (file-seq (io/file (cwd))))))

(defn read-all-invoices []
  (map read-json (get-invoice-filenames)))

(defn options-to-filter [options]
  (fn [invoice]
    (every? #(= (get options %) (get invoice (name %))) (keys options))))

(defn data [options]
  (println (json/write-str (filter (options-to-filter options) (read-all-invoices)))))

(defn list_ [options]
  (println (json/write-str (filter (options-to-filter options) (read-all-invoices)))))

(defn -main [& args]
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    ;; Handle help and error conditions
    (cond
      (:help options) (exit 0 (usage summary))
      errors (exit 1 (error-msg errors)))
    ;; Execute program with options
    (case (first arguments)
      "create" (create options arguments)
      "data" (data options)
      "list" (list_ options)
      (exit 1 (usage summary)))))

(ns invadm.core
  (:require [clojure.tools.cli :refer [parse-opts]]
            [clojure.data.json :as json]
            [clojure.java.io :as io]
            [clojure.string :as string])
  (:gen-class))

(def cli-options
  ;; TODO: add clever currency default
  [["-c" "--currency CURRENCY" "Invoice currency"]
   ["-r" "--client CLIENT" "Client"]
   ["-f" "--filename FILENAME" "Attached file"]
   ["-d" "--issue-date ISSUE_DATE" "Issue data"]
   ["-a" "--amount AMOUNT" "Total amount"
    :parse-fn #(Integer/parseInt %)]])

(defn usage [options-summary]
  (->> ["invadm - an invoice manager"
        ""
        "Usage: invadm [options] action"
        ""
        "  invadm create -c CURRENCY -r CLIENT -a AMOUNT [-d ISSUE_DATE] [-f FILENAME] ID"
        "    Creates an invoice."
        ""
        "  invadm list {-c CURRENCY, -r CLIENT, -f FILENAME}"
        "    Lists invoices."
        ""
        "  invadm data {-c CURRENCY, -r CLIENT, -f FILENAME}"
        "    Dump all the data in a JSON array."]
       (string/join \newline)))

(defn error-msg [errors]
  (str (string/join \newline errors)))

(defn exit [status msg]
  (println msg)
  (System/exit status))

(defn read-json [file]
  (json/read-str (slurp file)))

(defn write-json [file value]
  (with-open [w (io/writer file)]
    (.write w (json/write-str value))))

(defn id-to-filename [id]
  (str id ".json"))

(defn create [options arguments]
  (cond
    (not (:currency options)) (exit 1 (error-msg ["-c CURRENCY is required"]))
    (not (:client options)) (exit 1 (error-msg ["-r CLIENT is required"]))
    (not (:amount options)) (exit 1 (error-msg ["-a AMOUNT is required"]))
    (not (get arguments 1)) (exit 1 (error-msg ["invoice id is required"])))
  (write-json (id-to-filename (get arguments 1)) (assoc options "id" (get arguments 1))))

(defn cwd []
  (System/getProperty "user.dir"))

(defn get-invoice-filenames []
  (filter #(.endsWith % ".json") (map #(.getName %) (file-seq (io/file (cwd))))))

(defn read-all-invoices []
  (map read-json (get-invoice-filenames)))

(defn options-to-filter [options]
  (fn [invoice]
    (every? #(= (get options %) (get invoice (name %))) (keys options))))

(defn pretty-print-invoice [invoice]
  (format (->> ["Invoice #%s"
                "Client: %s"
                "Amount: %d %s\n"]
               (string/join \newline))
          (get invoice "id")
          (get invoice "client")
          (get invoice "amount")
          (get invoice "currency")))

(defn data [options]
  (println (json/write-str (filter (options-to-filter options) (read-all-invoices)))))

(defn list_ [options]
  (apply println (map pretty-print-invoice (filter (options-to-filter options) (read-all-invoices)))))

(defn -main [& args]
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    ;; Handle help and error conditions
    (cond
      (:help options) (exit 0 (usage summary))
      errors (exit 1 (error-msg errors)))
    ;; Execute program with options
    (case (first arguments)
      "create" (create options arguments)
      "data" (data options)
      "list" (list_ options)
      (exit 1 (usage summary)))))

Make `invadm list` pretty-print invoices


(ns backloggery.data.steam
  (:require [clj-http.client :as http])
  (:require [clojure.data.xml :as xml])
  (:require [backloggery.flags :refer :all])
  (:require [backloggery.data.default :refer [read-games]]))

(register-flags ["--steam-name" "Steam Community name"]
                ["--steam-platform" "Default platform to use for Steam games (recommended: PC, PCDL, or Steam)" :default "PC"])

(defn- xml-to-map
  [tag]
    (let [tag-content (fn [tag] [(:tag tag) (apply str (:content tag))])]
      (into {} (map tag-content (:content tag)))))

(defmethod read-games "steam" [_]
  (let [name (:steam-name *opts*)
        url (str "http://steamcommunity.com/id/" name "/games?tab=all&xml=1")]
    (->> url http/get :body xml/parse-str xml-seq (filter #(= :game (:tag %)))
      (map (comp :name xml-to-map))
      sort
      (map (fn [name] { :name name :platform (:steam-platform *opts*) :progress "unplayed" })))))

(ns backloggery.data.steam
  (:require [clj-http.client :as http])
  (:require [clojure.data.xml :as xml])
  (:require [clojure.string :refer [trim]])
  (:require [backloggery.flags :refer :all])
  (:require [backloggery.data.default :refer [read-games]]))

(register-flags ["--steam-name" "Steam Community name"]
                ["--steam-platform" "Default platform to use for Steam games (recommended: PC, PCDL, or Steam)" :default "PC"])

(defn- xml-to-map
  [tag]
    (let [tag-content (fn [tag] [(:tag tag) (apply str (:content tag))])]
      (into {} (map tag-content (:content tag)))))

(defmethod read-games "steam" [_]
  (let [name (:steam-name *opts*)
        url (str "http://steamcommunity.com/id/" name "/games?tab=all&xml=1")]
    (->> url http/get :body xml/parse-str xml-seq (filter #(= :game (:tag %)))
      (map (comp trim :name xml-to-map))
      sort
      (map (fn [name] { :name name :platform (:steam-platform *opts*) :progress "unplayed" })))))

Trim whitespace from game names when reading from steam


(ns quil-cljs-examples.bezier
	(:require [quil.core :as q])
	(:use-macros [quil.core :only [defsketch]]))

(defn draw []
	(q/background 255)
	(q/no-fill)
	(q/stroke 0 0 0)
	(q/bezier 85 20 10 10 90 90 15 80)

	(q/fill 255)
	(doseq [i (range 10)]
		(q/ellipse (q/bezier-point 85 10 90 15 (/ i 10.0))
				   (q/bezier-point 20 10 90 80 (/ i 10.0))
				   5 5)))

(defsketch bezier
	:host "bezier"
	:draw draw
	:size [300 300])

(ns quil-cljs-examples.bezier
	(:require [quil.core :as q])
	(:use-macros [quil.core :only [defsketch]]))

(defn draw []
	(q/background 255)
	(q/no-fill)
	(q/stroke 0 0 0)
	(q/bezier 85 20 10 10 90 90 15 80)

	(q/fill 255)
	(doseq [i (range 10)]
		(let [x  (q/bezier-point 85 10 90 15 (/ i 10.0))
			  y  (q/bezier-point 20 10 90 80 (/ i 10.0))
			  tx (q/bezier-tangent 85 19 90 15 (/ i 10.0))
			  ty (q/bezier-tangent 20 10 90 80 (/ i 10.0))
			  a  (+ q/PI (q/atan2 ty tx))
			  x2 (+ x (* 30 (q/cos a)))
			  y2 (+ y (* 30 (q/sin a)))]
			  (q/stroke 255 102 0)
			  (q/line x y x2 y2)
			  (q/stroke 0)
			  (q/ellipse x y 5 5))))

(defsketch bezier
	:host "bezier"
	:draw draw
	:size [300 300])

Add bezier-tangent to curve/bezier.cljs example.


(ns quil-cljs-examples.bezier
	(:require [quil.core :as q])
	(:use-macros [quil.core :only [defsketch]]))

(defn draw []
	(q/background 255)
	(q/no-fill)
	(q/stroke 0 0 0)
	(q/bezier 85 20 10 10 90 90 15 80))

(defsketch bezier
	:host "bezier"
	:draw draw
	:size [300 300])

(ns quil-cljs-examples.bezier
	(:require [quil.core :as q])
	(:use-macros [quil.core :only [defsketch]]))

(defn draw []
	(q/background 255)
	(q/no-fill)
	(q/stroke 0 0 0)
	(q/bezier 85 20 10 10 90 90 15 80)

	(q/fill 255)
	(doseq [i (range 10)]
		(q/ellipse (q/bezier-point 85 10 90 15 (/ i 10.0))
				   (q/bezier-point 20 10 90 80 (/ i 10.0))
				   5 5)))

(defsketch bezier
	:host "bezier"
	:draw draw
	:size [300 300])

Add bezier-point to curve/bezier.cljs example.


(ns fleetdb.core
  (use (fleetdb util)))

(defn init []
  {:rmap (sorted-map)
   :imap (sorted-map)})

(defn- index-insert [index on record]
  (let [val (on record)]
    (if (not (nil? val))
      (assoc index val (:id record)))))

(defn- indexes-insert [imap record]
  (reduce
    (fn [int-imap [on index]]
      (if-let [new-index (index-insert index on record)]
        (assoc int-imap on new-index)
        int-imap))
    imap imap))

(defn- index-delete [index on record]
  (let [val (on record)]
    (if (not (nil? val))
      (dissoc index val))))

(defn- indexes-delete [imap record]
  (reduce
    (fn [int-imap [on index]]
      (if-let [new-index (index-delete index on record)]
        (assoc int-imap on new-index)
        int-imap))
    imap imap))

(defn- q-insert [db {:keys [records]}]
  (let [{old-rmap :rmap old-imap :imap} db
        [new-rmap new-imap]
          (reduce
            (fn [[int-rmap int-imap] record]
              (let [id (:id record)]
                (assert id)
                (assert (not (contains? int-rmap id)))
                [(assoc int-rmap id record)
                 (indexes-insert int-imap record)]))
            [old-rmap old-imap]
            records)]
    [(assoc db :rmap new-rmap :imap new-imap) (count records)]))

(def- conj-op?
  #{:and :or})

(def- conj-op-fns
  {:and and? :or or?})

(def- sing-op?
  #{:= :!= :< :> :<= :> :>=})

(def- sing-op-fns
  {:= = :!= != :< < :<= <= :> > :>= >=})

(def- doub-op?
  #{:>< :>=< :><= :>=<=})

(def- doub-op-fns
  {:>< [> <] :>=< [>= <] :><= [> <=] :>=<= [>= <=]})

(defn- where-pred [[op & wrest]]
  (cond
    (conj-op? op)
      (let [subpreds (map #(where-pred %) wrest)
            conj-op-fn  (conj-op-fns op)]
        (fn [record]
          (conj-op-fn (map #(% record) subpreds))))
    (sing-op? op)
      (let [[attr val]  wrest
            sing-op-fn (sing-op-fns op)]
        (fn [record]
          (sing-op-fn (attr record) val)))
    (doub-op? op)
      (let [[attr [val1 val2]] wrest
            [doub-op-fn1 doub-op-fn2]      (doub-op-fns op)]
        (fn [record]
          (let [record-val (attr record)]
            (and (doub-op-fn1 record-val val1)
                 (doub-op-fn2 record-val val2)))))
    (= op :in)
      (let [[attr val-vec] wrest
            val-set        (set val-vec)]
        (fn [record]
          (contains? val-set (attr record))))
    (nil? op)
      (constantly true)
    :else
      (raise (str "where op " op " not recognized"))))

(defn- order-keyfn [attr dir]
  (assert (#{:asc :dsc} dir))
  (if (= dir :asc)
    (fn [record-a record-b]
      (compare (attr record-a) (attr record-b)))
    (fn [record-a record-b]
      (compare (attr record-b) (attr record-a)))))

(defn- apply-order [records order]
  (if-let [[attr dir] order]
    (sort (order-keyfn attr dir) records)
    records))

(defn- apply-offset [records offset]
  (if offset (drop offset records) records))

(defn- apply-limit [records limit]
  (if limit (take limit records) records))

(defn- find-records [records {:keys [where order offset limit]}]
  (-> (filter (where-pred where) records)
    (apply-order order)
    (apply-offset offset)
    (apply-limit limit)))

(defn- apply-only [records only]
  (if only
    (map #(select-keys % only) records))
    records)

(defn- q-select [db {:keys [only] :as opts}]
  (-> (find-records (vals (:rmap db)) opts)
    (apply-only only)))

(defn- q-count [db opts]
  (count (find-records (vals (:rmap db)) opts)))

(defn- q-update [db {:keys [with] :as opts}]
  (assert with)
  (let [{old-rmap :rmap old-imap :imap} db
        old-records     (find-records (vals old-rmap) opts)
        num-old-records (count old-records)
        [new-rmap new-imap]
          (reduce
            (fn [[int-rmap int-imap] old-record]
              (let [new-record (merge-compact old-record with)
                    aug-rmap   (assoc int-rmap (:id old-record) new-record)
                    aug-imap   (-> int-imap
                                 (indexes-delete old-record)
                                 (indexes-insert new-record))]
                [aug-rmap aug-imap]))
            [old-rmap old-imap]
            old-records)]
    [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

(defn- q-delete [db opts]
  (let [{old-rmap :rmap old-imap :imap} db
        old-records (find-records (vals old-rmap) opts)
        num-old-records (count old-records)
        [new-rmap new-imap]
          (reduce
            (fn [[int-rmap int-imap] old-record]
              (let [aug-rmap (dissoc int-rmap (:id old-record))
                    aug-imap (indexes-delete int-imap old-record)]
                [aug-rmap aug-imap]))
            [old-rmap old-imap]
            old-records)]
    [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

(defn- q-create-index [db {:keys [on where]}]
  (let [records (vals (:rmap db))
        index
          (reduce
            (fn [int-index record]
              (if-let [val (on record)]
                (assoc int-index val (:id record))
                int-index))
            (sorted-map)
            records)]
    [(assoc-in db [:imap on] index) (count index)]))

(defn- q-drop-index [db {:keys [on]}]
  (let [index (get-in db [:imap on])]
    [(update-in db [:imap] dissoc on) (count index)]))

(defn- q-list-indexes [db opts]
  (vec (keys (:imap db))))

(declare exec)

(defn- q-mread [db queries]
  (vec
    (map (fn [query] (exec db query))
         queries)))

(def- query-fns
  {:select       q-select
   :count        q-count
   :insert       q-insert
   :update       q-update
   :delete       q-delete
   :create-index q-create-index
   :drop-index   q-drop-index
   :list-indexes q-list-indexes
   :mread        q-mread})

(defn exec [db [query-type opts]]
  (if-let [queryfn (query-fns query-type)]
    (queryfn db opts)
    (raise "query type not recognized")))

(ns fleetdb.core
  (use (fleetdb util)))

(defn init []
  {:rmap (sorted-map)
   :imap (sorted-map)})

(defn- index-insert [index on record]
  (let [val (on record)]
    (if (not (nil? val))
      (assoc index val (:id record)))))

(defn- indexes-insert [imap record]
  (reduce
    (fn [int-imap [on index]]
      (if-let [new-index (index-insert index on record)]
        (assoc int-imap on new-index)
        int-imap))
    imap imap))

(defn- index-delete [index on record]
  (let [val (on record)]
    (if (not (nil? val))
      (dissoc index val))))

(defn- indexes-delete [imap record]
  (reduce
    (fn [int-imap [on index]]
      (if-let [new-index (index-delete index on record)]
        (assoc int-imap on new-index)
        int-imap))
    imap imap))

(defn- q-insert [db {:keys [records]}]
  (let [{old-rmap :rmap old-imap :imap} db
        [new-rmap new-imap]
          (reduce
            (fn [[int-rmap int-imap] record]
              (let [id (:id record)]
                (assert id)
                (assert (not (contains? int-rmap id)))
                [(assoc int-rmap id record)
                 (indexes-insert int-imap record)]))
            [old-rmap old-imap]
            records)]
    [(assoc db :rmap new-rmap :imap new-imap) (count records)]))

(def- conj-op?
  #{:and :or})

(def- conj-op-fns
  {:and and? :or or?})

(def- sing-op?
  #{:= :!= :< :> :<= :> :>=})

(def- sing-op-fns
  {:= = :!= != :< < :<= <= :> > :>= >=})

(def- doub-op?
  #{:>< :>=< :><= :>=<=})

(def- doub-op-fns
  {:>< [> <] :>=< [>= <] :><= [> <=] :>=<= [>= <=]})

(defn- where-pred [[op & wrest]]
  (cond
    (conj-op? op)
      (let [subpreds (map #(where-pred %) wrest)
            conj-op-fn  (conj-op-fns op)]
        (fn [record]
          (conj-op-fn (map #(% record) subpreds))))
    (sing-op? op)
      (let [[attr val]  wrest
            sing-op-fn (sing-op-fns op)]
        (fn [record]
          (sing-op-fn (attr record) val)))
    (doub-op? op)
      (let [[attr [val1 val2]] wrest
            [doub-op-fn1 doub-op-fn2]      (doub-op-fns op)]
        (fn [record]
          (let [record-val (attr record)]
            (and (doub-op-fn1 record-val val1)
                 (doub-op-fn2 record-val val2)))))
    (= op :in)
      (let [[attr val-vec] wrest
            val-set        (set val-vec)]
        (fn [record]
          (contains? val-set (attr record))))
    (nil? op)
      (constantly true)
    :else
      (raise (str "where op " op " not recognized"))))

(defn- order-keyfn [attr dir]
  (assert (#{:asc :dsc} dir))
  (if (= dir :asc)
    (fn [record-a record-b]
      (compare (attr record-a) (attr record-b)))
    (fn [record-a record-b]
      (compare (attr record-b) (attr record-a)))))

(defn- apply-order [records order]
  (if-let [[attr dir] order]
    (sort (order-keyfn attr dir) records)
    records))

(defn- apply-offset [records offset]
  (if offset (drop offset records) records))

(defn- apply-limit [records limit]
  (if limit (take limit records) records))

(defn- find-records [records {:keys [where order offset limit]}]
  (-> (filter (where-pred where) records)
    (apply-order order)
    (apply-offset offset)
    (apply-limit limit)))

(defn- apply-only [records only]
  (if only
    (map #(select-keys % only) records))
    records)

(defn- q-select [db {:keys [only] :as opts}]
  (-> (find-records (vals (:rmap db)) opts)
    (apply-only only)))

(defn- q-count [db opts]
  (count (find-records (vals (:rmap db)) opts)))

(defn- q-update [db {:keys [with] :as opts}]
  (assert with)
  (let [{old-rmap :rmap old-imap :imap} db
        old-records     (find-records (vals old-rmap) opts)
        num-old-records (count old-records)
        [new-rmap new-imap]
          (reduce
            (fn [[int-rmap int-imap] old-record]
              (let [new-record (merge-compact old-record with)
                    aug-rmap   (assoc int-rmap (:id old-record) new-record)
                    aug-imap   (-> int-imap
                                 (indexes-delete old-record)
                                 (indexes-insert new-record))]
                [aug-rmap aug-imap]))
            [old-rmap old-imap]
            old-records)]
    [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

(defn- q-delete [db opts]
  (let [{old-rmap :rmap old-imap :imap} db
        old-records (find-records (vals old-rmap) opts)
        num-old-records (count old-records)
        [new-rmap new-imap]
          (reduce
            (fn [[int-rmap int-imap] old-record]
              (let [aug-rmap (dissoc int-rmap (:id old-record))
                    aug-imap (indexes-delete int-imap old-record)]
                [aug-rmap aug-imap]))
            [old-rmap old-imap]
            old-records)]
    [(assoc db :rmap new-rmap :imap new-imap) num-old-records]))

(defn- q-create-index [db {:keys [on where]}]
  (let [records (vals (:rmap db))
        index
          (reduce
            (fn [int-index record]
              (if-let [val (on record)]
                (assoc int-index val (:id record))
                int-index))
            (sorted-map)
            records)]
    [(assoc-in db [:imap on] index) (count index)]))

(defn- q-drop-index [db {:keys [on]}]
  (let [index (get-in db [:imap on])]
    [(update-in db [:imap] dissoc on) (count index)]))

(defn- q-list-indexes [db opts]
  (vec (keys (:imap db))))

(declare exec)

(defn- q-multi-read [db queries]
  (vec
    (map (fn [query] (exec db query))
         queries)))

(def- query-fns
  {:select       q-select
   :count        q-count
   :insert       q-insert
   :update       q-update
   :delete       q-delete
   :create-index q-create-index
   :drop-index   q-drop-index
   :list-indexes q-list-indexes
   :multi-read   q-multi-read})

(defn exec [db [query-type opts]]
  (if-let [queryfn (query-fns query-type)]
    (queryfn db opts)
    (raise "query type not recognized")))

Rename mread to multi-read.

Rename mread to multi-read.


(ns discuss.communication
  "Functions concerning the communication with the remote discussion system."
  (:require [ajax.core :refer [GET POST]]
            [clojure.walk :refer [keywordize-keys]]
            [cognitect.transit :as transit]
            [discuss.config :as config]
            [discuss.debug :as debug]
            [discuss.history :as history]
            [discuss.lib :as lib]))

;; Auxiliary functions
(def r (transit/reader :json))

(defn make-url
  "Add prefix if not provided."
  [url]
  (str (:host config/api) url))

(defn token-header
  "Return token header for ajax request if user is logged in."
  []
  (when (lib/logged-in?)
    {"X-Messaging-Token" (lib/get-token)}))

;; Handlers
(defn error-handler
  "Generic error handler for ajax requests."
  [{:keys [status status-text]}]
  (.log js/console (str "something bad happened: " status " " status-text))
  (lib/loading? false))

(defn ajax-get
  "Make ajax call to dialogue based argumentation system."
  [url]
  (debug/update-debug :last-api url)
  (GET (make-url url)
       {:handler lib/update-all-states!
        :headers (token-header)
        :error-handler error-handler})
  (lib/loading? true))

(defn success-handler [response]
  (let [res (keywordize-keys (transit/read r response))
        error (:error res)
        url (:url res)]
    (if (< 0 (count error))
      (.log js/console error)
      (do
        (lib/hide-add-form)
        (ajax-get url)))))

(defn init!
  "Initialize initial data from API."
  []
  (let [url (:init config/api)]
    (lib/update-state-item! :layout :add? (fn [_] false))
    (discuss.communication/ajax-get url)))

;; Discussion-related functions
(defn post-statement [statement reference add-type]
  (let [id   (get-in @lib/app-state [:issues :uid])
        slug (get-in @lib/app-state [:issues :slug])
        url  (str (:base config/api) (get-in config/api [:add add-type]))]
    (POST (make-url url)
          {:body            (lib/clj->json {:statement statement
                                            :reference reference
                                            :issue_id id
                                            :slug slug})
           :handler         success-handler
           :error-handler   error-handler
           :format          :json
           :response-format :json
           :headers         (merge {"Content-Type" "application/json"}
                                   (token-header))
           :keywords?       true})
    (lib/update-state-item! :layout :add-type (fn [_] nil))))

(defn dispatch-add-action
  "Check which action needs to be performed based on the type previously stored in the app-state."
  [statement reference]
  (let [action (get-in @lib/app-state [:layout :add-type])]
    (cond
      (= action :add-start-statement) (post-statement statement reference :add-start-statement)
      (= action :add-start-premise)   (post-statement statement reference :add-start-premise)
      (= action :add-justify-premise) (post-statement statement reference :add-justify-premise)
      :else (println "Action not found:" action))))

(defn prepare-add
  "Save current add-method and show add form."
  [add-type]
  (lib/update-state-item! :layout :add-type (fn [_] add-type))
  (lib/show-add-form))

(defn item-click
  "Prepare which action has to be done when clicking an item."
  [id url]
  (lib/hide-add-form)
  (cond
    (= id "item_start_statement") (prepare-add :add-start-statement)
    (= id "item_start_premise")   (prepare-add :add-start-premise)
    (= id "item_justify_premise") (prepare-add :add-justify-premise)
    (= url "add")  (prepare-add "add")
    :else (ajax-get url)))

(ns discuss.communication
  "Functions concerning the communication with the remote discussion system."
  (:require [ajax.core :refer [GET POST]]
            [clojure.walk :refer [keywordize-keys]]
            [cognitect.transit :as transit]
            [discuss.config :as config]
            [discuss.debug :as debug]
            [discuss.lib :as lib]))

;; Auxiliary functions
(def r (transit/reader :json))

(defn make-url
  "Add prefix if not provided."
  [url]
  (str (:host config/api) url))

(defn token-header
  "Return token header for ajax request if user is logged in."
  []
  (when (lib/logged-in?)
    {"X-Messaging-Token" (lib/get-token)}))

;; Handlers
(defn error-handler
  "Generic error handler for ajax requests."
  [{:keys [status status-text]}]
  (.log js/console (str "something bad happened: " status " " status-text))
  (lib/loading? false))

(defn ajax-get
  "Make ajax call to dialogue based argumentation system."
  [url]
  (debug/update-debug :last-api url)
  (GET (make-url url)
       {:handler lib/update-all-states!
        :headers (token-header)
        :error-handler error-handler})
  (lib/loading? true))

(defn success-handler [response]
  (let [res (keywordize-keys (transit/read r response))
        error (:error res)
        url (:url res)]
    (if (< 0 (count error))
      (.log js/console error)
      (do
        (lib/hide-add-form)
        (lib/update-state-item! :layout :add-type (fn [_] nil))
        (ajax-get url)))))

(defn init!
  "Initialize initial data from API."
  []
  (let [url (:init config/api)]
    (lib/update-state-item! :layout :add? (fn [_] false))
    (discuss.communication/ajax-get url)))

;; Discussion-related functions
(defn get-conclusion-id
  "Returns statement id to which the newly added statement is referred to.
   Currently this is stored in the data_statement_uid of the first bubble."
  []
  (let [bubble (first (lib/get-bubbles))]
    (:data_statement_uid bubble)))

(defn post-statement [statement reference add-type]
  (let [id            (get-in @lib/app-state [:issues :uid])
        slug          (get-in @lib/app-state [:issues :slug])
        conclusion-id (get-conclusion-id)          ; Relevant for add-start-premise
        supportive?   (get-in @lib/app-state [:discussion :is_supportive])
        url           (str (:base config/api) (get-in config/api [:add add-type]))]
    (POST (make-url url)
          {:body            (lib/clj->json {:statement statement
                                            :reference reference
                                            :conclusion_id conclusion-id
                                            :supportive supportive?
                                            :issue_id id
                                            :slug slug})
           :handler         success-handler
           :error-handler   error-handler
           :format          :json
           :response-format :json
           :headers         (merge {"Content-Type" "application/json"}
                                   (token-header))
           :keywords?       true})))

(defn dispatch-add-action
  "Check which action needs to be performed based on the type previously stored in the app-state."
  [statement reference]
  (let [action (get-in @lib/app-state [:layout :add-type])]
    (cond
      (= action :add-start-statement) (post-statement statement reference :add-start-statement)
      (= action :add-start-premise)   (post-statement [statement] reference :add-start-premise)
      (= action :add-justify-premise) (post-statement [statement] reference :add-justify-premise)
      :else (println "Action not found:" action))))

(defn prepare-add
  "Save current add-method and show add form."
  [add-type]
  (lib/update-state-item! :layout :add-type (fn [_] add-type))
  (lib/show-add-form))

(defn item-click
  "Prepare which action has to be done when clicking an item."
  [id url]
  (lib/hide-add-form)
  (cond
    (= id "item_start_statement") (prepare-add :add-start-statement)
    (= id "item_start_premise")   (prepare-add :add-start-premise)
    (= id "item_justify_premise") (prepare-add :add-justify-premise)
    (= url "add")  (prepare-add "add")
    :else (ajax-get url)))

Tidy up, add more fields to api request, remove add-type when api call was successful