(ns salava.badge.cron
  (:require [clojure.tools.logging :as log]
            [clojure.java.jdbc :as jdbc]
            [clojure.string :as string]
            [clj-time.core :as t]
            [salava.core.util :as u]
            [salava.core.http :as http]
            [clojure.data.json :as json]))

#_(defn- assertion [assertion-url]
  (http/http-req {:socket-timeout 10000
                  :conn-timeout   10000
                  :method :get
                  :url assertion-url
                  :throw-exceptions false
                  :as :json
                  :accept :json}))

(defn- assertion [asr-url]
 (let [response (->> (http/http-req {:socket-timeout 10000
                           :conn-timeout 10000
                           :method :get
                           :url asr-url
                           :throw-exceptions false
                           :accept :json})
                     (clojure.walk/keywordize-keys))]
   (if (clojure.string/includes? (get-in response [:headers :Content-Type]) "application/json")
        (assoc response :body (json/read-str (:body response) :key-fn keyword))
        nil)))

(defn- revoked? [asr]
  (or (= (:status asr) 410) (get-in asr [:body :revoked])))

#_(defn- remote-url [factory-url asr]
  (when (and (string? factory-url) (map? asr))
    (cond
      (string/starts-with? (get asr :id "") factory-url) factory-url
      (string/starts-with? (get-in asr [:verify :url] "") factory-url) factory-url
      (and (= (get-in asr [:related :type]) "Assertion")
           (string/starts-with? (get (http/json-get (get-in asr [:related :id])) :id "") factory-url)) factory-url
      :else nil)))

(defn- remote-url [factory-url asr]
 (when (and (string? factory-url) (not (clojure.string/blank? factory-url)) (map? asr))
  (let [related-asr (->> (get asr :related) first :id)]
   (if (and (not (clojure.string/blank? (:id asr)))
            (not (clojure.string/blank? related-asr))
            (= (second (clojure.string/split (get asr :id "") #"/v1")) (second (clojure.string/split related-asr #"/v1")))
            (= (first (clojure.string/split related-asr #"/v1")) factory-url))
     (first (clojure.string/split related-asr #"/v1"))
     (cond
       (string/starts-with? (get asr :id "") factory-url) factory-url
       (string/starts-with? (get-in asr [:verify :url] "") factory-url) factory-url
       (and (= (get-in asr [:related :type]) "Assertion")
            (string/starts-with? (get (http/json-get (get-in asr [:related :id])) :id "") factory-url)) factory-url
           :else nil)))))

#_(defn- issuer-verified? [factory-url asr]
  (when (and (string? factory-url) (map? asr) (string/starts-with? (get asr :id "") factory-url))
    (try
      (let [badge (if (map? (:badge asr)) (:badge asr) (http/json-get (:badge asr)))
            issuer-url (if (map? (:issuer badge)) (get-in badge [:issuer :id]) (:issuer badge))
            issuer-id (last (re-find #"/v1/client.*[?&]key=(\w+)" issuer-url))]
        (if issuer-id
          (:verified (http/json-get (str factory-url "/v1/client?key=" issuer-id)))
          false))
      (catch Throwable _ false))))

(defn- issuer-verified? [factory-url asr]
 (let [factory-url (remote-url factory-url asr)]
   (try
     (let [badge (if (map? (:badge asr)) (:badge asr) (http/json-get (:badge asr)))
           issuer-url (if (map? (:issuer badge)) (get-in badge [:issuer :id]) (:issuer badge))
           issuer-id (last (re-find #"/v1/client.*[?&]key=(\w+)" issuer-url))]
       (if issuer-id
         (:verified (http/json-get (str factory-url "/v1/client?key=" issuer-id)))
         false))
     (catch Throwable _ false))))

(defn- check-badge [ctx db-conn factory-url user-badge]
  (let [asr (assertion (:assertion_url user-badge))
        related-asr (->> (get-in asr [:body :related]) first :id)
        factory-url (remote-url factory-url (:body asr))
        delete-user-metabadge (first (u/plugin-fun (u/get-plugins ctx) "db" "clear-user-metabadge!"))
        check-metabadge (first (u/plugin-fun (u/get-plugins ctx) "db" "metabadge?!"))]
    (if (revoked? asr)
      (do
        (jdbc/execute! db-conn
                       ["UPDATE user_badge SET revoked = 1, last_checked = UNIX_TIMESTAMP() WHERE id = ?"
                        (:id user-badge)])
        (if delete-user-metabadge (delete-user-metabadge ctx (:id user-badge))))

      ;; still valid, check verified issuer
      (jdbc/with-db-transaction [t-con db-conn]
        (jdbc/execute! t-con ["UPDATE badge SET remote_url = ? WHERE id = ? AND remote_url IS NULL"
                              (remote-url factory-url (:body asr)) (:badge_id user-badge)])
        (jdbc/execute! t-con ["UPDATE badge SET issuer_verified = ? WHERE id = ? AND remote_url IS NOT NULL"
                              (if (issuer-verified? factory-url (:body asr))
                                1
                                0) (:badge_id user-badge)])
        (if (and check-metabadge (not (clojure.string/blank? factory-url))) (check-metabadge ctx factory-url user-badge))))))

(defn- check-badges [ctx db-conn factory-url]
  (log/info "check-badges: started working")
  (let [time-limit (+ (System/currentTimeMillis) (* 30 60 1000))
        sql "SELECT id, badge_id, assertion_url FROM user_badge
        WHERE assertion_url IS NOT NULL
        AND deleted = 0 AND revoked = 0 AND status = 'accepted'
        AND (expires_on IS NULL OR expires_on > UNIX_TIMESTAMP())
        ORDER BY last_checked LIMIT 1000"]
    (doseq [chunk (partition-all 10 (jdbc/query db-conn [sql]))]
      (when (> time-limit (System/currentTimeMillis))
        (doseq [user-badge chunk]
          (try
            ;(log/debug "check-badges: working on id " (:id user-badge))
            (check-badge ctx db-conn factory-url user-badge)
            (jdbc/execute! db-conn ["UPDATE user_badge SET last_checked = UNIX_TIMESTAMP() WHERE id = ?"
                              (:id user-badge)])
            (Thread/sleep 100)
            (catch InterruptedException _)
            (catch Throwable ex
              (log/error "check-badges failed")
              (log/error (.toString ex)))))
        (try (Thread/sleep 1000) (catch InterruptedException _)))))
  (log/info "check-badges: done"))

;;;

(defn every-hour [ctx]
  (let [h (t/hour (t/now))]
    (when (and (not= h 14) (not= h 15)) ; skip during afternoon hours
      (check-badges ctx (:connection (u/get-db ctx)) (get-in ctx [:config :factory :url])))))

(ns salava.badge.cron
  (:require [clojure.tools.logging :as log]
            [clojure.java.jdbc :as jdbc]
            [clojure.string :as string]
            [clj-time.core :as t]
            [salava.core.util :as u]
            [salava.core.http :as http]
            [clojure.data.json :as json]))

#_(defn- assertion [assertion-url]
   (http/http-req {:socket-timeout 10000
                   :conn-timeout   10000
                   :method :get
                   :url assertion-url
                   :throw-exceptions false
                   :as :json
                   :accept :json}))

(defn- assertion [asr-url]
 (let [response (->> (http/http-req {:socket-timeout 10000
                                     :conn-timeout 10000
                                     :method :get
                                     :url asr-url
                                     :throw-exceptions false
                                     :accept :json})
                     (clojure.walk/keywordize-keys))]
   (if (clojure.string/includes? (get-in response [:headers :Content-Type]) "application/json")
       (assoc response :body (json/read-str (:body response) :key-fn keyword))
       nil)))

(defn- revoked? [asr]
  (or (= (:status asr) 410) (get-in asr [:body :revoked])))

#_(defn- remote-url [factory-url asr]
   (when (and (string? factory-url) (map? asr))
     (cond
       (string/starts-with? (get asr :id "") factory-url) factory-url
       (string/starts-with? (get-in asr [:verify :url] "") factory-url) factory-url
       (and (= (get-in asr [:related :type]) "Assertion")
            (string/starts-with? (get (http/json-get (get-in asr [:related :id])) :id "") factory-url)) factory-url
       :else nil)))

(defn- remote-url [factory-url asr]
 (when (and (string? factory-url) (not (clojure.string/blank? factory-url)) (map? asr))
  (let [related-asr (->> (get asr :related) first :id)]
   (if (and (not (clojure.string/blank? (:id asr)))
            (not (clojure.string/blank? related-asr))
            (= (second (clojure.string/split (get asr :id "") #"/v1")) (second (clojure.string/split related-asr #"/v1")))
            (= (first (clojure.string/split related-asr #"/v1")) factory-url))
     (first (clojure.string/split related-asr #"/v1"))
     (cond
       (string/starts-with? (get asr :id "") factory-url) factory-url
       (string/starts-with? (get-in asr [:verify :url] "") factory-url) factory-url
       (and (= (get-in asr [:related :type]) "Assertion")
            (string/starts-with? (get (http/json-get (get-in asr [:related :id])) :id "") factory-url)) factory-url
           :else nil)))))

#_(defn- issuer-verified? [factory-url asr]
   (when (and (string? factory-url) (map? asr) (string/starts-with? (get asr :id "") factory-url))
     (try
       (let [badge (if (map? (:badge asr)) (:badge asr) (http/json-get (:badge asr)))
             issuer-url (if (map? (:issuer badge)) (get-in badge [:issuer :id]) (:issuer badge))
             issuer-id (last (re-find #"/v1/client.*[?&]key=(\w+)" issuer-url))]
         (if issuer-id
           (:verified (http/json-get (str factory-url "/v1/client?key=" issuer-id)))
           false))
       (catch Throwable _ false))))

(defn- issuer-verified? [factory-url asr]
 (let [factory-url (remote-url factory-url asr)]
   (try
     (let [badge (if (map? (:badge asr)) (:badge asr) (http/json-get (:badge asr)))
           issuer-url (if (map? (:issuer badge)) (get-in badge [:issuer :id]) (:issuer badge))
           issuer-id (last (re-find #"/v1/client.*[?&]key=(\w+)" issuer-url))]
       (if issuer-id
         (:verified (http/json-get (str factory-url "/v1/client?key=" issuer-id)))
         false))
     (catch Throwable _ false))))

(defn- check-badge [ctx db-conn factory-url user-badge]
  (let [asr (assertion (:assertion_url user-badge))
        factory-url (remote-url factory-url (:body asr))
        delete-user-metabadge (first (u/plugin-fun (u/get-plugins ctx) "db" "clear-user-metabadge!"))
        check-metabadge (first (u/plugin-fun (u/get-plugins ctx) "db" "metabadge?!"))]
    (if (revoked? asr)
      (do
        (jdbc/execute! db-conn
                       ["UPDATE user_badge SET revoked = 1, last_checked = UNIX_TIMESTAMP() WHERE id = ?"
                        (:id user-badge)])
        (if delete-user-metabadge (delete-user-metabadge ctx (:id user-badge))))

      ;; still valid, check verified issuer
      (jdbc/with-db-transaction [t-con db-conn]
        (jdbc/execute! t-con ["UPDATE badge SET remote_url = ? WHERE id = ? AND remote_url IS NULL"
                              (remote-url factory-url (:body asr)) (:badge_id user-badge)])
        (jdbc/execute! t-con ["UPDATE badge SET issuer_verified = ? WHERE id = ? AND remote_url IS NOT NULL"
                              (if (issuer-verified? factory-url (:body asr))
                                1
                                0) (:badge_id user-badge)])
        (if (and check-metabadge (not (clojure.string/blank? factory-url))) (check-metabadge ctx factory-url user-badge))))))

(defn- check-badges [ctx db-conn factory-url]
  (log/info "check-badges: started working")
  (let [time-limit (+ (System/currentTimeMillis) (* 30 60 1000))
        sql "SELECT id, badge_id, assertion_url FROM user_badge
        WHERE assertion_url IS NOT NULL
        AND deleted = 0 AND revoked = 0 AND status = 'accepted'
        AND (expires_on IS NULL OR expires_on > UNIX_TIMESTAMP())
        ORDER BY last_checked LIMIT 1000"]
    (doseq [chunk (partition-all 10 (jdbc/query db-conn [sql]))]
      (when (> time-limit (System/currentTimeMillis))
        (doseq [user-badge chunk]
          (try
            ;(log/debug "check-badges: working on id " (:id user-badge))
            (check-badge ctx db-conn factory-url user-badge)
            (jdbc/execute! db-conn ["UPDATE user_badge SET last_checked = UNIX_TIMESTAMP() WHERE id = ?"
                                    (:id user-badge)])
            (Thread/sleep 100)
            (catch InterruptedException _)
            (catch Throwable ex
              (log/error "check-badges failed")
              (log/error (.toString ex)))))
        (try (Thread/sleep 1000) (catch InterruptedException _)))))
  (log/info "check-badges: done"))

;;;

(defn every-hour [ctx]
  (let [h (t/hour (t/now))]
    (when (and (not= h 14) (not= h 15)) ; skip during afternoon hours
      (check-badges ctx (:connection (u/get-db ctx)) (get-in ctx [:config :factory :url])))))

Add metabadge check to badge cron

Add metabadge check to badge cron


(ns my-money.events
    (:require [clojure.string :as string]
              [reagent.core :as r]
              [ajax.core :refer [GET]]
              [my-money.calculations :as calc]
              [my-money.event-filters :as filters]))

(defonce response-data (r/atom nil))

(defonce form-data (r/atom {:username ""
                            :selected-filters {:type "all"
                                               :month "All-time"}}))

(defn handle-response [response]
  (reset! response-data response))

(defn get-events
  ([]
   (get-events (:username @form-data)))
  ([username]
   (GET "/events" {:handler handle-response
                  :params {:user username}})))

(defn balance-info [events]
  (when events
    [:div.container
     [:h1.col-md-4 (str "Balance " (calc/balance events) "€")]
     [:h1.col-md-4 (str "Expenses " (calc/expenses events) "€")]
     [:h1.col-md-4 (str "Income " (calc/income events) "€")]]))

(defn labelled-radio-button [value type]
  [:div.radio
   [:input {:type "radio"
            :value value
            :id value
            :name type
            :on-click #(swap! form-data assoc-in [:selected-filters :type] value)}]
   [:label {:for value} (string/capitalize value)]])

(defn month-filter [events]
  [:select {:on-change #(swap! form-data assoc-in [:selected-filters :month] (-> % .-target .-value))}
   [:option "All-time"]
   (for [month (filters/months events)]
     ^{:key month}
     [:option month])])

(defn filter-selector [events]
  [:form
   [month-filter events]
   [labelled-radio-button "all" "type"]
   [labelled-radio-button "expenses" "type"]
   [labelled-radio-button "incomes" "type"]])

(defn bank-event-table [events]
  [:div.table-responsive
   [:table.table.table-striped
    [:thead
     [:tr
      [:th "Date"]
      [:th "Amount"]
      [:th "Recipient"]]]
    [:tbody (for [event (rest events)]
              ^{:key (:id event)}
              [:tr
               [:td (str (:transaction_date event))]
               [:td (str (/ (:amount event) 100) "€")]
               [:td (str (:recipient event))]])]]])

(defn event-retrieval-form [form-data]
  [:form.form-inline {:on-submit #(get-events)}
   [:label {:for "events-username"} "Username"]
   [:input {:class "form-control"
            :id "events-username"
            :type "text"
            :value (:username @form-data)
            :on-change #(swap! form-data assoc :username (-> % .-target .-value))}]
   [:input {:type "submit"
            :class "btn btn-primary"
            :value "Get events"}]])

(defn events-page []
  (fn []
    (let [applied-filters (filters/combined-filter (:selected-filters @form-data))
          filtered-events (filter applied-filters @response-data)]
      [:div.container
       [event-retrieval-form form-data]
       [filter-selector @response-data]
       [balance-info @response-data]
       [bank-event-table filtered-events]])))

(ns my-money.events
    (:require [clojure.string :as string]
              [reagent.core :as r]
              [ajax.core :refer [GET]]
              [my-money.calculations :as calc]
              [my-money.event-filters :as filters]))

(defonce response-data (r/atom nil))

(defonce form-data (r/atom {:username ""
                            :selected-filters {:type "all"
                                               :month "All-time"}}))

(defn handle-response [response]
  (reset! response-data response))

(defn get-events
  ([]
   (get-events (:username @form-data)))
  ([username]
   (GET "/events" {:handler handle-response
                  :params {:user username}})))

(defn balance-info [events]
  (when events
    [:div.container
     [:h1.col-md-4 (str "Balance " (calc/balance events) "€")]
     [:h1.col-md-4 (str "Expenses " (calc/expenses events) "€")]
     [:h1.col-md-4 (str "Income " (calc/income events) "€")]]))

(defn labelled-radio-button [value type]
  [:div.radio
   [:input {:type "radio"
            :value value
            :id value
            :name type
            :on-click #(swap! form-data assoc-in [:selected-filters :type] value)}]
   [:label {:for value} (string/capitalize value)]])

(defn month-filter [events]
  [:select {:on-change #(swap! form-data assoc-in [:selected-filters :month] (-> % .-target .-value))}
   [:option "All-time"]
   (for [month (filters/months events)]
     ^{:key month}
     [:option month])])

(defn filter-selector [events]
  [:form
   [month-filter events]
   [labelled-radio-button "all" "type"]
   [labelled-radio-button "expenses" "type"]
   [labelled-radio-button "incomes" "type"]])

(defn bank-event-table [events]
  [:div.table-responsive
   [:table.table.table-striped
    [:thead
     [:tr
      [:th "Date"]
      [:th "Amount"]
      [:th "Recipient"]]]
    [:tbody (for [event events]
              ^{:key (:id event)}
              [:tr
               [:td (str (:transaction_date event))]
               [:td (str (/ (:amount event) 100) "€")]
               [:td (str (:recipient event))]])]]])

(defn event-retrieval-form [form-data]
  [:form.form-inline {:on-submit #(get-events)}
   [:label {:for "events-username"} "Username"]
   [:input {:class "form-control"
            :id "events-username"
            :type "text"
            :value (:username @form-data)
            :on-change #(swap! form-data assoc :username (-> % .-target .-value))}]
   [:input {:type "submit"
            :class "btn btn-primary"
            :value "Get events"}]])

(defn events-page []
  (fn []
    (let [applied-filters (filters/combined-filter (:selected-filters @form-data))
          filtered-events (filter applied-filters @response-data)]
      [:div.container
       [event-retrieval-form form-data]
       [filter-selector @response-data]
       [balance-info @response-data]
       [bank-event-table filtered-events]])))

Fix bug not showing first event in events


(ns retroboard.user
  (:require [retroboard.xhr :as xhr]
            [retroboard.util :refer [display]]
            [cljs.core.async :refer [<! chan]]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true])
  (:require-macros [cljs.core.async.macros :refer [go]]))

(enable-console-print!)

(defn do-login
  ([email password]
     (let [ch (chan)]
       (do-login email password ch)
       ch))
  ([email password ch]
     (xhr/edn-xhr
      {:method :post
       :url "/login"
       :data {:username email
              :password password}
       :chan ch})))

(defn signup
  ([username email password]
     (let [ch (chan)]
       (signup username email password ch)
       ch))
  ([username email password ch]
     (xhr/edn-xhr
      {:method :post
       :url "/signup"
       :data {:username username
              :email email
              :password password}
       :chan ch})))

(defn add-board
  ([eid]
     (let [ch (chan)]
       (add-board eid ch)
       ch))
  ([eid ch]
     (xhr/edn-xhr
      {:method :post
       :url "/boards/add"
       :data {:eid eid}
       :chan ch})))

(defn fetch-boards
  ([]
     (let [ch (chan)]
       (fetch-boards ch)
       ch))
  ([ch]
     (xhr/edn-xhr
      {:method :get
       :url "/boards"
       :chan ch})))

(defn input [owner id placeholder & type]
  (dom/input #js {:type (or (first type) "text")
                  :id (name id)
                  :onChange (fn [e]
                              (om/set-state! owner id
                                             (.. e -target -value)))
                  :placeholder placeholder}))

(defn login-view [app owner {:keys [on-login]}]
  (reify
    om/IInitState
    (init-state [_]
      {:screen :login
       :ch (chan)})
    om/IWillMount
    (will-mount [_]
      (let [ch (om/get-state owner :ch)]
        (go (while true
              (let [{:keys [status body]} (<! ch)]
                (if (<= 200 status 300)
                  (on-login)))))))
    om/IRenderState
    (render-state [_ {:keys [ch screen username email password]}]
      (dom/div #js {:id "login-signup"}
               (dom/form #js {:id "login"
                              :style (display (= screen :login))}
                         (input owner :email "Your username or email")
                         (input owner :password "Your password" "password")
                         (dom/button
                          #js {:onClick (fn [e]
                                          (.preventDefault e)
                                          (do-login email
                                                    password
                                                    ch))}
                          "Login")
                         (dom/a #js {:href "#"
                                     :onClick (fn [_] (om/set-state! owner :screen :signup))}
                                "or sign up"))
               (dom/form #js {:id "signup"
                              :style (display (= screen :signup))}
                         (input owner :username "Choose a username")
                         (input owner :email "Your email")
                         (input owner :password "Choose a password" "password")
                         (dom/button
                          #js {:onClick (fn [e]
                                          (.preventDefault e)
                                          (signup username
                                                  email
                                                  password
                                                  ch))}
                          "Signup")
                         (dom/a #js {:href "#"
                                     :onClick (fn [_] (om/set-state! owner :screen :login))}
                                "or login"))))))

(defn board-link [board-id]
  (dom/a #js {:href (str "/e/" board-id)}
         board-id))

(defn profile-view [app owner]
  (reify
    om/IInitState
    (init-state [_]
      {:boards nil
       :logged-in? false
       :ch (chan)})
    om/IWillMount
    (will-mount [_]
      (let [ch (om/get-state owner :ch)]
        (fetch-boards ch)
        (go (while true
              (let [{:keys [status body]} (<! ch)]
                (om/set-state! owner :logged-in? (= 200 status))
                (om/set-state! owner :boards body))))))
    om/IRenderState
    (render-state [_ {:keys [logged-in? boards ch]}]
      (dom/div nil
               (dom/h1 nil "Logged in? " (pr-str logged-in?))
               (if logged-in?
                 (dom/div nil
                          (dom/div nil
                                   (dom/h1 nil "Your Boards")
                                   (apply dom/ul nil
                                          (map #(dom/li nil (board-link %)) boards)))
                          (dom/a #js {:href "/logout"} "Logout"))
                 (dom/div nil
                          (om/build login-view app {:opts {:on-login #(fetch-boards ch)}})))))))

(ns retroboard.user
  (:require [retroboard.xhr :as xhr]
            [retroboard.util :refer [display]]
            [cljs.core.async :refer [<! chan]]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true])
  (:require-macros [cljs.core.async.macros :refer [go]]))

(enable-console-print!)

(defn do-login
  ([email password]
     (let [ch (chan)]
       (do-login email password ch)
       ch))
  ([email password ch]
     (xhr/edn-xhr
      {:method :post
       :url "/login"
       :data {:username email
              :password password}
       :chan ch})))

(defn signup
  ([username email password]
     (let [ch (chan)]
       (signup username email password ch)
       ch))
  ([username email password ch]
     (xhr/edn-xhr
      {:method :post
       :url "/signup"
       :data {:username username
              :email email
              :password password}
       :chan ch})))

(defn add-board
  ([eid]
     (let [ch (chan)]
       (add-board eid ch)
       ch))
  ([eid ch]
     (xhr/edn-xhr
      {:method :post
       :url "/boards/add"
       :data {:eid eid}
       :chan ch})))

(defn fetch-boards
  ([]
     (let [ch (chan)]
       (fetch-boards ch)
       ch))
  ([ch]
     (xhr/edn-xhr
      {:method :get
       :url "/boards"
       :chan ch})))

(defn input [id placeholder on-change & [type]]
  (dom/input #js {:type (or type "text")
                  :id (name id)
                  :onChange on-change
                  :placeholder placeholder}))

(defn handle-change [owner id]
  (fn [e]
    (let [new-value (.. e -target -value)]
      (om/set-state! owner id new-value))))

(defn login-view [app owner {:keys [on-login]}]
  (reify
    om/IInitState
    (init-state [_]
      {:screen :login
       :ch (chan)})
    om/IWillMount
    (will-mount [_]
      (let [ch (om/get-state owner :ch)]
        (go (while true
              (let [{:keys [status body]} (<! ch)]
                (if (<= 200 status 300)
                  (on-login)))))))
    om/IRenderState
    (render-state [_ {:keys [ch screen username email password]}]
      (dom/div #js {:id "login-signup"}
               (dom/form #js {:id "login"
                              :style (display (= screen :login))}
                         (input :email "Your username or email"
                                (handle-change owner :email))
                         (input :password "Your password"
                                (handle-change owner :password)
                                "password")
                         (dom/button
                          #js {:onClick (fn [e]
                                          (.preventDefault e)
                                          (do-login email
                                                    password
                                                    ch))}
                          "Login")
                         (dom/a #js {:href "#"
                                     :onClick (fn [_] (om/set-state! owner :screen :signup))}
                                "or sign up"))
               (dom/form #js {:id "signup"
                              :style (display (= screen :signup))}
                         (input :username "Choose a username"
                                (handle-change owner :username))
                         (input :email "Your email"
                                (handle-change owner :email))
                         (input :password "Choose a password"
                                (handle-change owner :password)
                                "password")
                         (dom/button
                          #js {:onClick (fn [e]
                                          (.preventDefault e)
                                          (signup username
                                                  email
                                                  password
                                                  ch))}
                          "Signup")
                         (dom/a #js {:href "#"
                                     :onClick (fn [_] (om/set-state! owner :screen :login))}
                                "or login"))))))

(defn board-link [board-id]
  (dom/a #js {:href (str "/e/" board-id)}
         board-id))

(defn profile-view [app owner]
  (reify
    om/IInitState
    (init-state [_]
      {:boards nil
       :logged-in? false
       :ch (chan)})
    om/IWillMount
    (will-mount [_]
      (let [ch (om/get-state owner :ch)]
        (fetch-boards ch)
        (go (while true
              (let [{:keys [status body]} (<! ch)]
                (om/set-state! owner :logged-in? (= 200 status))
                (om/set-state! owner :boards body))))))
    om/IRenderState
    (render-state [_ {:keys [logged-in? boards ch]}]
      (dom/div nil
               (dom/h1 nil "Logged in? " (pr-str logged-in?))
               (if logged-in?
                 (dom/div nil
                          (dom/div nil
                                   (dom/h1 nil "Your Boards")
                                   (apply dom/ul nil
                                          (map #(dom/li nil (board-link %)) boards)))
                          (dom/a #js {:href "/logout"} "Logout"))
                 (dom/div nil
                          (om/build login-view app {:opts {:on-login #(fetch-boards ch)}})))))))

Move change code into a helper

Move change code into a helper


(ns clojure-ruby.evaluate)

(declare evaluate)

(defn evaluate-body [system body]
  (mapv (partial evaluate system) body))

(defn ruby-msg [system obj method-name args]
  (if-let [meth (get-in obj [:methods method-name])]
    (apply meth system obj args)
    (throw (ex-info "Method lookup failed" {:object obj, :method method-name}))))

(defmulti evaluate-one (fn [vars stmt] (first stmt)))

(defmethod evaluate-one :assignment [system stmt]
  (let [[_ name val] stmt
        val (evaluate system val)]
    (swap! (:variables system) assoc name val)))

(defmethod evaluate-one :reference [system stmt]
  (let [[_ name] stmt]
    (if-let [var (get @(:variables system) name)]
      var
      (if-let [meth (get @(:methods system) name)]
        (evaluate-body system meth)
        (throw (ex-info "Cannot find variable or method" {:name name}))))))

(defmethod evaluate-one :method-call [system stmt]
  (let [[_ obj method & args] stmt
        obj (evaluate system obj)
        args (map (partial evaluate system) args)]
    (ruby-msg system obj method args)))

(defmethod evaluate-one :number [system stmt]
  (let [[_ val] stmt
        {:keys [create-number]} system]
    (create-number (Long. val))))

(defmethod evaluate-one :string [system stmt]
  (let [[_ val] stmt
        {:keys [create-string]} system]
    (create-string val)))

(defmethod evaluate-one :if [system stmt]
 (let [[_ & branches] stmt
       {:keys [as-host-boolean]} system]
   (loop [branches branches]
     (if-let [[branch & branches] branches]
       (let [[_ predicate & body] branch]
         (if (as-host-boolean (evaluate system predicate))
           (evaluate-body system body)
           (recur branches)))))))

(defmethod evaluate-one :while [system stmt]
  (let [[_ predicate & body] stmt
        {:keys [as-host-boolean]} system]
    (while (as-host-boolean (evaluate system predicate))
      (evaluate-body system body))))

(defmethod evaluate-one :until [system stmt]
  (let [[_ predicate & body] stmt
        {:keys [as-host-boolean]} system]
    (while (not (as-host-boolean (evaluate system predicate)))
      (evaluate-body system body))))

(defmethod evaluate-one :case [system stmt]
  (let [[_ predicate & whens] stmt
        predicate (evaluate system predicate)
        {:keys [as-host-boolean]} system]
    (loop [whens whens]
      (if-let [[when & whens] (seq whens)]
        (let [[_ matcher & body] when
              matcher (evaluate system matcher)]
          (if (as-host-boolean (ruby-msg system predicate "===" [matcher]))
            (evaluate-body system body)
            (recur whens)))))))

(defmethod evaluate-one :method-def [system stmt]
  (let [[_ name args & body] stmt]
    (swap! (:methods system) assoc name body)))

(defn evaluate [system stmt]
  (try
    (evaluate-one system stmt)
    (catch Exception e
      (throw (ex-info "Evaluation failed" {:statement stmt} e)))))

(defn evaluate-all [create-string create-number as-host-boolean initial-variables stmts]
  (let [system {:variables (atom initial-variables)
                :methods (atom {})
                :create-string create-string
                :create-number create-number
                :as-host-boolean as-host-boolean}]
    (doseq [stmt stmts]
      (evaluate system stmt))))

(ns clojure-ruby.evaluate)

(declare evaluate)

(defn evaluate-body [system body]
  (mapv (partial evaluate system) body))

(defn method-lookup [obj method-name]
  (get-in obj [:methods method-name]))

(defn ruby-msg [system obj method-name args]
  (if-let [meth (method-lookup obj method-name)]
    (if (fn? meth)
      (apply meth system obj args)
      (evaluate-body system meth))
    (throw (ex-info "Method lookup failed" {:object obj, :method method-name}))))

(defmulti evaluate-one (fn [vars stmt] (first stmt)))

(defmethod evaluate-one :assignment [system stmt]
  (let [[_ name val] stmt
        val (evaluate system val)]
    (swap! (:variables system) assoc name val)))

(defmethod evaluate-one :reference [system stmt]
  (let [[_ name] stmt]
    (if-let [var (get @(:variables system) name)]
      var
      (let [self (get @(:variables system) "self")]
        (if (method-lookup self name)
          (ruby-msg system self name [])
          (throw (ex-info "Cannot find variable or method" {:name name})))))))

(defmethod evaluate-one :method-call [system stmt]
  (let [[_ obj method & args] stmt
        obj (evaluate system obj)
        args (map (partial evaluate system) args)]
    (ruby-msg system obj method args)))

(defmethod evaluate-one :number [system stmt]
  (let [[_ val] stmt
        {:keys [create-number]} system]
    (create-number (Long. val))))

(defmethod evaluate-one :string [system stmt]
  (let [[_ val] stmt
        {:keys [create-string]} system]
    (create-string val)))

(defmethod evaluate-one :if [system stmt]
 (let [[_ & branches] stmt
       {:keys [as-host-boolean]} system]
   (loop [branches branches]
     (if-let [[branch & branches] branches]
       (let [[_ predicate & body] branch]
         (if (as-host-boolean (evaluate system predicate))
           (evaluate-body system body)
           (recur branches)))))))

(defmethod evaluate-one :while [system stmt]
  (let [[_ predicate & body] stmt
        {:keys [as-host-boolean]} system]
    (while (as-host-boolean (evaluate system predicate))
      (evaluate-body system body))))

(defmethod evaluate-one :until [system stmt]
  (let [[_ predicate & body] stmt
        {:keys [as-host-boolean]} system]
    (while (not (as-host-boolean (evaluate system predicate)))
      (evaluate-body system body))))

(defmethod evaluate-one :case [system stmt]
  (let [[_ predicate & whens] stmt
        predicate (evaluate system predicate)
        {:keys [as-host-boolean]} system]
    (loop [whens whens]
      (if-let [[when & whens] (seq whens)]
        (let [[_ matcher & body] when
              matcher (evaluate system matcher)]
          (if (as-host-boolean (ruby-msg system predicate "===" [matcher]))
            (evaluate-body system body)
            (recur whens)))))))

(defmethod evaluate-one :method-def [system stmt]
  (let [[_ name args & body] stmt]
    (swap! (:variables system) assoc-in ["self" :methods name] body)))

(defn evaluate [system stmt]
  (try
    (evaluate-one system stmt)
    (catch Exception e
      (throw (ex-info "Evaluation failed" {:statement stmt} e)))))

(defn evaluate-all [create-string create-number as-host-boolean initial-variables stmts]
  (let [system {:variables (atom initial-variables)
                :create-string create-string
                :create-number create-number
                :as-host-boolean as-host-boolean}]
    (doseq [stmt stmts]
      (evaluate system stmt))))

Store Ruby-defined methods directly on the object


(ns cljs.source-map
  (:require [clojure.java.io :as io]
            [clojure.string :as string]
            [clojure.data.json :as json]
            [clojure.pprint :as pp]
            [cljs.source-map.base64-vlq :as base64-vlq]))

(defn source-compare [sources]
  (let [sources (->> sources
                  (map-indexed (fn [a b] [a b]))
                  (reduce (fn [m [i v]] (assoc m v i)) {}))]
    (fn [a b] (compare (sources a) (sources b)))))

(defn seg->map [seg source-map]
  (let [[gcol source line col name] seg]
   {:gcol   gcol
    :source (nth (:sources source-map) source)
    :line   line
    :col    col
    :name   (if-let [name (-> seg meta :name)]
              (nth (:names source-map) name))}))

(defn seg-combine [seg relseg]
  (let [[gcol source line col name] seg
        [rgcol rsource rline rcol rname] relseg
        nseg [(+ gcol rgcol)
              (+ (or source 0) rsource)
              (+ (or line 0) rline)
              (+ (or col 0) rcol)
              (+ (or name 0) rname)]]
    (if name
      (with-meta nseg {:name (+ name rname)})
      nseg)))

(defn update-result [result segmap gline]
  (let [{:keys [gcol source line col name]} segmap
        d {:gline gline
           :gcol gcol}
        d (if name (assoc d :name name) d)]
    (update-in result [source]
      (fnil (fn [m]
              (update-in m [line]
                (fnil (fn [m]
                        (assoc m col d))
                      (sorted-map))))
            (sorted-map)))))

(defn decode
  ([source-map]
     (decode (:mappings source-map) source-map))
  ([mappings source-map]
     (let [{:keys [sources]} source-map
           relseg-init [0 0 0 0 0]
           lines (seq (string/split mappings #";"))]
       (loop [gline 0
              lines lines
              relseg relseg-init
              result (sorted-map-by (source-compare sources))]
         (if lines
           (let [line (first lines)
                 [result relseg]
                 (let [segs (seq (string/split line #","))]
                   (loop [segs segs relseg relseg result result]
                     (if segs
                       (let [seg (first segs)
                             nrelseg (seg-combine (base64-vlq/decode seg) relseg)]
                         (recur (next segs) nrelseg
                           (update-result result (seg->map nrelseg source-map) gline)))
                       [result relseg])))]
             (recur (inc gline) (next lines) (assoc relseg 0 0) result))
           result)))))

(defn encode [m]
  )

(defn gen-merged-map [cljs-map closure-map]
  )

(comment
  ;; INSTRUCTIONS:

  ;; switch into samples/repl
  ;; run repl to start clojure
  ;; build with
  (require '[cljs.closure :as cljsc])
  (cljsc/build "src" {:optimizations :simple :output-to "repl_sample.js" :source-map "repl_sample_map.json"})

  ;; load source map
  (def raw-source-map
    (json/read-json (slurp (io/file "samples/repl/repl_sample_map.json"))))

  ;; test it out
  (first (decode raw-source-map))

  ;; decoded source map preserves file order
  (= (keys (decode raw-source-map)) (:sources raw-source-map))
  )

(ns cljs.source-map
  (:require [clojure.java.io :as io]
            [clojure.string :as string]
            [clojure.data.json :as json]
            [clojure.pprint :as pp]
            [cljs.source-map.base64-vlq :as base64-vlq]))

(defn indexed-sources [sources]
  (->> sources
    (map-indexed (fn [a b] [a b]))
    (reduce (fn [m [i v]] (assoc m v i)) {})))

(defn source-compare [sources]
  (let [sources (indexed-sources sources)]
    (fn [a b] (compare (sources a) (sources b)))))

(defn seg->map [seg source-map]
  (let [[gcol source line col name] seg]
   {:gcol   gcol
    :source (nth (:sources source-map) source)
    :line   line
    :col    col
    :name   (if-let [name (-> seg meta :name)]
              (nth (:names source-map) name))}))

(defn seg-combine [seg relseg]
  (let [[gcol source line col name] seg
        [rgcol rsource rline rcol rname] relseg
        nseg [(+ gcol rgcol)
              (+ (or source 0) rsource)
              (+ (or line 0) rline)
              (+ (or col 0) rcol)
              (+ (or name 0) rname)]]
    (if name
      (with-meta nseg {:name (+ name rname)})
      nseg)))

(defn update-result [result segmap gline]
  (let [{:keys [gcol source line col name]} segmap
        d {:gline gline
           :gcol gcol}
        d (if name (assoc d :name name) d)]
    (update-in result [source]
      (fnil (fn [m]
              (update-in m [line]
                (fnil (fn [m]
                        (assoc m col d))
                      (sorted-map))))
            (sorted-map)))))

(defn decode
  ([source-map]
     (decode (:mappings source-map) source-map))
  ([mappings source-map]
     (let [{:keys [sources]} source-map
           relseg-init [0 0 0 0 0]
           lines (seq (string/split mappings #";"))]
       (loop [gline 0
              lines lines
              relseg relseg-init
              result (sorted-map-by (source-compare sources))]
         (if lines
           (let [line (first lines)
                 [result relseg]
                 (let [segs (seq (string/split line #","))]
                   (loop [segs segs relseg relseg result result]
                     (if segs
                       (let [seg (first segs)
                             nrelseg (seg-combine (base64-vlq/decode seg) relseg)]
                         (recur (next segs) nrelseg
                           (update-result result (seg->map nrelseg source-map) gline)))
                       [result relseg])))]
             (recur (inc gline) (next lines) (assoc relseg 0 0) result))
           result)))))

(defn encode [m]
  )

(defn gen-merged-map [cljs-map closure-map]
  )

(comment
  ;; INSTRUCTIONS:

  ;; switch into samples/repl
  ;; run repl to start clojure
  ;; build with
  (require '[cljs.closure :as cljsc])
  (cljsc/build "src" {:optimizations :simple :output-to "repl_sample.js" :source-map "repl_sample_map.json"})

  ;; load source map
  (def raw-source-map
    (json/read-json (slurp (io/file "samples/repl/repl_sample_map.json"))))

  ;; test it out
  (first (decode raw-source-map))

  ;; decoded source map preserves file order
  (= (keys (decode raw-source-map)) (:sources raw-source-map))
  )

break out indexed-sources helper, will need to reuse


(ns train-race.core
  (:require [train-race.handler :as handler]
            [luminus.repl-server :as repl]
            [luminus.http-server :as http]
            [luminus-migrations.core :as migrations]
            [train-race.config :refer [env]]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure.tools.logging :as log]
            [mount.core :as mount])
  (:gen-class))

(def cli-options
  [["-p" "--port PORT" "Port number"
    :parse-fn #(Integer/parseInt %)]])

(mount/defstate ^{:on-reload :noop}
                http-server
                :start
                (http/start
                  (-> env
                      (assoc :handler (handler/app))
                      (update :port #(or (-> env :options :port) %))))
                :stop
                (http/stop http-server))

(mount/defstate ^{:on-reload :noop}
                repl-server
                :start
                (when-let [nrepl-port (env :nrepl-port)]
                  (repl/start {:port nrepl-port}))
                :stop
                (when repl-server
                  (repl/stop repl-server)))

(defn stop-app []
  (doseq [component (:stopped (mount/stop))]
    (log/info component "stopped"))
  (shutdown-agents))

(defn start-app [args]
  (doseq [component (-> args
                        (parse-opts cli-options)
                        mount/start-with-args
                        :started)]
    (log/info component "started"))
  (.addShutdownHook (Runtime/getRuntime) (Thread. stop-app)))

(defn -main [& args]
  (cond
    (some #{"migrate" "rollback"} args)
    (do
      (mount/start #'train-race.config/env)
      (migrations/migrate args (select-keys env [:database-url]))
      (System/exit 0))
    :else
    (start-app args)))

(ns train-race.core
  (:require [train-race.handler :as handler]
            [luminus.repl-server :as repl]
            [luminus.http-server :as http]
            [luminus-migrations.core :as migrations]
            [train-race.config :refer [env]]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure.tools.logging :as log]
            [mount.core :as mount])
  (:gen-class))

(def cli-options
  [["-p" "--port PORT" "Port number"
    :parse-fn #(Integer/parseInt %)]])

(mount/defstate ^{:on-reload :noop}
                http-server
                :start
                (http/start
                  (-> env
                      (assoc :handler (handler/app))
                      (update :port #(or (-> env :options :port) %))))
                :stop
                (http/stop http-server))

(mount/defstate ^{:on-reload :noop}
                repl-server
                :start
                (when-let [nrepl-port (env :nrepl-port)]
                  (repl/start {:port nrepl-port}))
                :stop
                (when repl-server
                  (repl/stop repl-server)))

(defn stop-app []
  (doseq [component (:stopped (mount/stop))]
    (log/info component "stopped"))
  (shutdown-agents))

(defn start-app [args]
  (doseq [component (-> args
                        (parse-opts cli-options)
                        mount/start-with-args
                        :started)]
    (log/info component "started"))
  (.addShutdownHook (Runtime/getRuntime) (Thread. stop-app)))

(defn dev-restart
  ([] (dev-restart nil))
  ([& args]
   (log/info "Shutting down all services")
   (doseq [component (:stopped (mount/stop))]
     (log/info component "stopped"))
   (log/info "Restarting..")
   (start-app args)))

(defn -main [& args]
  (cond
    (some #{"migrate" "rollback"} args)
    (do
      (mount/start #'train-race.config/env)
      (migrations/migrate args (select-keys env [:database-url]))
      (System/exit 0))
    :else
    (start-app args)))

Add dev-restart function for REPL development


; https://projecteuler.net/problem=1

(ns euler.001
  (require [clojure.set :refer :all]
           [clojure.test :refer [is]]))

(defn multiple-of-n? [n, num]
  (zero? (mod num n)))

(defn multiple-of-3-or-5? [n]
  (or (multiple-of-n? 3 n)
      (multiple-of-n? 5 n)))

; Produce the entire range of numbers and then filter it down
(defn multiples-3-and-5-sol1 [min max]
  (reduce + (filter multiple-of-3-or-5? (range min max))))

(is (= 233168 (multiples-3-and-5-sol1 0 1000)))

; Use `distinct` instead
(defn multiples-3-and-5-sol2 [min max]
  (reduce + (distinct (concat (range min max 3)
                              (range min max 5)))))

(is (= 233168 (multiples-3-and-5-sol2 0 1000)))

; Produce two ranges and convert to `set` to deduplicate the range
; Apparently slightly more performant (but who cares)
(defn multiples-3-and-5-sol3 [min max]
  (reduce + (set (concat (range min max 3)
                         (range min max 5)))))

(is (= 233168 (multiples-3-and-5-sol3 0 1000)))

; https://projecteuler.net/problem=1

(ns euler.001
  (require [clojure.set :refer :all]
           [clojure.test :refer [is]]))

(defn multiple-of-n? [n, num]
  (zero? (mod num n)))

(defn multiple-of-3-or-5? [n]
  (or (multiple-of-n? 3 n)
      (multiple-of-n? 5 n)))

; Produce the entire range of numbers and then filter it down
(defn multiples-3-and-5-sol1 [min max]
  (reduce + (filter multiple-of-3-or-5? (range min max))))

; Use `distinct` instead
(defn multiples-3-and-5-sol2 [min max]
  (reduce + (distinct (concat (range min max 3)
                              (range min max 5)))))

; Produce two ranges and convert to `set` to deduplicate the range
; Apparently slightly more performant (but who cares)
(defn multiples-3-and-5-sol3 [min max]
  (reduce + (set (concat (range min max 3)
                         (range min max 5)))))

Remove inline tests in favor of dedicated test files


(ns elfeed-cljsrn.events
  (:require [ajax.core :as ajax]
            [day8.re-frame.async-flow-fx]
            [day8.re-frame.http-fx]
            [re-frame.core :refer [reg-event-db after debug dispatch reg-event-fx reg-fx]]
            [cljs.spec :as s]
            [elfeed-cljsrn.navigation :refer [routes]]
            [elfeed-cljsrn.local-storage :as ls]
            [elfeed-cljsrn.rn :as rn]
            [elfeed-cljsrn.db :as db :refer [app-db]]))

;; -- Helpers ------------------------------------------------------------------

(defn dec-to-zero
  "Same as dec if not zero"
  [arg]
  (if (pos? arg)
    (dec arg)
    arg))

(defn valid-url? [url]
  (clojure.string/starts-with? url "http://"))

;; -- Interceptors -------------------------------------------------------------

(defn check-and-throw
  "Throw an exception if db doesn't have a valid spec."
  [spec db]
  (when-not (s/valid? spec db)
    (let [explain-data (s/explain-data spec db)]
      (throw (ex-info (str "Spec check failed: " explain-data) explain-data)))))

(def check-spec
  (if goog.DEBUG
    (after (partial check-and-throw ::db/app-db))
    []))

(def ->ls (after (fn [db] (ls/save (select-keys db '(:entries :nav :server :update-time))))))

;; -- Effect Handlers ----------------------------------------------------------

(reg-fx
 :get-localstore
 (fn [localstore-fx]
   (ls/load #(dispatch (conj (:on-success localstore-fx) %)))))

(reg-fx
 :open-url
 (fn [url]
   (.openURL (.-Linking rn/ReactNative) url)))

(reg-fx
 :open-drawer
 (fn [drawer-ref]
   (.openDrawer drawer-ref)))

(reg-fx
 :close-drawer
 (fn [drawer-ref]
   (.closeDrawer drawer-ref)))

;; -- Event Handlers -----------------------------------------------------------

(defn boot-flow []
  {:first-dispatch [:load-localstore]
   :rules [{:when :seen?
            :events :success-load-localstore
            :dispatch-n (list [:init-nav] [:fetch-content])}
           {:when :seen-both?
            :events [:success-fetch-entries :success-fetch-update-time]
            :dispatch [:success-boot] :halt? true}]})

(reg-event-fx
 :boot
 [debug]
 (fn [_ _]
   {:db (assoc app-db :booting? true)
    :async-flow (boot-flow)}))

(reg-event-db
 :success-boot
 (fn [db [_ _]]
   (assoc db :booting? false)))

(reg-event-fx
 :load-localstore
 (fn [{db :db} _]
   {:get-localstore {:on-success [:success-load-localstore]}
    :db (assoc db :loading-ls? true)}))

(reg-event-db
 :success-load-localstore
 (fn [db [_ value]]
   (-> db
       (merge value)
       (assoc :loading-ls? false))))

(reg-event-fx
 :update-server
 [check-spec]
 (fn [{db :db} [_ url]]
   {:http-xhrio {:method :post
                 :uri (str url "/elfeed/update")
                 :format :json
                 :response-format (ajax/json-response-format {:keywords? true})
                 :on-success [:success-update-server]
                 :on-failure [:failure-update-server]}
    :db (assoc db :server {:url url :checking? true})}))

(reg-event-fx
 :success-update-server
 [->ls check-spec]
 (fn [{db :db} _]
   {:db (update db :server merge {:valid? true :checking? false})}))

(reg-event-fx
 :failure-update-server
 [check-spec]
 (fn [{db :db} [_ error]]
   {:db (assoc db :server {:url nil :valid? false :error-message (:status-text error) :checking? false})}))

(reg-event-fx
 :save-server
 (fn [{db :db} [_ url ]]
   (let [events {:db (assoc db :server {:url url :checking? true})}]
     (if (valid-url? url)
       (merge events {:http-xhrio {:method :post
                                   :uri (str url "/elfeed/update")
                                   :format :json
                                   :response-format (ajax/json-response-format {:keywords? true})
                                   :on-success [:success-save-server]
                                   :on-failure [:failure-save-server]}})
       (merge events {:dispatch [:failure-save-server {:status-text "Invalid URL (should start with http://)"}]})))))

(reg-event-fx
 :success-save-server
 [->ls check-spec]
 (fn [{db :db} _]
   {:dispatch-n (list [:nav/push (:entries routes)] [:fetch-content])
    :db (update db :server merge {:valid? true :checking? false})}))

(reg-event-fx
 :failure-save-server
 (fn [{db :db} [_ error]]
   {:db (assoc db :server {:url nil :valid? false :error-message (:status-text error) :checking? false})}))

(reg-event-db
 :init-nav
 ->ls
 (fn [db _]
   (let [route (if (:valid? (:server db))
                 {:key :entries :title "All entries"}
                 {:key :configure-server :title "Configure your Elfeed server"})]
     (assoc db :nav {:index 0 :routes [route]}))))

(reg-event-fx
 :fetch-content
 (fn [{db :db} _]
   (if (:valid? (:server db))
     {:dispatch-n (list [:fetch-entries] [:fetch-update-time])
      :db db}
     {:db db})))

(reg-event-fx
 :fetch-entries
 (fn [{db :db} _]
   (let [query-term (js/encodeURIComponent
                     (or (:term (:search db)) (:default-term (:search db))))
         uri (str (:url (:server db)) "/elfeed/search?q=" query-term)]
     {:http-xhrio {:method :post
                   :uri uri
                   :format :text
                   :response-format (ajax/json-response-format {:keywords? true})
                   :keywords? true
                   :on-success [:success-fetch-entries]
                   :on-failure [:failure-fetch-entries]}
      :db (assoc db
                 :error-entries false
                 :fetching-entries? true)})))

(reg-event-db
 :success-fetch-entries
 ->ls
 (fn [db [_ response]]
   (-> db
       (assoc :fetching-entries? false)
       ;; TODO check if we can do this in a different way. SwipeableListView
       ;; needs a collection of elements with id attribute
       (assoc :entries (map (fn [x] (merge {:id (:webid x)} x)) response)))))

(reg-event-db
 :failure-fetch-entries
 (fn [db [_ error]]
   (-> db
       (assoc :fetching-entries? false)
       (assoc :error-entries error))))

(reg-event-fx
 :mark-entry-as-read
 [check-spec]
 (fn [{db :db} [_ entry]]
   {:http-xhrio {:method :put
                 :uri (str (:url (:server db)) "/elfeed/tags")
                 :params {:entries (list (:webid entry)) :remove (list "unread")}
                 :format (ajax/json-request-format)
                 :response-format (ajax/json-response-format)
                 :on-success [:success-mark-entry-as-read]
                 :on-failure [:failure-mark-entry-as-read]}
    :db (update db :recent-reads (fn [coll]
                                   (if coll
                                     (conj coll (:webid entry))
                                     #{(:webid entry)})))}))

(reg-event-db
 :success-mark-entry-as-read
 [check-spec]
 (fn [db [_ response]]
   db))

(reg-event-db
 :failure-mark-entry-as-read
 [check-spec]
 (fn [db [_ error]]
   db))

(reg-event-fx
 :fetch-entry-content
 [check-spec]
 (fn [{db :db} [_ entry]]
   {:http-xhrio {:method :post
                 :uri (str (:url (:server db)) "/elfeed/content/" (:content entry))
                 :format :json
                 :response-format (ajax/text-response-format)
                 :on-success [:success-fetch-entry-content entry]
                 :on-failure [:failure-fetch-entry-content]}
    :db (-> db
            (assoc :error-entry false
                   :current-entry (:webid entry)
                   :fetching-entry? true)
            (assoc-in [:entries-m (:webid entry)] entry))}))

(reg-event-db
 :success-fetch-entry-content
 [->ls check-spec]
 (fn [db [_ entry response]]
   (dispatch [:mark-entry-as-read entry])
   (let [clean-response (clojure.string/replace response "\n" " ")]
     (-> db
         (assoc :fetching-entry? false)
         (assoc-in [:entries-m (:webid entry) :content-body] clean-response)))))

(reg-event-db
 :failure-fetch-entry-content
 [check-spec]
 (fn [db [_ error]]
   (-> db
       (assoc :fetching-entry? false)
       (assoc :error-entry error))))

(reg-event-fx
 :fetch-update-time
 (fn [{db :db} _]
   {:http-xhrio {:method :post
                 :uri (str (:url (:server db)) "/elfeed/update")
                 :params {:time (:update-time db)}
                 :format :json
                 :response-format (ajax/json-response-format {:keywords? true})
                 :on-success [:success-fetch-update-time]
                 :on-failure [:failure-fetch-update-time]}
    :db (assoc db :fetching-update-time true)}))

(reg-event-db
 :success-fetch-update-time
 ->ls
 (fn [db [_ response]]
   (-> db
       (assoc :fetching-update-time false)
       (assoc :update-time response))))

(reg-event-db
 :failure-fetch-update-time
 (fn [db [_ error]]
   (-> db
       (assoc :fetching-update-time? false)
       (assoc :error-update-time error))))

(reg-event-db
 :update-server-value
 ->ls
 (fn [db [_ value]]
   (assoc db :server value)))

(reg-event-fx
 :open-entry-in-browser
 (fn [{db :db} _]
   (let [url (:link (get (:entries-m db) (:current-entry db)))]
     {:open-url url})))

(reg-event-db
 :drawer/set
 (fn [db [_ ref]]
   (assoc-in db [:drawer :ref] ref)))

(reg-event-fx
 :drawer/open
 (fn [{db :db} _]
   {:open-drawer (:ref (:drawer db))
    :db (assoc-in db [:drawer :open?] true)}))

(reg-event-fx
 :drawer/close
 (fn [{db :db} _]
   {:close-drawer (:ref (:drawer db))
    :db (assoc-in db [:drawer :open?] false)}))

(reg-event-db
 :nav/push
 [check-spec]
 (fn [db [_ value]]
   (-> db
       (update-in [:nav :index] inc)
       (update-in [:nav :routes] #(conj % value)))))

(reg-event-db
 :nav/pop
 [check-spec]
 (fn [db [_ _]]
   (-> db
       (update-in [:nav :index] dec-to-zero)
       (update-in [:nav :routes] pop))))

(reg-event-db
 :connection/set
 [debug]
 (fn [db [_ value]]
   (assoc db :connected? value)))

(reg-event-db
 :search/init
 [check-spec]
 (fn [db [_ _]]
   (assoc-in db [:search :searching?] true)))

(reg-event-db
 :search/clear
 [check-spec]
 (fn [db [_ _]]
   (assoc-in db [:search :term] "")))

(reg-event-fx
 :search/execute
 [check-spec]
 (fn [{db :db} [_ search-term]]
   (let [term (if (empty? search-term) (:default-term (:search db)) search-term)]
     {:dispatch [:fetch-entries]
      :db (-> db
              (assoc-in [:search :term] term)
              (assoc-in [:search :searching?] false))})))

(reg-event-db
 :search/abort
 [check-spec]
 (fn [db [_ _]]
   (assoc-in db [:search :searching?] false)))

(ns elfeed-cljsrn.events
  (:require [ajax.core :as ajax]
            [day8.re-frame.async-flow-fx]
            [day8.re-frame.http-fx]
            [re-frame.core :refer [reg-event-db after debug dispatch reg-event-fx reg-fx]]
            [cljs.spec :as s]
            [elfeed-cljsrn.navigation :refer [routes]]
            [elfeed-cljsrn.local-storage :as ls]
            [elfeed-cljsrn.rn :as rn]
            [elfeed-cljsrn.db :as db :refer [app-db]]))

;; -- Helpers ------------------------------------------------------------------

(defn dec-to-zero
  "Same as dec if not zero"
  [arg]
  (if (pos? arg)
    (dec arg)
    arg))

(defn valid-url? [url]
  (not (nil? (re-matches #"(https?://)(.*)" url))))

;; -- Interceptors -------------------------------------------------------------

(defn check-and-throw
  "Throw an exception if db doesn't have a valid spec."
  [spec db]
  (when-not (s/valid? spec db)
    (let [explain-data (s/explain-data spec db)]
      (throw (ex-info (str "Spec check failed: " explain-data) explain-data)))))

(def check-spec
  (if goog.DEBUG
    (after (partial check-and-throw ::db/app-db))
    []))

(def ->ls (after (fn [db] (ls/save (select-keys db '(:entries :nav :server :update-time))))))

;; -- Effect Handlers ----------------------------------------------------------

(reg-fx
 :get-localstore
 (fn [localstore-fx]
   (ls/load #(dispatch (conj (:on-success localstore-fx) %)))))

(reg-fx
 :open-url
 (fn [url]
   (.openURL (.-Linking rn/ReactNative) url)))

(reg-fx
 :open-drawer
 (fn [drawer-ref]
   (.openDrawer drawer-ref)))

(reg-fx
 :close-drawer
 (fn [drawer-ref]
   (.closeDrawer drawer-ref)))

;; -- Event Handlers -----------------------------------------------------------

(defn boot-flow []
  {:first-dispatch [:load-localstore]
   :rules [{:when :seen?
            :events :success-load-localstore
            :dispatch-n (list [:init-nav] [:fetch-content])}
           {:when :seen-both?
            :events [:success-fetch-entries :success-fetch-update-time]
            :dispatch [:success-boot] :halt? true}]})

(reg-event-fx
 :boot
 [debug]
 (fn [_ _]
   {:db (assoc app-db :booting? true)
    :async-flow (boot-flow)}))

(reg-event-db
 :success-boot
 (fn [db [_ _]]
   (assoc db :booting? false)))

(reg-event-fx
 :load-localstore
 (fn [{db :db} _]
   {:get-localstore {:on-success [:success-load-localstore]}
    :db (assoc db :loading-ls? true)}))

(reg-event-db
 :success-load-localstore
 (fn [db [_ value]]
   (-> db
       (merge value)
       (assoc :loading-ls? false))))

(reg-event-fx
 :update-server
 [check-spec]
 (fn [{db :db} [_ url]]
   {:http-xhrio {:method :post
                 :uri (str url "/elfeed/update")
                 :format :json
                 :response-format (ajax/json-response-format {:keywords? true})
                 :on-success [:success-update-server]
                 :on-failure [:failure-update-server]}
    :db (assoc db :server {:url url :checking? true})}))

(reg-event-fx
 :success-update-server
 [->ls check-spec]
 (fn [{db :db} _]
   {:db (update db :server merge {:valid? true :checking? false})}))

(reg-event-fx
 :failure-update-server
 [check-spec]
 (fn [{db :db} [_ error]]
   {:db (assoc db :server {:url nil :valid? false :error-message (:status-text error) :checking? false})}))

(reg-event-fx
 :save-server
 (fn [{db :db} [_ url ]]
   (let [events {:db (assoc db :server {:url url :checking? true})}]
     (if (valid-url? url)
       (merge events {:http-xhrio {:method :post
                                   :uri (str url "/elfeed/update")
                                   :format :json
                                   :response-format (ajax/json-response-format {:keywords? true})
                                   :on-success [:success-save-server]
                                   :on-failure [:failure-save-server]}})
       (merge events {:dispatch [:failure-save-server {:status-text "Invalid URL (should start with http://)"}]})))))

(reg-event-fx
 :success-save-server
 [->ls check-spec]
 (fn [{db :db} _]
   {:dispatch-n (list [:nav/push (:entries routes)] [:fetch-content])
    :db (update db :server merge {:valid? true :checking? false})}))

(reg-event-fx
 :failure-save-server
 (fn [{db :db} [_ error]]
   {:db (assoc db :server {:url nil :valid? false :error-message (:status-text error) :checking? false})}))

(reg-event-db
 :init-nav
 ->ls
 (fn [db _]
   (let [route (if (:valid? (:server db))
                 {:key :entries :title "All entries"}
                 {:key :configure-server :title "Configure your Elfeed server"})]
     (assoc db :nav {:index 0 :routes [route]}))))

(reg-event-fx
 :fetch-content
 (fn [{db :db} _]
   (if (:valid? (:server db))
     {:dispatch-n (list [:fetch-entries] [:fetch-update-time])
      :db db}
     {:db db})))

(reg-event-fx
 :fetch-entries
 (fn [{db :db} _]
   (let [query-term (js/encodeURIComponent
                     (or (:term (:search db)) (:default-term (:search db))))
         uri (str (:url (:server db)) "/elfeed/search?q=" query-term)]
     {:http-xhrio {:method :post
                   :uri uri
                   :format :text
                   :response-format (ajax/json-response-format {:keywords? true})
                   :keywords? true
                   :on-success [:success-fetch-entries]
                   :on-failure [:failure-fetch-entries]}
      :db (assoc db
                 :error-entries false
                 :fetching-entries? true)})))

(reg-event-db
 :success-fetch-entries
 ->ls
 (fn [db [_ response]]
   (-> db
       (assoc :fetching-entries? false)
       ;; TODO check if we can do this in a different way. SwipeableListView
       ;; needs a collection of elements with id attribute
       (assoc :entries (map (fn [x] (merge {:id (:webid x)} x)) response)))))

(reg-event-db
 :failure-fetch-entries
 (fn [db [_ error]]
   (-> db
       (assoc :fetching-entries? false)
       (assoc :error-entries error))))

(reg-event-fx
 :mark-entry-as-read
 [check-spec]
 (fn [{db :db} [_ entry]]
   {:http-xhrio {:method :put
                 :uri (str (:url (:server db)) "/elfeed/tags")
                 :params {:entries (list (:webid entry)) :remove (list "unread")}
                 :format (ajax/json-request-format)
                 :response-format (ajax/json-response-format)
                 :on-success [:success-mark-entry-as-read]
                 :on-failure [:failure-mark-entry-as-read]}
    :db (update db :recent-reads (fn [coll]
                                   (if coll
                                     (conj coll (:webid entry))
                                     #{(:webid entry)})))}))

(reg-event-db
 :success-mark-entry-as-read
 [check-spec]
 (fn [db [_ response]]
   db))

(reg-event-db
 :failure-mark-entry-as-read
 [check-spec]
 (fn [db [_ error]]
   db))

(reg-event-fx
 :fetch-entry-content
 [check-spec]
 (fn [{db :db} [_ entry]]
   {:http-xhrio {:method :post
                 :uri (str (:url (:server db)) "/elfeed/content/" (:content entry))
                 :format :json
                 :response-format (ajax/text-response-format)
                 :on-success [:success-fetch-entry-content entry]
                 :on-failure [:failure-fetch-entry-content]}
    :db (-> db
            (assoc :error-entry false
                   :current-entry (:webid entry)
                   :fetching-entry? true)
            (assoc-in [:entries-m (:webid entry)] entry))}))

(reg-event-db
 :success-fetch-entry-content
 [->ls check-spec]
 (fn [db [_ entry response]]
   (dispatch [:mark-entry-as-read entry])
   (let [clean-response (clojure.string/replace response "\n" " ")]
     (-> db
         (assoc :fetching-entry? false)
         (assoc-in [:entries-m (:webid entry) :content-body] clean-response)))))

(reg-event-db
 :failure-fetch-entry-content
 [check-spec]
 (fn [db [_ error]]
   (-> db
       (assoc :fetching-entry? false)
       (assoc :error-entry error))))

(reg-event-fx
 :fetch-update-time
 (fn [{db :db} _]
   {:http-xhrio {:method :post
                 :uri (str (:url (:server db)) "/elfeed/update")
                 :params {:time (:update-time db)}
                 :format :json
                 :response-format (ajax/json-response-format {:keywords? true})
                 :on-success [:success-fetch-update-time]
                 :on-failure [:failure-fetch-update-time]}
    :db (assoc db :fetching-update-time true)}))

(reg-event-db
 :success-fetch-update-time
 ->ls
 (fn [db [_ response]]
   (-> db
       (assoc :fetching-update-time false)
       (assoc :update-time response))))

(reg-event-db
 :failure-fetch-update-time
 (fn [db [_ error]]
   (-> db
       (assoc :fetching-update-time? false)
       (assoc :error-update-time error))))

(reg-event-db
 :update-server-value
 ->ls
 (fn [db [_ value]]
   (assoc db :server value)))

(reg-event-fx
 :open-entry-in-browser
 (fn [{db :db} _]
   (let [url (:link (get (:entries-m db) (:current-entry db)))]
     {:open-url url})))

(reg-event-db
 :drawer/set
 (fn [db [_ ref]]
   (assoc-in db [:drawer :ref] ref)))

(reg-event-fx
 :drawer/open
 (fn [{db :db} _]
   {:open-drawer (:ref (:drawer db))
    :db (assoc-in db [:drawer :open?] true)}))

(reg-event-fx
 :drawer/close
 (fn [{db :db} _]
   {:close-drawer (:ref (:drawer db))
    :db (assoc-in db [:drawer :open?] false)}))

(reg-event-db
 :nav/push
 [check-spec]
 (fn [db [_ value]]
   (-> db
       (update-in [:nav :index] inc)
       (update-in [:nav :routes] #(conj % value)))))

(reg-event-db
 :nav/pop
 [check-spec]
 (fn [db [_ _]]
   (-> db
       (update-in [:nav :index] dec-to-zero)
       (update-in [:nav :routes] pop))))

(reg-event-db
 :connection/set
 [debug]
 (fn [db [_ value]]
   (assoc db :connected? value)))

(reg-event-db
 :search/init
 [check-spec]
 (fn [db [_ _]]
   (assoc-in db [:search :searching?] true)))

(reg-event-db
 :search/clear
 [check-spec]
 (fn [db [_ _]]
   (assoc-in db [:search :term] "")))

(reg-event-fx
 :search/execute
 [check-spec]
 (fn [{db :db} [_ search-term]]
   (let [term (if (empty? search-term) (:default-term (:search db)) search-term)]
     {:dispatch [:fetch-entries]
      :db (-> db
              (assoc-in [:search :term] term)
              (assoc-in [:search :searching?] false))})))

(reg-event-db
 :search/abort
 [check-spec]
 (fn [db [_ _]]
   (assoc-in db [:search :searching?] false)))

Fix url validation

Fix url validation

Accept http and https


(ns stuttaford.web.layout.html
  (:use [plumbing.core])
  (:require [hiccup.page :as page]
            [stuttaford.web.templates :refer [templates]]))

(defnk header [base-url [:meta title description] page]
  [:head
   [:link {:rel "profile" :href "http://gmpg.org/xfn/11"}]
   [:meta {:content "IE=edge" :http-equiv "X-UA-Compatible"}]
   [:meta {:content "text/html; charset=utf-8" :http-equiv "content-type"}]
   [:meta {:content "width=device-width initial-scale=1.0 maximum-scale=1":name "viewport"}]
   [:title
    (when-let [page-title (:title page)]
      (str page-title " · "))
    title ", " description]
   (when-let [description (:description page)]
     [:meta {:name "description" :content description}])
   (page/include-css
    (str base-url "css/poole.css")
    (str base-url "css/syntax.css")
    (str base-url "css/stuttaford.css"))
   (when-let [css (seq (:css page))]
     (->> css
          (map (partial str base-url))
          (apply page/include-css)))
   [:link {:href (str base-url "apple-touch-icon-precomposed.png") :sizes "152x152"
           :rel "apple-touch-icon-precomposed"}]
   [:link {:href (str base-url "favicon.ico") :rel "shortcut icon"}]
   [:link {:href (str base-url "atom.xml") :rel "alternate"
           :type "application/rss+xml" :title "RSS"}]])

(defnk nav-item [title path]
  [:small [:a {:href path} title]])

(defnk masthead [base-url [:meta title description] [:author twitter github] nav]
  [:div.masthead
   [:h3.masthead-title
    [:a {:title "Home" :href base-url} title] " "
    [:small description]]
   (->> nav
        (map nav-item)
        (interpose " · "))
   " · "
   [:small
    "I'm on " [:a {:href twitter} "Twitter"]
    " and " [:a {:href github} "GitHub"] "."]])

(defnk foot [google-analytics-id domain year]
  [:div.footer
   [:p "© " year ". All rights reserved."]
   [:script {:type "text/javascript"}
    "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
    (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
    m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
    })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
    ga('create', '" google-analytics-id "', '" domain "');
    ga('send', 'pageview');"]])

(defnk html-layout [base-url [:page layout content] :as config]
  (page/html5
   (header config)
   [:body
    [:div.container.content
     (masthead config)
     (when-let [page-layout (-> layout keyword templates)]
       (page-layout config))
     (foot config)]]))

(ns stuttaford.web.layout.html
  (:use [plumbing.core])
  (:require [hiccup.page :as page]
            [stuttaford.web.templates :refer [templates]]))

(defnk header [base-url [:meta title description] page]
  [:head
   [:link {:rel "profile" :href "http://gmpg.org/xfn/11"}]
   [:meta {:content "IE=edge" :http-equiv "X-UA-Compatible"}]
   [:meta {:content "text/html; charset=utf-8" :http-equiv "content-type"}]
   [:meta {:content "width=device-width initial-scale=1.0 maximum-scale=1":name "viewport"}]
   [:title
    (when-let [page-title (:title page)]
      (str page-title " · "))
    title ", " description]
   (when-let [description (:description page)]
     [:meta {:name "description" :content description}])
   (page/include-css
    (str base-url "css/poole.css")
    (str base-url "css/syntax.css")
    (str base-url "css/stuttaford.css"))
   (when-let [css (seq (:css page))]
     (->> css
          (map (partial str base-url))
          (apply page/include-css)))
   [:link {:href (str base-url "apple-touch-icon-precomposed.png") :sizes "152x152"
           :rel "apple-touch-icon-precomposed"}]
   [:link {:href (str base-url "favicon.ico") :rel "shortcut icon"}]
   [:link {:href (str base-url "atom.xml") :rel "alternate"
           :type "application/rss+xml" :title "RSS"}]])

(defnk nav-item [title path]
  [:small [:a {:href path} title]])

(defnk masthead [base-url [:meta title description] [:author twitter github] nav]
  [:div.masthead
   [:h3.masthead-title
    [:a {:title "Home" :href base-url} title] " "
    [:small description]]
   (->> nav
        (map nav-item)
        (interpose " · "))
   " · "
   [:small
    "I'm on " [:a {:href twitter} "Twitter"]
    " and " [:a {:href github} "GitHub"] "."]])

(defnk foot [google-analytics-id domain year [:author name]]
  [:div.footer
   [:p "© " name " " year ". All rights reserved. Some lefts, too."]
   [:script {:type "text/javascript"}
    "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
    (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
    m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
    })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
    ga('create', '" google-analytics-id "', '" domain "');
    ga('send', 'pageview');"]])

(defnk html-layout [base-url [:page layout content] :as config]
  (page/html5
   (header config)
   [:body
    [:div.container.content
     (masthead config)
     (when-let [page-layout (-> layout keyword templates)]
       (page-layout config))
     (foot config)]]))

Include name in copyright.

Include name in copyright.


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

(ns containium.deployer
  (:require [containium.systems :refer (require-system)]
            [containium.systems.config :refer (Config get-config)]
            [containium.modules :refer (Manager deploy! redeploy! undeploy!
                                                       register-notifier! unregister-notifier!)]
            [containium.deployer.watcher :refer (mk-watchservice watch close)]
            [clojure.java.io :refer (file)])
  (:import [containium.systems Startable Stoppable]
           [java.nio.file Path WatchService]
           [java.io File]))

;;; Public API for Deployer systems.

(defprotocol Deployer
  (bootstrap-modules [this]
    "Deploys all modules that should be started on Containium boot."))

;;; File system implementation.

(def ignore-files-re #".*\.status|\..*")

(defn- handle-notification
  [dir kind [module-name]]
  (spit (file dir (str module-name ".status")) (name kind)))

(defn- handle-event
  [manager dir kind file-or-path]
  (let [file-name (if (instance? Path file-or-path)
                    (.. ^Path file-or-path getFileName toString)
                    (.getName ^File file-or-path))
        timeout (* 1000 60)]
    (when-not (re-matches ignore-files-re file-name)
      (let [response (case kind
                       :create (deref (deploy! manager file-name (file dir file-name))
                                      timeout ::timeout)
                       :modify (deref (redeploy! manager file-name) timeout ::timeout)
                       :delete (deref (undeploy! manager file-name) timeout ::timeout))]
        (if (= ::timeout response)
          (println "Response for file system deployer action for" file-name "timed out."
                   "\nThe action may have failed or may still complete.")
          (println "File system deployer action for" file-name ":" (:message response)))))))

(defrecord DirectoryDeployer [manager ^File dir watcher]
  Deployer
  (bootstrap-modules [_]
    (doseq [^File file (.listFiles dir)]
      (when-not (or (.isDirectory file) (re-matches ignore-files-re (.getName file)))
        (println "File system deployer now bootstrapping module" file)
        (future (try
                  (handle-event manager dir :create (.getAbsoluteFile file))
                  (catch Exception ex
                    (.printStackTrace ex)))))))

  Stoppable
  (stop [_]
    (println "Stopping filesystem deployment watcher...")
    (close watcher)
    (unregister-notifier! manager "fs-deployer")
    (println "Filesystem deployment watcher stopped.")))

(def directory
  (reify Startable
    (start [_ systems]
      (let [config (get-config (require-system Config systems) :fs)
            manager (require-system Manager systems)]
        (println "Starting filesystem deployment watcher, using config" config "...")
        (assert (:deployments config) "Missing :deployments configuration for FS system.")
        (let [dir (file (:deployments config))]
          (assert (.exists dir) ("The directory " dir " does not exist."))
          (assert (.isDirectory dir) (str "Path " dir " is not a directory."))
          (register-notifier! manager "fs-deployer" (partial handle-notification dir))
          (let [watcher (-> (mk-watchservice (partial handle-event manager dir))
                            (watch dir))]
            (println "Filesystem deployment watcher started.")
            (DirectoryDeployer. manager dir watcher)))))))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

(ns containium.deployer
  (:require [containium.systems :refer (require-system)]
            [containium.systems.config :refer (Config get-config)]
            [containium.modules :refer (Manager deploy! redeploy! undeploy!
                                                       register-notifier! unregister-notifier!)]
            [containium.deployer.watcher :refer (mk-watchservice watch close)]
            [clojure.java.io :refer (file)])
  (:import [containium.systems Startable Stoppable]
           [java.nio.file Path WatchService]
           [java.io File]))

;;; Public API for Deployer systems.

(defprotocol Deployer
  (bootstrap-modules [this]
    "Deploys all modules that should be started on Containium boot."))

;;; File system implementation.

(def ignore-files-re #".*\.status|\..*")

(defn- handle-notification
  [dir kind [module-name]]
  (spit (file dir (str module-name ".status")) (name kind)))

(defn- handle-event
  [manager dir kind file-or-path]
  (let [file-name (if (instance? Path file-or-path)
                    (.. ^Path file-or-path getFileName toString)
                    (.getName ^File file-or-path))
        timeout (* 1000 60)]
    (when-not (re-matches ignore-files-re file-name)
      (let [response (case kind
                       :create (deref (deploy! manager file-name (file dir file-name))
                                      timeout ::timeout)
                       :modify (deref (redeploy! manager file-name) timeout ::timeout)
                       :delete (deref (undeploy! manager file-name) timeout ::timeout))]
        (if (= ::timeout response)
          (println "Response for file system deployer action for" file-name "timed out."
                   "\nThe action may have failed or may still complete.")
          (println "File system deployer action for" file-name ":" (:message response)))))))

(defrecord DirectoryDeployer [manager ^File dir watcher]
  Deployer
  (bootstrap-modules [_]
    (doseq [^File file (.listFiles dir)]
      (when-not (or (.isDirectory file) (re-matches ignore-files-re (.getName file)))
        (println "File system deployer now bootstrapping module" file)
        (future (try
                  (handle-event manager dir :create (.getAbsoluteFile file))
                  (catch Exception ex
                    (.printStackTrace ex)))))))

  Stoppable
  (stop [_]
    (println "Stopping filesystem deployment watcher...")
    (close watcher)
    (unregister-notifier! manager "fs-deployer")
    (println "Filesystem deployment watcher stopped.")))

(def directory
  (reify Startable
    (start [_ systems]
      (let [config (get-config (require-system Config systems) :fs)
            manager (require-system Manager systems)]
        (println "Starting filesystem deployment watcher, using config" config "...")
        (assert (:deployments config) "Missing :deployments configuration for FS system.")
        (let [dir (file (:deployments config))]
          (assert (.exists dir) (str "The directory '" dir "' does not exist."))
          (assert (.isDirectory dir) (str "Path '" dir "' is not a directory."))
          (register-notifier! manager "fs-deployer" (partial handle-notification dir))
          (let [watcher (-> (mk-watchservice (partial handle-event manager dir))
                            (watch dir))]
            (println "Filesystem deployment watcher started.")
            (DirectoryDeployer. manager dir watcher)))))))

Fix String getting called as function in assert :)


(ns neuseg.db
  (:use [clj-tuple]
        [clojure.core.matrix :only [set-current-implementation
                                    new-matrix set-row! get-row
                                    dot zero-vector normalise]]))

(set-current-implementation :vectorz)

(def indexes
  { "unigram"   (atom {})
    "bigram"    (atom {})
    "trigram"   (atom {})
    "quadgram"  (atom {}) })

(def dimensions
  { "unigram"   (atom 0)
    "bigram"    (atom 0)
    "trigram"   (atom 0)
    "quadgram"  (atom 0) })

(defn- splited-line [line]
  (let [items (clojure.string/split line #"\s+")
        wd    (first items)
        nvec  (normalise (vec (map #(Double. %1) (rest items))))]
        (tuple wd nvec)))

(defn- process-line [vecmodel name data]
  (let [[[wd nvec] idx] data]
      (do
        (swap! (get indexes name) assoc wd idx)
        (set-row! vecmodel idx nvec))))

(defn load-db [name]
  (println "loading" name "started......")
  (with-open [rdr (clojure.java.io/reader (str "data/models/" name ".vec"))]
    (let [data  (line-seq rdr)
          declr (first data)
          [size dim] (map #(Integer. %) (clojure.string/split declr #"\s+"))
          last (atom -1)
          vecmodel (new-matrix size dim)]
          (reset! (get dimensions name) dim)
          (dorun
            (map (partial process-line vecmodel name)
              (partition-by #(if (number? %1) (reset! last %1) (+ @last 1))
                (interleave (map splited-line (rest data))
                            (iterate inc 0)))))
          vecmodel)))

(def unigram  (load-db "unigram"))
(def bigram   (load-db "bigram"))
(def trigram  (load-db "trigram"))
(def quadgram (load-db "quadgram"))

(def ngrams { "unigram" unigram
              "bigram" bigram
              "trigram" trigram
              "quadgram" quadgram })

(defn- retrieve-vector [name s]
  (let [idx (get @(get indexes name) s)
        dim @(get dimensions name)
        ngram (get ngrams name)]
    (if idx (get-row ngram idx) (zero-vector dim))))

(defn get-vector [s]
  (let [wd (.toString s)]
    (case (.length s)
      1 (retrieve-vector "unigram" wd)
      2 (retrieve-vector "bigram" wd)
      3 (retrieve-vector "trigram" wd)
      4 (retrieve-vector "quadgram" wd)
      (zero-vector 0))))

(def unizero  (get-vector " "))
(def bizero   (get-vector "  "))
(def trizero  (get-vector "   "))
(def quadzero (get-vector "    "))

(defn neighbors [radius elem-fill coll]
  (let [window (+ 1 (* 2 radius))
        head   (repeat radius elem-fill)
        tail   (repeat radius elem-fill)
        merged (concat head coll tail)]
    (partition window 1 merged)))

(defn- mdot [vecs]
  (let [mid 4
        mid-vec (nth vecs mid)]
    (map (partial dot mid-vec) (concat (take mid vecs) (drop (inc mid) vecs)))))

(defn- zip [& colls]
  (map flatten (partition (count colls) (apply interleave colls))))

(defn vectorize [text]
  (zip (map mdot (neighbors 4 unizero  (map get-vector (iterator-seq (NGram/unigram text)))))
                            (map mdot (neighbors 4 bizero   (map get-vector (iterator-seq (NGram/bigram text)))))
                            (map mdot (neighbors 4 trizero  (map get-vector (iterator-seq (NGram/trigram text)))))
                            (map mdot (neighbors 4 quadzero (map get-vector (iterator-seq (NGram/quadgram text)))))))

(ns neuseg.db
  (:use [clj-tuple]
        [clojure.core.matrix :only [set-current-implementation
                                    new-matrix set-row! get-row
                                    dot zero-vector normalise]])
  (:import [com.guokr.neuseg.util NGram]))

(set-current-implementation :vectorz)

(def indexes
  { "unigram"   (atom {})
    "bigram"    (atom {})
    "trigram"   (atom {})
    "quadgram"  (atom {}) })

(def dimensions
  { "unigram"   (atom 0)
    "bigram"    (atom 0)
    "trigram"   (atom 0)
    "quadgram"  (atom 0) })

(defn- splited-line [line]
  (let [items (clojure.string/split line #"\s+")
        wd    (first items)
        nvec  (normalise (vec (map #(Double. %1) (rest items))))]
        (tuple wd nvec)))

(defn- process-line [vecmodel name data]
  (let [[[wd nvec] idx] data]
      (do
        (swap! (get indexes name) assoc wd idx)
        (set-row! vecmodel idx nvec))))

(defn load-db [name]
  (println "loading" name "started......")
  (with-open [rdr (clojure.java.io/reader (str "data/models/" name ".vec"))]
    (let [data  (line-seq rdr)
          declr (first data)
          [size dim] (map #(Integer. %) (clojure.string/split declr #"\s+"))
          last (atom -1)
          vecmodel (new-matrix size dim)]
          (reset! (get dimensions name) dim)
          (dorun
            (map (partial process-line vecmodel name)
              (partition-by #(if (number? %1) (reset! last %1) (+ @last 1))
                (interleave (map splited-line (rest data))
                            (iterate inc 0)))))
          vecmodel)))

(def unigram  (load-db "unigram"))
(def bigram   (load-db "bigram"))
(def trigram  (load-db "trigram"))
(def quadgram (load-db "quadgram"))

(def ngrams { "unigram" unigram
              "bigram" bigram
              "trigram" trigram
              "quadgram" quadgram })

(defn- retrieve-vector [name s]
  (let [idx (get @(get indexes name) s)
        dim @(get dimensions name)
        ngram (get ngrams name)]
    (if idx (get-row ngram idx) (zero-vector dim))))

(defn get-vector [s]
  (let [wd (.toString s)]
    (case (.length s)
      1 (retrieve-vector "unigram" wd)
      2 (retrieve-vector "bigram" wd)
      3 (retrieve-vector "trigram" wd)
      4 (retrieve-vector "quadgram" wd)
      (zero-vector 0))))

(def unizero  (get-vector " "))
(def bizero   (get-vector "  "))
(def trizero  (get-vector "   "))
(def quadzero (get-vector "    "))

(defn neighbors [radius elem-fill coll]
  (let [window (+ 1 (* 2 radius))
        head   (repeat radius elem-fill)
        tail   (repeat radius elem-fill)
        merged (concat head coll tail)]
    (partition window 1 merged)))

(defn- mdot [vecs]
  (let [mid 4
        mid-vec (nth vecs mid)]
    (map (partial dot mid-vec) (concat (take mid vecs) (drop (inc mid) vecs)))))

(defn- zip [& colls]
  (map flatten (partition (count colls) (apply interleave colls))))

(defn vectorize [text]
  (zip (map mdot (neighbors 4 unizero  (map get-vector (iterator-seq (NGram/unigram text)))))
                            (map mdot (neighbors 4 bizero   (map get-vector (iterator-seq (NGram/bigram text)))))
                            (map mdot (neighbors 4 trizero  (map get-vector (iterator-seq (NGram/trigram text)))))
                            (map mdot (neighbors 4 quadzero (map get-vector (iterator-seq (NGram/quadgram text)))))))

fix import

fix import