;; Note that under the cover there are two different kinds of communications with the fabric backend
;; that trigger different events to be emitted back to the application’s handlers:
;; - the grpc client with the orderer service uses a “regular” stateless HTTP connection in
;;      a request/response fashion with the “broadcast” call. The method implementation should emit
;;      “transaction submitted” when a successful acknowledgement is received in the response, or
;;      “error” when an error is received
;; - The method implementation should also maintain a persistent connection with the Chain’s
;;      event source Peer as part of the internal event hub mechanism in order to support
;;      the fabric events “BLOCK”, “CHAINCODE” and “TRANSACTION”. These events should cause
;;      the method to emit “complete” or “error” events to the application
(ns clojure-fabric.grpc-core
  (:import [org.hyperledger.fabric.protos.peer Chaincode$ChaincodeID
            Chaincode$ChaincodeSpec Chaincode$ChaincodeInput Chaincode$ChaincodeSpec$Type
            Chaincode$ChaincodeInvocationSpec
            ProposalPackage$ChaincodeHeaderExtension]
           [org.hyperledger.fabric.protos.common Common$ChannelHeader Common$HeaderType]
           [com.google.protobuf ByteString Timestamp]))

(defn make-chaincode-id
  ([name]
   (make-chaincode-id name {}))
  ([name {:keys [version path] :or {version "" path ""}}]
   (-> (Chaincode$ChaincodeID/newBuilder)
       (.setName name)
       (.setVersion version)
       (.setPath path)
       (.build))))

(defn make-chaincode-input
  ([args]
   (-> (Chaincode$ChaincodeInput/newBuilder)
       (.addAllArgs args)
       (.build)))
  ;; FIXME: can't find deatails on decorations
  #_
  ([args decorations]
   (-> (Chaincode$ChaincodeInput/newBuilder)
       (.addAllArgs args))))

(defn make-chaincode-spec
  ([chaincode-id input]
   (-> (Chaincode$ChaincodeSpec/newBuilder)
       (.setType Chaincode$ChaincodeSpec$Type/GOLANG)
       (.setChaincodeId ^Chaincode$ChaincodeID chaincode-id)
       (.setInput ^Chaincode$ChaincodeInput input)
       (.build)))
  ;; FIXME: use of timeout
  #_
  ([type chaincode-id input timeout]
   (-> (Chaincode$ChaincodeSpec/newBuilder)
       (.setType)
       (.setChaincodeId)
       (.setInput)
       (.setTimeout)
       (.build))))

(defn make-chaincode-invocation-spec
  ([^Chaincode$ChaincodeSpec chaincode-spec]
   (-> (Chaincode$ChaincodeInvocationSpec/newBuilder)
       (.setChaincodeSpec chaincode-spec)))
  ;; FIXME: setIdGenerationAlg
  #_
  ([^Chaincode$ChaincodeSpec chaincode-spec id-generation-alg]
   (-> (Chaincode$ChaincodeInvocationSpec/newBuilder)
       (.setChaincodeSpec chaincode-spec)
       (.setIdGenerationAlg id-generation-alg))))

(defn make-chaincode-header-extention
  ([chaincode-id]
   (make-chaincode-header-extention chaincode-id ByteString/EMPTY))
  ([^Chaincode$ChaincodeID chaincode-id payload-visibility]
   (-> (ProposalPackage$ChaincodeHeaderExtension/newBuilder)
       (.setChaincodeId chaincode-id)
       ;; FIXME: payload-visibility is ByteString
       ;; Use above arity 1 function - currently all other SDKs do this
       (.setPayloadVisibility payload-visibility)
       (.build))))

(defn make-current-grpc-timestamp
  []
  (let [now (System/currentTimeMillis)]
    (-> (Timestamp/newBuilder)
        (.setSeconds (quot now 1000))
        (.setNanos (-> now (rem 1000) (* 10000000)))
        (.build))))

(defn make-channel-header
  ([type version channel-id tx-id epoch]
   (make-channel-header type version channel-id tx-id epoch ByteString/EMPTY))
  ([type version channel-id tx-id epoch extension]
   (let [now (System/currentTimeMillis)]
    (-> (Common$ChannelHeader/newBuilder)
        (.setType type)
        (.setVersion version)
        (.setTimestamp ^Timestamp (make-current-grpc-timestamp))
        (.setChannelId ^Chaincode$ChaincodeID channel-id)
        (.setTxId tx-id)
        (.setEpoch epoch)
        (.setExtension extension)
        (.build)))))

(defn make-chaincode-header
  [^Chaincode$ChaincodeID chaincode-id channel-id tx-id epoch]
  (make-channel-header Common$HeaderType/ENDORSER_TRANSACTION ; type
                       1                ; version
                       channel-id
                       tx-id
                       epoch
                       (make-chaincode-header-extention chaincode-id)))

;; Note that under the cover there are two different kinds of communications with the fabric backend
;; that trigger different events to be emitted back to the application’s handlers:
;; - the grpc client with the orderer service uses a “regular” stateless HTTP connection in
;;      a request/response fashion with the “broadcast” call. The method implementation should emit
;;      “transaction submitted” when a successful acknowledgement is received in the response, or
;;      “error” when an error is received
;; - The method implementation should also maintain a persistent connection with the Chain’s
;;      event source Peer as part of the internal event hub mechanism in order to support
;;      the fabric events “BLOCK”, “CHAINCODE” and “TRANSACTION”. These events should cause
;;      the method to emit “complete” or “error” events to the application
(ns clojure-fabric.grpc-core
  (:import [org.hyperledger.fabric.protos.peer Chaincode$ChaincodeID Chaincode$ChaincodeSpec
            Chaincode$ChaincodeInput Chaincode$ChaincodeSpec$Type Chaincode$ChaincodeInvocationSpec
            ProposalPackage$ChaincodeHeaderExtension ProposalPackage$ChaincodeProposalPayload
            ProposalPackage$Proposal]
           [org.hyperledger.fabric.protos.common Common$ChannelHeader Common$HeaderType
            Common$Header Common$SignatureHeader]
           [com.google.protobuf ByteString Timestamp]))

;;;
;;; Low level functions
;;;

(defn make-chaincode-id
  ([name]
   (make-chaincode-id name {}))
  ([name {:keys [version path] :or {version "" path ""}}]
   (-> (Chaincode$ChaincodeID/newBuilder)
       (.setName name)
       (.setVersion version)
       (.setPath path)
       (.build))))

(defn make-chaincode-input
  ([args]
   (-> (Chaincode$ChaincodeInput/newBuilder)
       (.addAllArgs args)
       (.build)))
  ;; FIXME: can't find deatails on decorations
  #_
  ([args decorations]
   (-> (Chaincode$ChaincodeInput/newBuilder)
       (.addAllArgs args))))

(defn make-chaincode-spec
  ([chaincode-id input]
   (-> (Chaincode$ChaincodeSpec/newBuilder)
       (.setType Chaincode$ChaincodeSpec$Type/GOLANG)
       (.setChaincodeId ^Chaincode$ChaincodeID chaincode-id)
       (.setInput ^Chaincode$ChaincodeInput input)
       (.build)))
  ;; FIXME: use of timeout
  #_
  ([type chaincode-id input timeout]
   (-> (Chaincode$ChaincodeSpec/newBuilder)
       (.setType)
       (.setChaincodeId)
       (.setInput)
       (.setTimeout)
       (.build))))

(defn make-chaincode-invocation-spec
  ([^Chaincode$ChaincodeSpec chaincode-spec]
   (-> (Chaincode$ChaincodeInvocationSpec/newBuilder)
       (.setChaincodeSpec chaincode-spec)))
  ;; FIXME: setIdGenerationAlg
  #_
  ([^Chaincode$ChaincodeSpec chaincode-spec id-generation-alg]
   (-> (Chaincode$ChaincodeInvocationSpec/newBuilder)
       (.setChaincodeSpec chaincode-spec)
       (.setIdGenerationAlg id-generation-alg))))

(defn make-chaincode-header-extention
  ([chaincode-id]
   (make-chaincode-header-extention chaincode-id ByteString/EMPTY))
  ([^Chaincode$ChaincodeID chaincode-id payload-visibility]
   (-> (ProposalPackage$ChaincodeHeaderExtension/newBuilder)
       (.setChaincodeId chaincode-id)
       ;; FIXME: payload-visibility is ByteString
       ;; Use above arity 1 function - currently all other SDKs do this
       (.setPayloadVisibility payload-visibility)
       (.build))))

(defn make-current-grpc-timestamp
  []
  (let [now (System/currentTimeMillis)]
    (-> (Timestamp/newBuilder)
        (.setSeconds (quot now 1000))
        (.setNanos (-> now (rem 1000) (* 10000000)))
        (.build))))

(defn make-channel-header
  ([type version channel-id tx-id epoch]
   (make-channel-header type version channel-id tx-id epoch ByteString/EMPTY))
  ([type version channel-id tx-id epoch extension]
   (let [now (System/currentTimeMillis)]
    (-> (Common$ChannelHeader/newBuilder)
        (.setType type)
        (.setVersion version)
        (.setTimestamp ^Timestamp (make-current-grpc-timestamp))
        (.setChannelId ^Chaincode$ChaincodeID channel-id)
        (.setTxId tx-id)
        (.setEpoch epoch)
        (.setExtension extension)
        (.build)))))

(defn make-chaincode-header
  [^Chaincode$ChaincodeID chaincode-id channel-id tx-id epoch]
  (make-channel-header Common$HeaderType/ENDORSER_TRANSACTION ; type
                       1                ; version
                       channel-id
                       tx-id
                       epoch
                       (make-chaincode-header-extention chaincode-id)))

(defonce java-empty-map (java.util.Collections/emptyMap))

(defn make-chaincode-proposal-payload
  ([chaincode-invocation-spec]
   (make-chaincode-proposal-payload chaincode-invocation-spec java-empty-map))
  ([^Chaincode$ChaincodeInvocationSpec chaincode-invocation-spec transient-map]
   (-> (ProposalPackage$ChaincodeProposalPayload/newBuilder)
       (.setInput (.toByteString chaincode-invocation-spec))
       (.putAllTransientMap transient-map)
       (.build))))

(defn make-signature-header
  [creator nonce]
  (-> (Common$SignatureHeader/newBuilder)
      (.setCreator creator)
      (.setNonce nonce)
      (.build)))

(defn make-header
  [^Common$ChannelHeader channel-header signature-header]
  (-> (Common$Header/newBuilder)
      (.setChannelHeader (.toByteString channel-header))
      (.setSignatureHeader channel-header)
      (.build)))

(defn make-proposal
  ([header payload]
   (make-proposal header payload ByteString/EMPTY))
  ([header payload extension]
   (-> (ProposalPackage$Proposal/newBuilder)
       (.setHeader (.toByteString ^Common$Header header))
       (.setPayload (.toByteString ^ProposalPackage$ChaincodeProposalPayload payload))
       (.setExtension extension))))

Add more grpc functions

Add more grpc functions


(ns postal.frames
  "A frame types definition."
  (:refer-clojure :exclude [take])

(defrecord Frame [command headers body])

(defn frame
  "A generic frame constructor."
  ([command headers]
   (frame command headers ""))
  ([command headers body]
   (Frame. command headers body)))

(defn query
  "A QUERY frame constructor."
  ([headers]
   (query headers ""))
  ([headers body]
   (frame :query headers body)))

(defn novelty
  "A NOVELTY frame constructor."
  ([headers]
   (novelty headers ""))
  ([headers body]
   (frame :novelty headers body)))

(defn subscribe
  "A SUBSCRIBE frame constructor."
  ([headers]
   (subscribe headers ""))
  ([headers body]
   (frame :subscribe headers body)))

(defn unsubscribe
  "A UNSUBSCRIBE frame constructor."
  ([headers]
   (unsubscribe headers ""))
  ([headers body]
   (frame :unsubscribe headers body)))

(defn publish
  "A PUBLISH frame constructor."
  ([headers]
   (publish headers ""))
  ([headers body]
   (frame :publish headers body)))

(defn put
  "A PUT frame constructor."
  ([headers]
   (put headers ""))
  ([headers body]
   (frame :put headers body)))

(defn take
  "A TAKE frame constructor."
  ([headers]
   (take headers ""))
  ([headers body]
   (frame :take headers body)))

(defn consume
  "A TAKE frame constructor."
  ([headers]
   (consume headers ""))
  ([headers body]
   (frame :consume headers body)))

(defn frame?
  "Return true if a provided frame is a true
  instance of Frame type."
  [frame]
  (instance? Frame frame))

(ns postal.frames
  "A frame types definition."
  (:refer-clojure :exclude [take]))

(defrecord Frame [command headers body])

(defn frame
  "A generic frame constructor."
  ([command headers]
   (frame command headers ""))
  ([command headers body]
   (Frame. command headers body)))

(defn query
  "A QUERY frame constructor."
  ([headers]
   (query headers ""))
  ([headers body]
   (frame :query headers body)))

(defn novelty
  "A NOVELTY frame constructor."
  ([headers]
   (novelty headers ""))
  ([headers body]
   (frame :novelty headers body)))

(defn subscribe
  "A SUBSCRIBE frame constructor."
  ([headers]
   (subscribe headers ""))
  ([headers body]
   (frame :subscribe headers body)))

(defn unsubscribe
  "A UNSUBSCRIBE frame constructor."
  ([headers]
   (unsubscribe headers ""))
  ([headers body]
   (frame :unsubscribe headers body)))

(defn publish
  "A PUBLISH frame constructor."
  ([headers]
   (publish headers ""))
  ([headers body]
   (frame :publish headers body)))

(defn put
  "A PUT frame constructor."
  ([headers]
   (put headers ""))
  ([headers body]
   (frame :put headers body)))

(defn take
  "A TAKE frame constructor."
  ([headers]
   (take headers ""))
  ([headers body]
   (frame :take headers body)))

(defn consume
  "A TAKE frame constructor."
  ([headers]
   (consume headers ""))
  ([headers body]
   (frame :consume headers body)))

(defn frame?
  "Return true if a provided frame is a true
  instance of Frame type."
  [frame]
  (instance? Frame frame))

Fix syntax error introduced in previous commit.


(ns cbfg.world.t1
  (:require-macros [cljs.core.async.macros :refer [go-loop]]
                   [cbfg.act :refer [act actx-top achan achan-buf aput atake]])
  (:require [cljs.core.async :refer [<! >! close! chan map< merge timeout dropping-buffer]]
            [goog.dom :as gdom]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [ago.core :refer [make-ago-world ago-chan ago-timeout]]
            [cbfg.vis :refer [listen-el get-el-value get-el-innerHTML]]
            [cbfg.net :refer [make-net]]
            [cbfg.lane]
            [cbfg.world.net]
            [cbfg.world.lane]
            [cbfg.world.base :refer [world-cmd-loop]]))

;; TODO: How to assign locations to world entities before rendering?

(def prog-world (atom {})) ; { :world => world-actx
                           ;   :net-listen-ch => ch
                           ;   :net-connect-ch => ch
                           ;   :servers => { server-addr => ports }
                           ;   :clients => { client-addr => client-info }
                           ;   :res-ch => ch }

(def run-history
  (atom {:snapshots {0 {}
                     10 {:a 1 :b 2 :c 3 :d 4}
                     20 {:a 11 :b 22 :c 33 :d 44}}
         :events [[0 :snapshot]
                  [1 :event [:a 1]]
                  [2 :event [:b 2]]
                  [3 :event [:c 3]]
                  [4 :event [:d 4]]
                  [10 :snapshot]
                  [11 :event [:a 11]]
                  [12 :event [:b 22]]
                  [13 :event [:c 33]]
                  [14 :event [:d 44]]
                  [20 :snapshot]
                  [21 :event [:a 21]]
                  [22 :event [:b 22]]

                  [0 :snapshot]
                  [1 :event [:a 1]]
                  [2 :event [:b 2]]
                  [3 :event [:c 3]]
                  [4 :event [:d 4]]
                  [10 :snapshot]
                  [11 :event [:a 11]]
                  [12 :event [:b 22]]
                  [13 :event [:c 33]]
                  [14 :event [:d 44]]
                  [20 :snapshot]
                  [21 :event [:a 21]]
                  [22 :event [:b 22]]]}))

(def run-world       (atom {:a 10}))
(def run-world-hover (atom nil))

; -------------------------------------------------------------------

(defn render-world [app owner]
  (apply dom/ul nil
         (map (fn [[k v]] (dom/li nil (str k ":" v))) app)))

(defn render-snapshot [app owner ss-ts]
  (render-world (get-in app [:snapshots ss-ts] nil) owner))

(defn on-event-focus [snapshot-ts event-ts]
  (when-let [ss (get-in @run-history [:snapshots snapshot-ts])]
    (reset! run-world-hover ss)
    (.add gdom/classes (gdom/getElement "world-container") "hover")))

(defn on-event-blur [snapshot-ts event-ts]
  (reset! run-world-hover nil)
  (.remove gdom/classes (gdom/getElement "world-container") "hover"))

(defn render-events [app owner]
  (apply dom/ul nil
         (second
          (reduce
           (fn [[last-snapshot-ts res] [ts kind args]]
             (if (= kind :snapshot)
               [ts (conj res
                         (dom/li #js {:className "snapshot"
                                      :onMouseEnter #(on-event-focus ts nil)
                                      :onMouseLeave #(on-event-blur ts nil)}
                                 (str ts)))]
               [(or last-snapshot-ts ts)
                (conj res
                      (dom/li #js {:onMouseEnter
                                   #(on-event-focus last-snapshot-ts ts)
                                   :onMouseLeave
                                   #(on-event-blur last-snapshot-ts ts)}
                              (str ts (pr-str args))))]))
           [nil []]
           (:events app)))))

(defn render-clients [app owner]
  (apply dom/select #js {:id "client"}
         (map (fn [client-addr]
                (dom/option #js {:value client-addr} (str client-addr)))
              (keys (:clients app)))))

(defn init-roots []
  (om/root render-world run-world
           {:target (. js/document (getElementById "world"))})
  (om/root render-world run-world
           {:target (. js/document (getElementById "world-map"))})
  (om/root render-world run-world-hover
           {:target (. js/document (getElementById "world-hover"))})
  (om/root render-world run-world-hover
           {:target (. js/document (getElementById "world-map-hover"))})
  (om/root render-events run-history
           {:target (. js/document (getElementById "events"))})
  (om/root render-clients prog-world
           {:target (. js/document (getElementById "controls-clients"))}))

; ------------------------------------------------

(defn world-vis-init [el-prefix init-event-delay]
  (init-roots)
  (let [prog-ch (listen-el (gdom/getElement "prog-go") "click")
        step-ch (chan (dropping-buffer 1))
        event-delay (atom init-event-delay)
        run-controls-ch (cbfg.vis/vis-run-controls event-delay step-ch "header")]
    (go-loop [num-worlds 0]
      (let [last-id (atom 0)
            gen-id #(swap! last-id inc)
            agw (make-ago-world num-worlds)
            get-agw (fn [] agw)
            event-ch (ago-chan agw)
            make-timeout-ch (fn [actx delay] (ago-timeout agw delay))
            w [{:gen-id gen-id
                :get-agw get-agw
                :event-ch event-ch
                :make-timeout-ch make-timeout-ch}]
            world (conj w "world-0")  ; No act for world actx init to avoid recursion.
            vis (atom
                 {:actxs {world {:children {} ; child-actx -> true,
                                 :wait-chs {} ; ch -> [:ghost|:take|:put optional-ch-name],
                                 :collapsed true
                                 ; :loop-state last-loop-bindings,
                                 }}
                  :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                          ;         :first-taker-actx actx-or-nil}}.
                  :gen-id gen-id})
            render-ch (chan)
            render-cb (fn [vis-next]
                        (println :on-render-cb @last-id))]
        (reset! prog-world {:world world
                            :net-listen-ch (achan-buf world 10)
                            :net-connect-ch (achan-buf world 10)
                            :servers {}
                            :clients {}
                            :res-ch (achan-buf world 10)})
        (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
                                 event-ch step-ch render-ch)
        (cbfg.vis/process-render el-prefix world render-ch render-cb)
        (make-net world
                  (:net-listen-ch @prog-world)
                  (:net-connect-ch @prog-world))
        (let [req-ch (achan world)
              res-ch (achan world)
              vis-chs {}
              cmd-ch (map< (fn [ev] {:op (.-id (.-target ev))
                                     :x (js/parseInt (get-el-value "x"))
                                     :y (js/parseInt (get-el-value "y"))
                                     :delay (js/parseInt (get-el-value "delay"))
                                     :fence (= (get-el-value "fence") "1")
                                     :lane (get-el-value "lane")
                                     :client (get-el-value "client")
                                     :color (get-el-value "color")
                                     :sleep (js/parseInt (get-el-value "sleep"))})
                           (merge (map #(listen-el (gdom/getElement %) "click")
                                       (keys cbfg.world.lane/cmd-handlers))))
              prog (get-el-value "prog")
              prog-js (str "with (cbfg.world.t1) {" prog "}")
              prog-res (try (js/eval prog-js) (catch js/Object ex ex))]
          (world-cmd-loop world cbfg.world.lane/cmd-handlers cmd-ch
                          req-ch res-ch vis-chs world-vis-init el-prefix)
          (println :prog-res prog-res)
          (<! prog-ch)
          (close! cmd-ch)
          (close! event-ch)
          (close! render-ch)
          (recur (inc num-worlds)))))))

; --------------------------------------------

(defn wait-done [done]
  (loop []
    (when (not @done)
      (cljs.core.async.impl.dispatch/process-messages)
      (recur))))

; --------------------------------------------

(defn kv-server [server-addr & ports]
  (let [world (:world @prog-world)
        done (atom false)]
    (act server-init world
         (doseq [port ports]
           (when-let [listen-result-ch (achan server-init)]
             (aput server-init (:net-listen-ch @prog-world)
                   [server-addr port listen-result-ch])
             (when-let [[accept-ch close-accept-ch] (atake server-init listen-result-ch)]
               (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)
               (swap! prog-world #(update-in % [:servers server-addr] conj port)))))
         (reset! done true))
    (wait-done done)))

(defn kv-client [client-addr server-addr server-port]
  (let [world (:world @prog-world)
        done (atom false)]
    (act client-init world
         (let [req-ch (cbfg.world.net/client-loop world (:net-connect-ch @prog-world)
                                                  server-addr server-port
                                                  client-addr (:res-ch @prog-world))]
           (swap! prog-world #(assoc-in % [:clients client-addr]
                                        {:client-addr client-addr
                                         :server-addr server-addr
                                         :server-port server-port
                                         :req-ch req-ch}))
           (reset! done true)))
    (wait-done done)))

(ns cbfg.world.t1
  (:require-macros [cljs.core.async.macros :refer [go-loop]]
                   [cbfg.act :refer [act actx-top achan achan-buf aput atake]])
  (:require [cljs.core.async :refer [<! >! close! chan map< merge timeout dropping-buffer]]
            [goog.dom :as gdom]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [ago.core :refer [make-ago-world ago-chan ago-timeout]]
            [cbfg.vis :refer [listen-el get-el-value get-el-innerHTML]]
            [cbfg.net :refer [make-net]]
            [cbfg.lane]
            [cbfg.world.net]
            [cbfg.world.lane]
            [cbfg.world.base :refer [world-cmd-loop]]))

;; TODO: How to assign locations to world entities before rendering?

(def prog-world (atom {})) ; { :world => world-actx
                           ;   :net-listen-ch => ch
                           ;   :net-connect-ch => ch
                           ;   :servers => { server-addr => ports }
                           ;   :clients => { client-addr => client-info }
                           ;   :res-ch => ch }

(def run-history
  (atom {:snapshots {0 {}
                     10 {:a 1 :b 2 :c 3 :d 4}
                     20 {:a 11 :b 22 :c 33 :d 44}}
         :events [[0 :snapshot]
                  [1 :event [:a 1]]
                  [2 :event [:b 2]]
                  [3 :event [:c 3]]
                  [4 :event [:d 4]]
                  [10 :snapshot]
                  [11 :event [:a 11]]
                  [12 :event [:b 22]]
                  [13 :event [:c 33]]
                  [14 :event [:d 44]]
                  [20 :snapshot]
                  [21 :event [:a 21]]
                  [22 :event [:b 22]]

                  [0 :snapshot]
                  [1 :event [:a 1]]
                  [2 :event [:b 2]]
                  [3 :event [:c 3]]
                  [4 :event [:d 4]]
                  [10 :snapshot]
                  [11 :event [:a 11]]
                  [12 :event [:b 22]]
                  [13 :event [:c 33]]
                  [14 :event [:d 44]]
                  [20 :snapshot]
                  [21 :event [:a 21]]
                  [22 :event [:b 22]]]}))

(def run-world       (atom {:a 10}))
(def run-world-hover (atom nil))

; -------------------------------------------------------------------

(defn render-world [app owner]
  (apply dom/ul nil
         (map (fn [[k v]] (dom/li nil (str k ":" v))) app)))

(defn render-snapshot [app owner ss-ts]
  (render-world (get-in app [:snapshots ss-ts] nil) owner))

(defn on-event-focus [snapshot-ts event-ts]
  (when-let [ss (get-in @run-history [:snapshots snapshot-ts])]
    (reset! run-world-hover ss)
    (.add gdom/classes (gdom/getElement "world-container") "hover")))

(defn on-event-blur [snapshot-ts event-ts]
  (reset! run-world-hover nil)
  (.remove gdom/classes (gdom/getElement "world-container") "hover"))

(defn render-events [app owner]
  (apply dom/ul nil
         (second
          (reduce
           (fn [[last-snapshot-ts res] [ts kind args]]
             (if (= kind :snapshot)
               [ts (conj res
                         (dom/li #js {:className "snapshot"
                                      :onMouseEnter #(on-event-focus ts nil)
                                      :onMouseLeave #(on-event-blur ts nil)}
                                 (str ts)))]
               [(or last-snapshot-ts ts)
                (conj res
                      (dom/li #js {:onMouseEnter
                                   #(on-event-focus last-snapshot-ts ts)
                                   :onMouseLeave
                                   #(on-event-blur last-snapshot-ts ts)}
                              (str ts (pr-str args))))]))
           [nil []]
           (:events app)))))

(defn render-clients [app owner]
  (apply dom/select #js {:id "client"}
         (map (fn [client-addr]
                (dom/option #js {:value client-addr} (str client-addr)))
              (keys (:clients app)))))

(defn init-roots []
  (om/root render-world run-world
           {:target (. js/document (getElementById "world"))})
  (om/root render-world run-world
           {:target (. js/document (getElementById "world-map"))})
  (om/root render-world run-world-hover
           {:target (. js/document (getElementById "world-hover"))})
  (om/root render-world run-world-hover
           {:target (. js/document (getElementById "world-map-hover"))})
  (om/root render-events run-history
           {:target (. js/document (getElementById "events"))})
  (om/root render-clients prog-world
           {:target (. js/document (getElementById "controls-clients"))}))

; ------------------------------------------------

(defn world-vis-init [el-prefix init-event-delay]
  (init-roots)
  (let [prog-ch (listen-el (gdom/getElement "prog-go") "click")
        step-ch (chan (dropping-buffer 1))
        event-delay (atom init-event-delay)
        run-controls-ch (cbfg.vis/vis-run-controls event-delay step-ch "header")]
    (go-loop [num-worlds 0]
      (let [last-id (atom 0)
            gen-id #(swap! last-id inc)
            agw (make-ago-world num-worlds)
            get-agw (fn [] agw)
            event-ch (ago-chan agw)
            make-timeout-ch (fn [actx delay] (ago-timeout agw delay))
            w [{:gen-id gen-id
                :get-agw get-agw
                :event-ch event-ch
                :make-timeout-ch make-timeout-ch}]
            world (conj w "world-0")  ; No act for world actx init to avoid recursion.
            vis (atom
                 {:actxs {world {:children {} ; child-actx -> true,
                                 :wait-chs {} ; ch -> [:ghost|:take|:put optional-ch-name],
                                 :collapsed true
                                 ; :loop-state last-loop-bindings,
                                 }}
                  :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                          ;         :first-taker-actx actx-or-nil}}.
                  :gen-id gen-id})
            delayed-event-ch (chan)
            render-cb (fn [vis-next]
                        (println :on-render-cb @last-id))]
        (reset! prog-world {:world world
                            :net-listen-ch (achan-buf world 10)
                            :net-connect-ch (achan-buf world 10)
                            :servers {}
                            :clients {}
                            :res-ch (achan-buf world 10)})
        (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
                                 event-ch step-ch delayed-event-ch)
        (cbfg.vis/process-render el-prefix world delayed-event-ch render-cb)
        (make-net world
                  (:net-listen-ch @prog-world)
                  (:net-connect-ch @prog-world))
        (let [req-ch (achan world)
              res-ch (achan world)
              vis-chs {}
              cmd-ch (map< (fn [ev] {:op (.-id (.-target ev))
                                     :x (js/parseInt (get-el-value "x"))
                                     :y (js/parseInt (get-el-value "y"))
                                     :delay (js/parseInt (get-el-value "delay"))
                                     :fence (= (get-el-value "fence") "1")
                                     :lane (get-el-value "lane")
                                     :client (get-el-value "client")
                                     :color (get-el-value "color")
                                     :sleep (js/parseInt (get-el-value "sleep"))})
                           (merge (map #(listen-el (gdom/getElement %) "click")
                                       (keys cbfg.world.lane/cmd-handlers))))
              prog (get-el-value "prog")
              prog-js (str "with (cbfg.world.t1) {" prog "}")
              prog-res (try (js/eval prog-js) (catch js/Object ex ex))]
          (world-cmd-loop world cbfg.world.lane/cmd-handlers cmd-ch
                          req-ch res-ch vis-chs world-vis-init el-prefix)
          (println :prog-res prog-res)
          (<! prog-ch)
          (close! cmd-ch)
          (close! event-ch)
          (close! delayed-event-ch)
          (recur (inc num-worlds)))))))

; --------------------------------------------

(defn wait-done [done]
  (loop []
    (when (not @done)
      (cljs.core.async.impl.dispatch/process-messages)
      (recur))))

; --------------------------------------------

(defn kv-server [server-addr & ports]
  (let [world (:world @prog-world)
        done (atom false)]
    (act server-init world
         (doseq [port ports]
           (when-let [listen-result-ch (achan server-init)]
             (aput server-init (:net-listen-ch @prog-world)
                   [server-addr port listen-result-ch])
             (when-let [[accept-ch close-accept-ch] (atake server-init listen-result-ch)]
               (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)
               (swap! prog-world #(update-in % [:servers server-addr] conj port)))))
         (reset! done true))
    (wait-done done)))

(defn kv-client [client-addr server-addr server-port]
  (let [world (:world @prog-world)
        done (atom false)]
    (act client-init world
         (let [req-ch (cbfg.world.net/client-loop world (:net-connect-ch @prog-world)
                                                  server-addr server-port
                                                  client-addr (:res-ch @prog-world))]
           (swap! prog-world #(assoc-in % [:clients client-addr]
                                        {:client-addr client-addr
                                         :server-addr server-addr
                                         :server-port server-port
                                         :req-ch req-ch}))
           (reset! done true)))
    (wait-done done)))

Rename render-ch delayed-event-ch.

Rename render-ch delayed-event-ch.


(ns checkmate.core
  (:use compojure.core
        [compojure.handler :only [site]])
  (:require monger.json
            [cheshire.core :as json]
            [compojure.route :as route]
            [checkmate.views :as views]
            [checkmate.views.new-list :as new-list]
            [checkmate.views.show-list :as show-list]
            [checkmate.views.overview :as overview]
            [monger.core :as mongo]
            [monger.collection :as mc])
  (:import [org.bson.types ObjectId]))

(defn init []
  (mongo/connect!)
  (-> "checkmate"
      mongo/get-db
      mongo/set-db!))

(defn shutdown []
  (mongo/disconnect!))

(def not-empty? (comp not empty?))

(defn unique-name? [n]
  (nil? (mc/find-one "lists" {:name n})))

(defn store-new-list [l]
  (let [{list-name :name items :items} l]
    (if (and
         (not-empty? list-name)
         (not-empty? items)
         (unique-name? list-name))
      (mc/insert-and-return "lists" l)
      {:error "There's already a list of this name, please choose a different one"})))

(defn find-list [id]
  (mc/find-map-by-id "lists" (ObjectId. id)))

(defn get-all-lists []
  (mc/find-maps "lists"))

(defn delete-list [l]
  (let [name (:name (find-list (:id l)))
        remv (mc/remove-by-id "lists" (ObjectId. (:id l)))]
    (println remv)
    {:_id (:id l) :name name}))

(defroutes app
  (POST "/delete" {{data :data} :params}
        (let [l (json/parse-string data true)]
          (json/generate-string (delete-list l))))
  (POST "/save" {{data :data} :params}
        (let [c (json/parse-string data true)]
          (json/generate-string (store-new-list c))))
  (GET "/show/:id" [id]
       (let [list (find-list id)]
         (views/main-template (show-list/render list))))
  (GET "/list/:id" [id]
       (json/generate-string (or (find-list id) {:error "No list with this id"})))
  (GET "/new" [] (views/main-template (new-list/render nil)))
  (GET "/edit/:id" [id] (views/main-template (new-list/render id)))
  (GET "/" [] (views/main-template (overview/render (get-all-lists))))
  (route/resources "/"))

(def handler (site app))

(ns checkmate.core
  (:use compojure.core
        [compojure.handler :only [site]])
  (:require monger.json
            [cheshire.core :as json]
            [compojure.route :as route]
            [checkmate.views :as views]
            [checkmate.views.new-list :as new-list]
            [checkmate.views.show-list :as show-list]
            [checkmate.views.overview :as overview]
            [monger.core :as mongo]
            [monger.collection :as mc])
  (:import [org.bson.types ObjectId]))

(defn init []
  (mongo/connect!)
  (-> "checkmate"
      mongo/get-db
      mongo/set-db!))

(defn shutdown []
  (mongo/disconnect!))

(def not-empty? (comp not empty?))

(defn unique-name? [n]
  (nil? (mc/find-one "lists" {:name n})))

(defn store-new-list [l]
  (let [{list-name :name items :items} l]
    (if (and
         (not-empty? list-name)
         (not-empty? items)
         (unique-name? list-name))
      (mc/insert-and-return "lists" l)
      {:error "There's already a list of this name, please choose a different one"})))

(defn find-list [id]
  (mc/find-map-by-id "lists" (ObjectId. id)))

(defn get-all-lists []
  (mc/find-maps "lists"))

(defn delete-list [l]
  (let [name (:name (find-list (:id l)))
        remv (mc/remove-by-id "lists" (ObjectId. (:id l)))]
    {:_id (:id l) :name name}))

(defn update-list [l]
  (let [mongo-list (dissoc l :_id)]
    (mc/update-by-id "lists" (ObjectId. (:_id l)) mongo-list)
    (find-list (:_id l))))

(defroutes app
  (POST "/delete" {{data :data} :params}
        (let [l (json/parse-string data true)]
          (json/generate-string (delete-list l))))
  (POST "/save" {{data :data} :params}
        (let [c (json/parse-string data true)
              existing? (:_id c)
              saved-list (if existing?
                           (update-list c)
                           (store-new-list c))]
          (json/generate-string saved-list)))
  (GET "/show/:id" [id]
       (let [list (find-list id)]
         (views/main-template (show-list/render list))))
  (GET "/list/:id" [id]
       (json/generate-string (or (find-list id) {:error "No list with this id"})))
  (GET "/new" [] (views/main-template (new-list/render nil)))
  (GET "/edit/:id" [id] (views/main-template (new-list/render id)))
  (GET "/" [] (views/main-template (overview/render (get-all-lists))))
  (route/resources "/"))

(def handler (site app))

update in backend

update in backend


(ns frontend.models.action
  (:require [frontend.datetime :as datetime]
            [frontend.models.project :as proj]
            [frontend.utils :as utils :include-macros true]
            [goog.string :as gstring]
            goog.string.format))

;; XXX: write an id function
(defn id [action]
  )

(defn failed? [action]
  (#{"failed" "timedout" "cancelled" "infrastructure_fail"} (:status action)))

(defn has-content? [action]
  (or (:has_output action)
      (:bash_command action)
      (:output action)))

(defn duration [{:keys [start_time stop_time] :as action}]
  (cond (:run_time_millis action) (datetime/as-duration (:run_time_millis action))
        (:start_time action) (datetime/as-duration (- (.getTime (js/Date.))
                                                      (js/Date.parse start_time)))
        :else nil))

(defn new-converter [action type]
  (let [default-color (if (= :err :type) "red" "brblue")
        starting-state (clj->js (get-in action [:converters-state type]))]
    (js/CI.terminal.ansiToHtmlConverter default-color starting-state)))

(defn format-output [action output-index]
  (let [output (get-in action [:output output-index])
        converter (new-converter action (keyword (:type output)))]
    (-> action
        (assoc-in [:output output-index :converted-message] (.append converter (:message output)))
        (assoc-in [:output output-index :react-key] (utils/uuid))
        (assoc-in [:converters-state (keyword (:type output))] (js->clj (.currentState converter) :keywordize-keys true)))))

(defn format-latest-output [action]
  (if-let [output (seq (:output action))]
    (format-output action (dec (count output)))
    action))

(defn format-all-output [action]
  (if-let [output (seq (:output action))]
    (reduce format-output action (range (count output)))
    action))

(defn trailing-output [converters-state]
  (str (get-in converters-state [:out :trailing_out])
       (get-in converters-state [:err :trailing_out])))

(ns frontend.models.action
  (:require [frontend.datetime :as datetime]
            [frontend.models.project :as proj]
            [frontend.utils :as utils :include-macros true]
            [goog.string :as gstring]
            goog.string.format))

;; XXX: write an id function
(defn id [action]
  )

(defn failed? [action]
  (#{"failed" "timedout" "cancelled" "infrastructure_fail"} (:status action)))

(defn has-content? [action]
  (or (:has_output action)
      (:bash_command action)
      (:output action)))

(defn duration [{:keys [start_time stop_time] :as action}]
  (cond (:run_time_millis action) (datetime/as-duration (:run_time_millis action))
        (:start_time action) (datetime/as-duration (- (.getTime (js/Date.))
                                                      (js/Date.parse start_time)))
        :else nil))

(defn new-converter [action type]
  (let [default-color (if (= :err type) "red" "brblue")
        starting-state (clj->js (get-in action [:converters-state type]))]
    (js/CI.terminal.ansiToHtmlConverter default-color starting-state)))

(defn format-output [action output-index]
  (let [output (get-in action [:output output-index])
        converter (new-converter action (keyword (:type output)))]
    (-> action
        (assoc-in [:output output-index :converted-message] (.append converter (:message output)))
        (assoc-in [:output output-index :react-key] (utils/uuid))
        (assoc-in [:converters-state (keyword (:type output))] (js->clj (.currentState converter) :keywordize-keys true)))))

(defn format-latest-output [action]
  (if-let [output (seq (:output action))]
    (format-output action (dec (count output)))
    action))

(defn format-all-output [action]
  (if-let [output (seq (:output action))]
    (reduce format-output action (range (count output)))
    action))

(defn trailing-output [converters-state]
  (str (get-in converters-state [:out :trailing_out])
       (get-in converters-state [:err :trailing_out])))

fix typo in om stdout converter

fix typo in om stdout converter


(ns c2.scale
  (:use [c2.util :only [c2-obj]]
        [c2.maths :only [log10]]))

(c2-obj linear {:domain [0 1]
                :range  [0 1]}

        clojure.lang.IFn
        (invoke [_ x] (let [domain-length (- (last domain) (first domain))
                            range-length (- (last range) (first range))]
                        (+ (first range)
                           (* range-length
                              (/ (- x (first domain))
                                 domain-length))))))

(c2-obj log {:domain [1 10]
             :range  [0 1]}
        clojure.lang.IFn
        (invoke [_ x]
                (comp (linear :domain (map log10 domain)
                              :range range)
                      log10)))

(ns c2.scale
  (:use [c2.util :only [c2-obj]]
        [c2.maths :only [log10]]))

(c2-obj linear {:domain [0 1]
                :range  [0 1]
                :float true}

        clojure.lang.IFn
        (invoke [_ x] (let [domain-length (- (last domain) (first domain))
                            range-length (- (last range) (first range))
                            scale-val (+ (first range)
                                         (* range-length
                                            (/ (- x (first domain))
                                               domain-length)))]
                        (if float
                          (clojure.core/float scale-val)
                          scale-val))))

(c2-obj log {:domain [1 10]
             :range  [0 1]}
        clojure.lang.IFn
        (invoke [_ x]
                (comp (linear :domain (map log10 domain)
                              :range range)
                      log10)))

Add :float option (default true) to linear scale that coerces scale output to float (html/svg doesn't care for ratios).


(ns fscrawler-tika-convert.core
  (:require [langohr.basic :as lb])
  (:require [langohr.core :as rmq])
  (:require [langohr.queue :as lq])
  (:require [langohr.channel :as lch])
  (:require [langohr.consumers :as lcons])
  ;; (:require [me.raynes.fs :as fs])
  (:require [clojure.tools.cli :as cli])
  (:require [clojure.data.json :as json])
  (:require [clojure.string :as string])
  (:require [com.brainbot.stat :as stat])
  (:require [tika])
  (:import java.io.File)
  (:gen-class))

(def number-of-cores
  (.availableProcessors (Runtime/getRuntime)))

(defn wash
  "remove unicode 0xfffd character from string
  this is the unicode 'replacement character', which tika uses for
  unknown characters"
  [str]
  (string/trim (string/replace (or str "") (char 0xfffd) \space)))

(defn convert
  "convert file and call wash on text property"
  [filename]
  (update-in (convert filename) [:text] wash))

(defn handle-message
  [ch metadata ^bytes payload]
  (let [body (json/read-str (String. payload "UTF-8"))
        ;; {:keys [directory relpath] body}
        directory (:directory body)
        relpath (:relpath (:entry body))
        fp (string/join File/separator [directory relpath])
        ;; converted (tika/parse fp)
        ]
        ;;
    (future (let [converted (convert fp)]
              (println "before ack" (Thread/currentThread) (:delivery-tag metadata))
              (lb/ack ch (:delivery-tag metadata))
              (println "done" fp " ****" )))

    (println "scheduled" fp " ****" )))

    ;; (println "dir" fp " ****" (:content-type converted))))

;; (println "got message" metadata (String. payload "UTF-8")))

(defn run-with-connection
  []
  (let [conn       (rmq/connect)
        ch         (lch/open conn)
        queue-name "nextbot.extract_content.fscrawler:test"
        handler    (fn [ch {:keys [headers delivery-tag redelivery?]} ^bytes payload]
                     (println "hello")
                     (println "headers" headers)
                     ;; (println (format "[consumer] Received %s" (String. payload "UTF-8")))
                     (lb/ack ch delivery-tag))]
    ;; (lq/declare ch queue-name :exclusive false :auto-delete true)
    ;; (lq/bind    ch queue-name "nextbot")
    (lb/qos ch (+ number-of-cores 4))
    (lcons/subscribe ch queue-name handle-message :auto-ack false)
    (println "done with subscribing")))

(defn -main [& args]
  ;; work around dangerous default behaviour in Clojure
  (alter-var-root #'*read-eval* (constantly false))

  (let [[options args banner]
        (cli/cli args
                 ["--ampqp-url" "amqp url to connect to"]
                 ["--port" "Port to listen on" :default 5000]
                 ["--root" "Root directory of web server" :default "public"])]
    (println "port:" (:port options))
    (println "root:" (:root options)))
  (run-with-connection))

(ns fscrawler-tika-convert.core
  (:require [langohr.basic :as lb])
  (:require [langohr.core :as rmq])
  (:require [langohr.queue :as lq])
  (:require [langohr.channel :as lch])
  (:require [langohr.consumers :as lcons])
  ;; (:require [me.raynes.fs :as fs])
  (:require [clojure.tools.cli :as cli])
  (:require [clojure.data.json :as json])
  (:require [clojure.string :as string])
  (:require [com.brainbot.stat :as stat])
  (:require [tika])
  (:import java.io.File)
  (:gen-class))

(def number-of-cores
  (.availableProcessors (Runtime/getRuntime)))

(defn wash
  "remove unicode 0xfffd character from string
  this is the unicode 'replacement character', which tika uses for
  unknown characters"
  [str]
  (string/trim (string/replace (or str "") (char 0xfffd) \space)))

(defn convert
  "convert file and call wash on text property"
  [filename]
  (update-in (convert filename) [:text] wash))

(defn handle-message
  [ch metadata ^bytes payload]
  (let [body (json/read-json (String. payload "UTF-8"))
        ;; {:keys [directory relpath] body}
        directory (:directory body)
        relpath (:relpath (:entry body))
        fp (string/join File/separator [directory relpath])
        ;; converted (tika/parse fp)
        ]
        ;;
    (future (let [converted (convert fp)]
              (println "before ack" (Thread/currentThread) (:delivery-tag metadata))
              (lb/ack ch (:delivery-tag metadata))
              (println "done" fp " ****" )))

    (println "scheduled" fp " ****" )))

    ;; (println "dir" fp " ****" (:content-type converted))))

;; (println "got message" metadata (String. payload "UTF-8")))

(defn run-with-connection
  []
  (let [conn       (rmq/connect)
        ch         (lch/open conn)
        queue-name "nextbot.extract_content.fscrawler:test"
        handler    (fn [ch {:keys [headers delivery-tag redelivery?]} ^bytes payload]
                     (println "hello")
                     (println "headers" headers)
                     ;; (println (format "[consumer] Received %s" (String. payload "UTF-8")))
                     (lb/ack ch delivery-tag))]
    ;; (lq/declare ch queue-name :exclusive false :auto-delete true)
    ;; (lq/bind    ch queue-name "nextbot")
    (lb/qos ch (+ number-of-cores 4))
    (lcons/subscribe ch queue-name handle-message :auto-ack false)
    (println "done with subscribing")))

(defn -main [& args]
  ;; work around dangerous default behaviour in Clojure
  (alter-var-root #'*read-eval* (constantly false))

  (let [[options args banner]
        (cli/cli args
                 ["--ampqp-url" "amqp url to connect to"]
                 ["--port" "Port to listen on" :default 5000]
                 ["--root" "Root directory of web server" :default "public"])]
    (println "port:" (:port options))
    (println "root:" (:root options)))
  (run-with-connection))

fix handle-message

fix handle-message


(ns iwaswhere-web.files
  (:require [clojure.pprint :as pp]
            [iwaswhere-web.graph :as g]
            [clj-time.core :as time]
            [clj-time.format :as timef]
            [me.raynes.fs :as fs]
            [clojure.tools.logging :as log]
            [ubergraph.core :as uber]))

(defn filter-by-name
  "Filter a sequence of files by their name, matched via regular expression."
  [file-s regexp]
  (filter (fn [f] (re-matches regexp (.getName f))) file-s))

(defn append-daily-log
  "Appends journal entry to the current day's log file."
  [entry]
  (let [filename (str "./data/daily-logs/" (timef/unparse (timef/formatters :year-month-day) (time/now)) ".jrn")
        serialized (str (pr-str entry) "\n")]
    (spit filename serialized :append true)))

(defn entry-import-fn
  "Handler function for persisting an imported journal entry."
  [{:keys [current-state msg-payload]}]
  (let [entry-ts (:timestamp msg-payload)
        last-filter (:last-filter current-state)
        exists? (uber/has-node? (:graph current-state) entry-ts)]
    (if exists?
      (log/warn "Entry exists, skipping" msg-payload)
      (let [new-state (g/add-node current-state entry-ts msg-payload)]
        (append-daily-log msg-payload)
        {:new-state new-state
         :emit-msg  [:state/new (g/get-filtered-results new-state last-filter)]}))))

(defn geo-entry-persist-fn
  "Handler function for persisting journal entry."
  [{:keys [current-state msg-payload]}]
  (let [entry-ts (:timestamp msg-payload)
        last-filter (:last-filter current-state)
        new-state (g/add-node current-state entry-ts msg-payload)]
    (append-daily-log msg-payload)
    {:new-state new-state
     :emit-msg  [:state/new (g/get-filtered-results new-state last-filter)]}))

(defn trash-entry-fn
  "Handler function for deleting journal entry."
  [{:keys [current-state msg-payload]}]
  (let [entry-ts (:timestamp msg-payload)
        last-filter (:last-filter current-state)
        new-state (g/remove-node current-state entry-ts)]
    (log/info "Entry" entry-ts "marked as deleted.")
    (append-daily-log (merge msg-payload {:deleted true}))
    {:new-state new-state
     :emit-msg  [:state/new (g/get-filtered-results new-state last-filter)]}))

(ns iwaswhere-web.files
  (:require [clojure.pprint :as pp]
            [iwaswhere-web.graph :as g]
            [clj-time.core :as time]
            [clj-time.format :as timef]
            [me.raynes.fs :as fs]
            [clojure.tools.logging :as log]
            [ubergraph.core :as uber]))

(defn filter-by-name
  "Filter a sequence of files by their name, matched via regular expression."
  [file-s regexp]
  (filter (fn [f] (re-matches regexp (.getName f))) file-s))

(defn append-daily-log
  "Appends journal entry to the current day's log file."
  [entry]
  (let [filename (str "./data/daily-logs/" (timef/unparse (timef/formatters :year-month-day) (time/now)) ".jrn")
        serialized (str (pr-str entry) "\n")]
    (spit filename serialized :append true)))

(defn entry-import-fn
  "Handler function for persisting an imported journal entry."
  [{:keys [current-state msg-payload]}]
  (let [entry-ts (:timestamp msg-payload)
        last-filter (:last-filter current-state)
        graph (:graph current-state)
        exists? (uber/has-node? graph entry-ts)
        existing (when exists? (uber/attrs graph entry-ts))]
    ; Okay this is slightly too specific for my taste, but currently, the completion
    ; of a visit is an update to a visit, and otherwise, the exists? logic would refuse
    ; to import it.
    (if (and exists? (not= (:md existing) "No departure recorded #visit"))
      (log/warn "Entry exists, skipping" msg-payload)
      (let [new-state (g/add-node current-state entry-ts msg-payload)]
        (append-daily-log msg-payload)
        {:new-state new-state
         :emit-msg  [:state/new (g/get-filtered-results new-state last-filter)]}))))

(defn geo-entry-persist-fn
  "Handler function for persisting journal entry."
  [{:keys [current-state msg-payload]}]
  (let [entry-ts (:timestamp msg-payload)
        last-filter (:last-filter current-state)
        new-state (g/add-node current-state entry-ts msg-payload)]
    (append-daily-log msg-payload)
    {:new-state new-state
     :emit-msg  [:state/new (g/get-filtered-results new-state last-filter)]}))

(defn trash-entry-fn
  "Handler function for deleting journal entry."
  [{:keys [current-state msg-payload]}]
  (let [entry-ts (:timestamp msg-payload)
        last-filter (:last-filter current-state)
        new-state (g/remove-node current-state entry-ts)]
    (log/info "Entry" entry-ts "marked as deleted.")
    (append-daily-log (merge msg-payload {:deleted true}))
    {:new-state new-state
     :emit-msg  [:state/new (g/get-filtered-results new-state last-filter)]}))

fix for not importing completed visits

fix for not importing completed visits


(ns org.akvo.flow-api.unilog.unilog
  (:import [com.google.appengine.api.datastore DatastoreServiceFactory])
  (:require [clojure.java.jdbc :as jdbc]
            [clojure.string :as str]
            [org.akvo.flow-api.boundary.form-instance :as form-instance]
            [org.akvo.flow-api.unilog.spec :as unilog-spec]
            [org.akvo.flow-api.boundary.user :as user]
            [org.akvo.flow-api.datastore :as ds]
            [org.akvo.flow-api.boundary.survey :as survey]
            [org.akvo.flow-api.datastore.survey :as su]
            [clojure.spec.alpha :as s]
            [cheshire.core :as json]
            [com.stuartsierra.component :as component]))

(defrecord UnilogConfig [spec]
  component/Lifecycle
  (start [this]
    (assoc this :spec spec))
  (stop [this]
    (dissoc this :spec)))

(defn unilog-config [spec]
  (->UnilogConfig spec))

(defn event-log-spec [config]
  (assert (not (empty? config)) "Config map is empty")
  (merge
    {:subprotocol "postgresql"
     :subname (format "//%s:%s/%s"
                (config :event-log-host)
                (config :event-log-port)
                (config :db-name))
     :ssl true
     :user (config :event-log-user)
     :password (config :event-log-password)}
    (:extra-jdbc-opts config)))

(def parse-json #(json/parse-string % true))

(defn form-data [{:keys [formId id surveyId]}]
  {:form-id formId
   :id id})

(defn form-instance-data [{:keys [formId formInstanceId]}]
  {:form-id formId
   :id formInstanceId})

(defn data-point-data [{:keys [id surveyId lat lon name identifier]}]
  (cond-> {:id (str id)
           :identifier identifier
           :survey-id (str surveyId)}
    lat (assoc :lat lat)
    lon (assoc :lon lon)
    name (assoc :name name)))

(def form-instance-changed (comp #{"formInstanceUpdated" "formInstanceCreated"} :eventType :payload))
(def form-instance-deleted (comp #{"formInstanceDeleted"} :eventType :payload))
(def answer-changed (comp #{"answerUpdated" "answerCreated"} :eventType :payload))
(def form-changed (comp #{"formUpdated" "formCreated"} :eventType :payload))
(def form-deleted (comp #{"formDeleted"} :eventType :payload))
(def data-point-changed (comp #{"dataPointUpdated" "dataPointCreated"} :eventType :payload))
(def data-point-deleted (comp #{"dataPointDeleted"} :eventType :payload))

(defn process-new-events [reducible]
  (let [pipeline (comp
                  (map (fn [x]
                          (try
                            (update x :payload parse-json)
                            (catch Exception e
                              x))))
                   (map (fn [x]
                          (if (unilog-spec/valid? x)
                            (cond
                              (form-instance-changed x) (assoc x ::form-instance-changed (-> x :payload :entity form-data))
                              (answer-changed x) (assoc x ::form-instance-changed (-> x :payload :entity form-instance-data))
                              (form-instance-deleted x) (assoc x ::form-instance-deleted (-> x :payload :entity :id))
                              (form-changed x) (assoc x ::form-changed (-> x :payload :entity :id))
                              (form-deleted x) (assoc x ::form-deleted (-> x :payload :entity :id))
                              (data-point-changed x) (assoc x ::data-point-changed (-> x :payload :entity data-point-data))
                              (data-point-deleted x) (assoc x ::data-point-deleted (-> x :payload :entity :id)))
                            (assoc x ::x ::invalid)))))]
    (transduce
      pipeline
      (fn
        ([final]
         (let [form-deleted (set (keep ::form-deleted final))
               form-updated (apply disj (set (keep ::form-changed final)) form-deleted)
               form-instance-deleted (set (keep ::form-instance-deleted final))
               form-instances-grouped-by-form (group-by :form-id
                                                (remove
                                                  (comp form-deleted :form-id)
                                                  (remove
                                                    (comp form-instance-deleted :id)
                                                    (distinct (keep ::form-instance-changed final)))))
               data-point-changed (set (keep ::data-point-changed final))
               data-point-deleted (set (keep ::data-point-deleted final))]
           {::unilog-id (:id (last final))
            ::form-instance-deleted form-instance-deleted
            ::form-updated form-updated
            ::form-deleted form-deleted
            :forms-to-load (apply conj form-updated (keys form-instances-grouped-by-form))
            ::forms-instances-grouped-by-form form-instances-grouped-by-form
            ::data-point-changed data-point-changed
            ::data-point-deleted data-point-deleted}))
        ([sofar batch]
         (conj sofar batch)))
      []
      reducible)))

(defn after-forms-loaded [{::keys [forms-instances-grouped-by-form
                                   unilog-id
                                   form-updated
                                   form-deleted
                                   form-instance-deleted
                                   data-point-changed
                                   data-point-deleted]}
                          form-id->form]
  {:unilog-id unilog-id
   :form-changed (->> form-updated
                   (keep form-id->form)
                   set)
   :form-deleted form-deleted
   :form-instance-deleted form-instance-deleted
   :form-instances-to-load (->> forms-instances-grouped-by-form
                             (keep (fn [[form-id form-instance]]
                                     (when-let [form (get form-id->form form-id)]
                                       {:form form
                                        :form-instance-ids (set (map :id form-instance))})))
                             set)
   :data-point-changed data-point-changed
   :data-point-deleted data-point-deleted})

(defn get-cursor [config]
  (let [result (first (jdbc/query (event-log-spec config)
                                  ["SELECT MAX(id) AS cursor FROM event_log"]))]
    (or (:cursor result) 0)))

(defn valid-offset? [offset config]
  (or (= offset 0)
      (let [result (first (jdbc/query (event-log-spec config)
                                      ["SELECT id AS offset FROM event_log WHERE id = ?" offset]))]
        (boolean (:offset result)))))

(defn process-unilog-events [offset config instance-id remote-api]
  (ds/with-remote-api remote-api instance-id
    (let [ds (DatastoreServiceFactory/getDatastoreService)
          events (process-new-events
                   (jdbc/reducible-query (event-log-spec config)
                                         ["SELECT id, payload::text AS payload FROM event_log WHERE id > ? ORDER BY id ASC LIMIT 300" offset]
                                         {:auto-commit? false :fetch-size 300}))
          form-id->form (reduce (fn [acc form-id]
                                  (assoc acc form-id (su/get-form-definition (long form-id))))
                                {}
                                (:forms-to-load events))
          events-2 (after-forms-loaded events form-id->form) ;; TODO: get form definition from cache
          form-instances (doall
                           (mapcat
                             (fn [to-load]
                               (form-instance/by-ids ds (:form to-load) (:form-instance-ids to-load)))
                             (:form-instances-to-load events-2)))]
      (assoc events-2 :form-instance-changed form-instances))))

(ns org.akvo.flow-api.unilog.unilog
  (:import [com.google.appengine.api.datastore DatastoreServiceFactory])
  (:require [clojure.java.jdbc :as jdbc]
            [clojure.string :as str]
            [org.akvo.flow-api.boundary.form-instance :as form-instance]
            [org.akvo.flow-api.unilog.spec :as unilog-spec]
            [org.akvo.flow-api.boundary.user :as user]
            [org.akvo.flow-api.datastore :as ds]
            [org.akvo.flow-api.boundary.survey :as survey]
            [org.akvo.flow-api.datastore.survey :as su]
            [clojure.spec.alpha :as s]
            [cheshire.core :as json]
            [com.stuartsierra.component :as component]))

(defrecord UnilogConfig [spec]
  component/Lifecycle
  (start [this]
    (assoc this :spec spec))
  (stop [this]
    (dissoc this :spec)))

(defn unilog-config [spec]
  (->UnilogConfig spec))

(defn event-log-spec [config]
  (assert (not (empty? config)) "Config map is empty")
  (merge
    {:subprotocol "postgresql"
     :subname (format "//%s:%s/%s"
                (config :event-log-host)
                (config :event-log-port)
                (config :db-name))
     :ssl true
     :user (config :event-log-user)
     :password (config :event-log-password)}
    (:extra-jdbc-opts config)))

(def parse-json #(json/parse-string % true))

(defn form-data [{:keys [formId id surveyId]}]
  {:form-id formId
   :id id})

(defn form-instance-data [{:keys [formId formInstanceId]}]
  {:form-id formId
   :id formInstanceId})

(defn data-point-data [{:keys [id surveyId lat lon name identifier]}]
  (cond-> {:id (str id)
           :identifier identifier
           :survey-id (str surveyId)}
    lat (assoc :lat lat)
    lon (assoc :lon lon)
    name (assoc :name name)))

(defn process-new-events [reducible]
  (let [pipeline (comp
                  (map (fn [x]
                          (try
                            (update x :payload parse-json)
                            (catch Exception e
                              x))))
                   (map (fn [x]
                          (if-not (unilog-spec/valid? x)
                            (assoc x ::x ::invalid)
                            (let [[k f]
                                  (case (-> x :payload :eventType)
                                    ("formInstanceUpdated" "formInstanceCreated") [::form-instance-changed form-data]
                                    ("answerUpdated" "answerCreated") [::form-instance-changed form-instance-data]
                                    "formInstanceDeleted" [::form-instance-deleted :id]
                                    ("formUpdated" "formCreated") [::form-changed :id]
                                    "formDeleted" [::form-deleted :id]
                                    ("dataPointUpdated" "dataPointCreated") [::data-point-changed data-point-data]
                                    "dataPointDeleted" [::data-point-deleted :id])]
                              (assoc x k (-> x :payload :entity f)))))))]
    (transduce
      pipeline
      (fn
        ([final]
         (let [form-deleted (set (keep ::form-deleted final))
               form-updated (apply disj (set (keep ::form-changed final)) form-deleted)
               form-instance-deleted (set (keep ::form-instance-deleted final))
               form-instances-grouped-by-form (group-by :form-id
                                                (remove
                                                  (comp form-deleted :form-id)
                                                  (remove
                                                    (comp form-instance-deleted :id)
                                                    (distinct (keep ::form-instance-changed final)))))
               data-point-changed (set (keep ::data-point-changed final))
               data-point-deleted (set (keep ::data-point-deleted final))]
           {::unilog-id (:id (last final))
            ::form-instance-deleted form-instance-deleted
            ::form-updated form-updated
            ::form-deleted form-deleted
            :forms-to-load (apply conj form-updated (keys form-instances-grouped-by-form))
            ::forms-instances-grouped-by-form form-instances-grouped-by-form
            ::data-point-changed data-point-changed
            ::data-point-deleted data-point-deleted}))
        ([sofar batch]
         (conj sofar batch)))
      []
      reducible)))

(defn after-forms-loaded [{::keys [forms-instances-grouped-by-form
                                   unilog-id
                                   form-updated
                                   form-deleted
                                   form-instance-deleted
                                   data-point-changed
                                   data-point-deleted]}
                          form-id->form]
  {:unilog-id unilog-id
   :form-changed (->> form-updated
                   (keep form-id->form)
                   set)
   :form-deleted form-deleted
   :form-instance-deleted form-instance-deleted
   :form-instances-to-load (->> forms-instances-grouped-by-form
                             (keep (fn [[form-id form-instance]]
                                     (when-let [form (get form-id->form form-id)]
                                       {:form form
                                        :form-instance-ids (set (map :id form-instance))})))
                             set)
   :data-point-changed data-point-changed
   :data-point-deleted data-point-deleted})

(defn get-cursor [config]
  (let [result (first (jdbc/query (event-log-spec config)
                                  ["SELECT MAX(id) AS cursor FROM event_log"]))]
    (or (:cursor result) 0)))

(defn valid-offset? [offset config]
  (or (= offset 0)
      (let [result (first (jdbc/query (event-log-spec config)
                                      ["SELECT id AS offset FROM event_log WHERE id = ?" offset]))]
        (boolean (:offset result)))))

(defn process-unilog-events [offset config instance-id remote-api]
  (ds/with-remote-api remote-api instance-id
    (let [ds (DatastoreServiceFactory/getDatastoreService)
          events (process-new-events
                   (jdbc/reducible-query (event-log-spec config)
                                         ["SELECT id, payload::text AS payload FROM event_log WHERE id > ? ORDER BY id ASC LIMIT 300" offset]
                                         {:auto-commit? false :fetch-size 300}))
          form-id->form (reduce (fn [acc form-id]
                                  (assoc acc form-id (su/get-form-definition (long form-id))))
                                {}
                                (:forms-to-load events))
          events-2 (after-forms-loaded events form-id->form) ;; TODO: get form definition from cache
          form-instances (doall
                           (mapcat
                             (fn [to-load]
                               (form-instance/by-ids ds (:form to-load) (:form-instance-ids to-load)))
                             (:form-instances-to-load events-2)))]
      (assoc events-2 :form-instance-changed form-instances))))

Remove some duplication

[#200] Remove some duplication


(ns status-im.ui.screens.notifications-center.views.notification
  (:require [status-im.ui.components.react :as react]
            [re-frame.core :as re-frame]
            [quo.core :as quo]
            [clojure.string :as string]
            [status-im.i18n.i18n :as i18n]
            [status-im.ui.screens.notifications-center.styles :as styles]
            [status-im.utils.handlers :refer [<sub]]
            [status-im.ui.screens.chat.photos :as photos]
            [status-im.multiaccounts.core :as multiaccounts]
            [status-im.ui.components.icons.icons :as icons]
            [status-im.utils.contenthash :as contenthash]
            [status-im.constants :as constants]
            [status-im.ui.components.colors :as colors]
            [status-im.ui.screens.home.views.inner-item :as home-item]))

(defn mention-element [from]
  (let [contact-name @(re-frame/subscribe [:contacts/contact-name-by-identity from])]
    (str (when-not (= (subs contact-name 0 1) "@") "@") contact-name)))

(def max-notification-length 160)
(def max-notification-lines 2)
(def max-reply-lines 1)

(defn add-parsed-to-message [acc style text-weight {:keys [type destination literal children]}]
  (let [result (case type
                 "paragraph"
                 (reduce
                  (fn [{:keys [_ length] :as acc-paragraph} parsed-child]
                    (if (>= length max-notification-length)
                      (reduced acc-paragraph)
                      (add-parsed-to-message acc-paragraph style text-weight parsed-child)))
                  {:components [quo/text {:style style
                                          :weight text-weight}]
                   :length     0}
                  children)

                 "mention"
                 {:components [quo/text {:style (merge style styles/mention-text)} [mention-element literal]]
                  :length     4}                            ;; we can't predict name length so take the smallest possible

                 "status-tag"
                 (home-item/truncate-literal (str "#" literal))

                 "link"
                 (home-item/truncate-literal destination)

                 (home-item/truncate-literal (string/replace literal #"\n" " ")))]
    {:components (conj (:components acc) (:components result))
     :length     (+ (:length acc) (:length result))}))

(defn message-wrapper
  ([] (message-wrapper 1 styles/notification-reply-text))
  ([number-of-lines style]
   [react/text-class {:style               style
                      :number-of-lines     number-of-lines
                      :ellipsize-mode      :tail
                      :accessibility-label :chat-message-text}]))

(defn render-message
  "Render the preview of a message with a maximum length, maximum lines, style and font weight"
  ([parsed-text] (render-message parsed-text max-notification-length max-notification-lines styles/notification-message-text :regular))
  ([parsed-text max-length number-of-lines style text-weight]
   (let [result
         (reduce
          (fn [{:keys [_ length] :as acc-text} new-text-chunk]
            (if (>= length max-length)
              (reduced acc-text)
              (add-parsed-to-message acc-text style text-weight new-text-chunk)))
          {:components (message-wrapper number-of-lines style)
           :length     0}
          parsed-text)]
     (:components result))))

(defn message-content-text [{:keys [content content-type community-id]} max-number-of-lines style text-weight]
  [react/view
   (cond

     (not (and content content-type))
     [react/text {:style               (merge
                                        style
                                        {:color colors/gray})
                  :accessibility-label :no-messages-text}
      (i18n/label :t/no-messages)]

     (= constants/content-type-sticker content-type)
     [react/image {:style  {:margin 1 :width 20 :height 20}
                   ;;TODO (perf) move to event
                   :source {:uri (contenthash/url (-> content :sticker :hash))}}]

     (= constants/content-type-image content-type)
     [react/text {:style               style
                  :accessibility-label :no-messages-text}
      (i18n/label :t/image)]

     (= constants/content-type-audio content-type)
     [react/text {:style               style
                  :accessibility-label :no-messages-text}
      (i18n/label :t/audio)]

     (= constants/content-type-community content-type)
     (let [{:keys [name]}
           @(re-frame/subscribe [:communities/community community-id])]
       [react/text {:style               style
                    :accessibility-label :no-messages-text}
        (i18n/label :t/community-message-preview {:community-name name})])

     (string/blank? (:text content))
     [react/text {:style style}
      ""]

     (:text content)
     (render-message (:parsed-text content) max-notification-length max-number-of-lines style text-weight))])

(defn activity-text-item [home-item opts]
  (let [{:keys [chat-id chat-name message last-message reply-message muted read group-chat timestamp type]} home-item
        message (or message last-message)
        {:keys [community-id]} (<sub [:chat-by-id chat-id])
        {:keys [name]} @(re-frame/subscribe [:communities/community community-id])
        contact (when message @(re-frame/subscribe [:contacts/contact-by-identity (message :from)]))
        sender (when message (first @(re-frame/subscribe [:contacts/contact-two-names-by-identity (message :from)])))]
    [react/touchable-opacity (merge {:style (styles/notification-container read)} opts)
     [react/view {:style styles/notification-content-container}
      [react/view {:style styles/photo-container}
       [photos/photo
        (multiaccounts/displayed-photo contact)
        {:size 40
         :accessibility-label :current-account-photo}]]
      [quo/text {:weight              :medium
                 :color               (when muted :secondary)
                 :accessibility-label :chat-name-or-sender-text
                 :ellipsize-mode      :tail
                 :number-of-lines     1
                 :style               styles/title-text}
       (if (or
            (= type constants/activity-center-notification-type-mention)
            (= type constants/activity-center-notification-type-reply))
         sender
         [home-item/chat-item-title chat-id muted group-chat chat-name])]
      [react/text {:style               styles/datetime-text
                   :number-of-lines     1
                   :accessibility-label :notification-time-text}
       ;;TODO (perf) move to event
       (home-item/memo-timestamp timestamp)]
      [react/view {:style styles/notification-message-container}
       [message-content-text (select-keys message [:content :content-type :community-id]) max-notification-lines styles/notification-message-text]
       (cond (= type constants/activity-center-notification-type-mention)
             [react/view {:style styles/group-info-container
                          :accessibility-label :chat-name-container}
              [icons/icon
               (if community-id :main-icons/tiny-community :main-icons/tiny-group)
               {:color  colors/gray
                :width  16
                :height 16
                :container-style styles/group-icon}]
              (when community-id
                [react/view {:style styles/community-info-container}
                 [quo/text {:color :secondary
                            :weight :medium
                            :size :small}
                  name]
                 [icons/icon
                  :main-icons/chevron-down
                  {:color  colors/gray
                   :width  16
                   :height 22}]])
              [quo/text {:color :secondary
                         :weight :medium
                         :size :small}
               (str (when community-id "#") chat-name)]]

             (= type constants/activity-center-notification-type-reply)
             [react/view {:style styles/reply-message-container
                          :accessibility-label :reply-message-container}
              [icons/icon
               :main-icons/tiny-reply
               {:color  colors/gray
                :width  18
                :height 18
                :container-style styles/reply-icon}]
              [message-content-text (select-keys reply-message [:content :content-type :community-id]) max-reply-lines styles/notification-reply-text :medium]])]]]))

(ns status-im.ui.screens.notifications-center.views.notification
  (:require [status-im.ui.components.react :as react]
            [re-frame.core :as re-frame]
            [quo.core :as quo]
            [clojure.string :as string]
            [status-im.i18n.i18n :as i18n]
            [status-im.ui.screens.notifications-center.styles :as styles]
            [status-im.utils.handlers :refer [<sub]]
            [status-im.ui.components.icons.icons :as icons]
            [status-im.utils.contenthash :as contenthash]
            [status-im.constants :as constants]
            [status-im.ui.components.colors :as colors]
            [status-im.ui.screens.home.views.inner-item :as home-item]
            [status-im.ui.components.chat-icon.screen :as chat-icon.screen]
            [status-im.ui.components.chat-icon.styles :as chat-icon.styles]))

(defn mention-element [from]
  (let [contact-name @(re-frame/subscribe [:contacts/contact-name-by-identity from])]
    (str (when-not (= (subs contact-name 0 1) "@") "@") contact-name)))

(def max-notification-length 160)
(def max-notification-lines 2)
(def max-reply-lines 1)

(defn add-parsed-to-message [acc style text-weight {:keys [type destination literal children]}]
  (let [result (case type
                 "paragraph"
                 (reduce
                  (fn [{:keys [_ length] :as acc-paragraph} parsed-child]
                    (if (>= length max-notification-length)
                      (reduced acc-paragraph)
                      (add-parsed-to-message acc-paragraph style text-weight parsed-child)))
                  {:components [quo/text {:style style
                                          :weight text-weight}]
                   :length     0}
                  children)

                 "mention"
                 {:components [quo/text {:style (merge style styles/mention-text)} [mention-element literal]]
                  :length     4}                            ;; we can't predict name length so take the smallest possible

                 "status-tag"
                 (home-item/truncate-literal (str "#" literal))

                 "link"
                 (home-item/truncate-literal destination)

                 (home-item/truncate-literal (string/replace literal #"\n" " ")))]
    {:components (conj (:components acc) (:components result))
     :length     (+ (:length acc) (:length result))}))

(defn message-wrapper
  ([] (message-wrapper 1 styles/notification-reply-text))
  ([number-of-lines style]
   [react/text-class {:style               style
                      :number-of-lines     number-of-lines
                      :ellipsize-mode      :tail
                      :accessibility-label :chat-message-text}]))

(defn render-message
  "Render the preview of a message with a maximum length, maximum lines, style and font weight"
  ([parsed-text] (render-message parsed-text max-notification-length max-notification-lines styles/notification-message-text :regular))
  ([parsed-text max-length number-of-lines style text-weight]
   (let [result
         (reduce
          (fn [{:keys [_ length] :as acc-text} new-text-chunk]
            (if (>= length max-length)
              (reduced acc-text)
              (add-parsed-to-message acc-text style text-weight new-text-chunk)))
          {:components (message-wrapper number-of-lines style)
           :length     0}
          parsed-text)]
     (:components result))))

(defn message-content-text [{:keys [content content-type community-id]} max-number-of-lines style text-weight]
  [react/view
   (cond

     (not (and content content-type))
     [react/text {:style               (merge
                                        style
                                        {:color colors/gray})
                  :accessibility-label :no-messages-text}
      (i18n/label :t/no-messages)]

     (= constants/content-type-sticker content-type)
     [react/image {:style  {:margin 1 :width 20 :height 20}
                   ;;TODO (perf) move to event
                   :source {:uri (contenthash/url (-> content :sticker :hash))}}]

     (= constants/content-type-image content-type)
     [react/text {:style               style
                  :accessibility-label :no-messages-text}
      (i18n/label :t/image)]

     (= constants/content-type-audio content-type)
     [react/text {:style               style
                  :accessibility-label :no-messages-text}
      (i18n/label :t/audio)]

     (= constants/content-type-community content-type)
     (let [{:keys [name]}
           @(re-frame/subscribe [:communities/community community-id])]
       [react/text {:style               style
                    :accessibility-label :no-messages-text}
        (i18n/label :t/community-message-preview {:community-name name})])

     (string/blank? (:text content))
     [react/text {:style style}
      ""]

     (:text content)
     (render-message (:parsed-text content) max-notification-length max-number-of-lines style text-weight))])

(defn activity-text-item [home-item opts]
  (let [{:keys [chat-id chat-name message last-message reply-message muted read group-chat timestamp type color]} home-item
        message (or message last-message)
        {:keys [community-id]} (<sub [:chat-by-id chat-id])
        {:keys [name]} @(re-frame/subscribe [:communities/community community-id])
        sender (when message (first @(re-frame/subscribe [:contacts/contact-two-names-by-identity (message :from)])))]
    [react/touchable-opacity (merge {:style (styles/notification-container read)} opts)
     [react/view {:style styles/notification-content-container}
      [chat-icon.screen/chat-icon-view chat-id group-chat chat-name
       {:container              styles/photo-container
        :size                   40
        :chat-icon              chat-icon.styles/chat-icon-chat-list
        :default-chat-icon      (chat-icon.styles/default-chat-icon-chat-list color)
        :default-chat-icon-text (chat-icon.styles/default-chat-icon-text 40)
        :accessibility-label    :current-account-photo}]
      [quo/text {:weight              :medium
                 :color               (when muted :secondary)
                 :accessibility-label :chat-name-or-sender-text
                 :ellipsize-mode      :tail
                 :number-of-lines     1
                 :style               styles/title-text}
       (if (or
            (= type constants/activity-center-notification-type-mention)
            (= type constants/activity-center-notification-type-reply))
         sender
         [home-item/chat-item-title chat-id muted group-chat chat-name])]
      [react/text {:style               styles/datetime-text
                   :number-of-lines     1
                   :accessibility-label :notification-time-text}
       ;;TODO (perf) move to event
       (home-item/memo-timestamp timestamp)]
      [react/view {:style styles/notification-message-container}
       [message-content-text (select-keys message [:content :content-type :community-id]) max-notification-lines styles/notification-message-text]
       (cond (= type constants/activity-center-notification-type-mention)
             [react/view {:style styles/group-info-container
                          :accessibility-label :chat-name-container}
              [icons/icon
               (if community-id :main-icons/tiny-community :main-icons/tiny-group)
               {:color  colors/gray
                :width  16
                :height 16
                :container-style styles/group-icon}]
              (when community-id
                [react/view {:style styles/community-info-container}
                 [quo/text {:color :secondary
                            :weight :medium
                            :size :small}
                  name]
                 [icons/icon
                  :main-icons/chevron-down
                  {:color  colors/gray
                   :width  16
                   :height 22}]])
              [quo/text {:color :secondary
                         :weight :medium
                         :size :small}
               (str (when community-id "#") chat-name)]]

             (= type constants/activity-center-notification-type-reply)
             [react/view {:style styles/reply-message-container
                          :accessibility-label :reply-message-container}
              [icons/icon
               :main-icons/tiny-reply
               {:color  colors/gray
                :width  18
                :height 18
                :container-style styles/reply-icon}]
              [message-content-text (select-keys reply-message [:content :content-type :community-id]) max-reply-lines styles/notification-reply-text :medium]])]]]))

Fix for group chat invites icon in activity center


;; Copyright © 2014 JUXT LTD.

;; We call this project modular to make the invocation: lein new modular appname
(defproject modular/lein-template "0.6.13"
  :description "Leiningen template for a full-featured component based app using modular extensions."
  :url "http://modularity.org/"
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.7.0-alpha4"]
                 ;; EDN reader with location metadata
                 [org.clojure/tools.reader "0.8.3"]
                 [org.clojure/tools.logging "0.2.6"]]
  :eval-in-leiningen true)

;; Copyright © 2014 JUXT LTD.

;; We call this project modular to make the invocation: lein new modular appname
(defproject modular/lein-template "0.6.14"
  :description "Leiningen template for a full-featured component based app using modular extensions."
  :url "http://modularity.org/"
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :dependencies [[org.clojure/clojure "1.7.0-alpha4"]
                 ;; EDN reader with location metadata
                 [org.clojure/tools.reader "0.8.3"]
                 [org.clojure/tools.logging "0.2.6"]]
  :eval-in-leiningen true)

Upgrade lein-template version

Upgrade lein-template version


;; Copyright © 2014 JUXT LTD.

;; We call this project modular to make the invocation: lein new modular appname
(defproject modular/lein-template "0.3.0"
  :description "Leiningen template for a full-featured component based app using modular extensions."
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :eval-in-leiningen true)

;; Copyright © 2014 JUXT LTD.

;; We call this project modular to make the invocation: lein new modular appname
(defproject modular/lein-template "0.5.0-SNAPSHOT"
  :description "Leiningen template for a full-featured component based app using modular extensions."
  :license {:name "The MIT License"
            :url "http://opensource.org/licenses/MIT"}
  :eval-in-leiningen true)

Bump version of lein-template

Bump version of lein-template


(require '[cljs.build.api :as b])

(b/watch (b/inputs "test" "src")
  {:main 'beicon.tests.runner
   :target :nodejs
   :output-to "out/tests.js"
   :output-dir "out"
   :optimizations :none
   :pretty-print true
   :language-in  :ecmascript5
   :language-out :ecmascript5
   :verbose true})

(require '[cljs.build.api :as b])

(b/watch (b/inputs "test" "src")
  {:main 'beicon.tests.runner
   :target :nodejs
   :output-to "out/tests.js"
   :output-dir "out"
   :optimizations :simple
   :pretty-print true
   :language-in  :ecmascript6
   :language-out :ecmascript5
   :verbose true})

Set optimization level to :simple for watch script.


(ns leiningen.help
  "Display a list of tasks or help for a given task."
  (:use [leiningen.util.ns :only [namespaces-matching]]))

(def tasks (->> (namespaces-matching "leiningen")
                (filter #(re-find #"^leiningen\.(?!core|util)[^\.]+$" (name %)))
                (distinct)
                (sort)))

(defn get-arglists [task]
  (for [args (:arglists (meta task))]
    (vec (remove #(= 'project %) args))))

(defn help-for
  "Help for a task is stored in its docstring, or if that's not present
  in its namespace."
  [task]
  (let [task-ns (doto (symbol (str "leiningen." task)) require)
        task (ns-resolve task-ns (symbol task))]
    (str "Arguments: " (pr-str (get-arglists task)) "\n"
         (or (:doc (meta task))
             (:doc (meta (find-ns task-ns)))))))

;; affected by clojure ticket #130: bug of AOT'd namespaces losing metadata
(defn help-summary-for [task-ns]
  (require task-ns)
  (let [task-name (last (.split (name task-ns) "\\."))]
    (str task-name (apply str (repeat (- 8 (count task-name)) " "))
         " - " (:doc (meta (find-ns task-ns))))))

(defn help
  "Display a list of tasks or help for a given task."
  ([task] (println (help-for task)))
  ([]
     (println "Leiningen is a build tool for Clojure.\n")
     (println "Several tasks are available:")
     (doseq [task-ns tasks]
       ;; (println (help-summary-for task-ns))
       (println " " (last (.split (name task-ns) "\\."))))
     (println "\nRun lein help $TASK for details.")
     (println "See http://github.com/technomancy/leiningen as well.")))

(ns leiningen.help
  "Display a list of tasks or help for a given task."
  (:use [leiningen.util.ns :only [namespaces-matching]]))

(def tasks (->> (namespaces-matching "leiningen")
                (filter #(re-find #"^leiningen\.(?!core|util)[^\.]+$" (name %)))
                (distinct)
                (sort)))

(defn get-arglists [task]
  (for [args (or (:help-arglists (meta task)) (:arglists (meta task)))]
    (vec (remove #(= 'project %) args))))

(defn help-for
  "Help for a task is stored in its docstring, or if that's not present
  in its namespace."
  [task]
  (let [task-ns (doto (symbol (str "leiningen." task)) require)
        task (ns-resolve task-ns (symbol task))
        help-fn (ns-resolve 'task-ns 'help)]
    (str "Arguments: " (pr-str (get-arglists task)) "\n"
         (or (and help-fn (help-fn))
             (:doc (meta task))
             (:doc (meta (find-ns task-ns)))))))

;; affected by clojure ticket #130: bug of AOT'd namespaces losing metadata
(defn help-summary-for [task-ns]
  (require task-ns)
  (let [task-name (last (.split (name task-ns) "\\."))]
    (str task-name (apply str (repeat (- 8 (count task-name)) " "))
         " - " (:doc (meta (find-ns task-ns))))))

(defn help
  "Display a list of tasks or help for a given task."
  ([task] (println (help-for task)))
  ([]
     (println "Leiningen is a build tool for Clojure.\n")
     (println "Several tasks are available:")
     (doseq [task-ns tasks]
       ;; (println (help-summary-for task-ns))
       (println " " (last (.split (name task-ns) "\\."))))
     (println "\nRun lein help $TASK for details.")
     (println "See http://github.com/technomancy/leiningen as well.")))

Allow tasks to provide their own help function.


(ns adventofcode.days.day4
  (:require [clojure.string :as s]
            [clojure.java.io :as io]))

(defn room-name [room]
  (subs room 0 (- (count room) 11)))

(defn sector-id [room]
  (let [length (count room)]
    (subs room (- length 10) (- length 7))))

(defn checksum [room]
  (let [length (count room)]
    (subs room (- length 6) (- length 1))))

(defn calc-checksum [room-name]
  (->> (s/replace room-name "-" "")
       (frequencies)
       (sort-by val)
       (reverse)
       (partition-by val)
       (map #(map first %))
       (map sort)
       (flatten)
       (take 5)
       (s/join)))

(defn sector-value [room]
  (if (= (checksum room) (calc-checksum (room-name room)))
    (Integer. (sector-id room))
    0))

(defn rooms [path]
  (line-seq (io/reader path)))

(reduce + (map sector-value (rooms "././files/day4_input.txt")))

(ns adventofcode.days.day4
  (:require [clojure.string :as s]
            [clojure.java.io :as io]))

(defn compare-freq [[k1 v1] [k2 v2]]
  (or (> v1 v2)
      (and (= v1 v2)
           (< (compare k1 k2) 0))))

(defn calc-checksum [room-name]
  (->> (s/replace room-name "-" "")
       (frequencies)
       (sort compare-freq)
       (flatten)
       (take-nth 2)
       (take 5)
       (s/join)))

(defn sector-value [room]
  (let [length (count room)]
    (letfn [(room-name [room] (subs room 0 (- length 11)))
            (sector-id [room] (subs room (- length 10) (- length 7)))
            (checksum [room] (subs room (- length 6) (- length 1)))]
      (if (= (checksum room) (calc-checksum (room-name room)))
        (Integer. (sector-id room))
        0))))

(defn rooms [path]
  (line-seq (io/reader path)))

(reduce + (map sector-value (rooms "././files/day4_input.txt")))

reduce redundancy and use custom comparator

should also be faster