(ns snippets.image.rendering
  (:require [quil.snippet :refer [defsnippet]]
            [quil.core :refer :all]))

(defsnippet blend-mode-s {:renderer :p2d}
  (background 255)
  (let [modes [:replace :blend :add :subtract :darkest
               :lightest :exclusion :multiply :screen]
        splitted (partition-all 4 modes)]
    (dotimes [row (count splitted)]
      (dotimes [col (count (nth splitted row))]
        (let [mode (nth (nth splitted row) col)
              gr (create-graphics 100 100 :p2d)]
          (with-graphics gr
            (background 127)
            (blend-mode mode)
            (no-stroke)
            (fill 255 0 0)
            (rect 10 20 80 20)
            (fill 50 170 255 127)
            (rect 60 10 20 80)
            (fill 200 130 150 200)
            (rect 10 60 80 20)
            (fill 20 240 50 50)
            (rect 20 10 20 80))
          (image gr (* col 120) (* row 120)))))))

(defsnippet create-graphics-s {}
  (background 255)
  (let [gr (create-graphics 100 100)]
    (with-graphics gr
      (background 127)
      (ellipse 50 50 80 40))
    (image gr 0 0)
    (image gr 120 120)))

(ns snippets.image.rendering
  (:require [quil.snippet :refer [defsnippet]]
            [quil.core :refer :all]))

(defsnippet blend-mode-s {:renderer :p2d}
  (background 255)
  (let [modes [:replace :blend :add :subtract :darkest
               :lightest :exclusion :multiply :screen]
        splitted (partition-all 4 modes)]
    (dotimes [row (count splitted)]
      (dotimes [col (count (nth splitted row))]
        (let [mode (nth (nth splitted row) col)
              gr (create-graphics 100 100 :p2d)]
          (with-graphics gr
            (background 127)
            (blend-mode mode)
            (no-stroke)
            (fill 255 0 0)
            (rect 10 20 80 20)
            (fill 50 170 255 127)
            (rect 60 10 20 80)
            (fill 200 130 150 200)
            (rect 10 60 80 20)
            (fill 20 240 50 50)
            (rect 20 10 20 80))
          (image gr (* col 120) (* row 120)))))))

(defsnippet create-graphics-s {}
  (background 255)
  (let [gr (create-graphics 100 100)]
    (with-graphics gr
      (background 127)
      (ellipse 50 50 80 40))
    (image gr 0 0))
  (let [gr (create-graphics 100 100 :java2d)]
    (with-graphics gr
      (background 127)
      (ellipse 50 50 40 80))
    (image gr 100 100)))

Test version of create-graphics. Issue #87.


(ns tensorflow-clj.core-test
  (:require [clojure.test :refer :all]
            [tensorflow-clj.core :refer :all]))

(deftest scalar-tensor
  (testing "Scalar tensor"
    (let [t (org.tensorflow.Tensor/create 123.0)]
      (is (= org.tensorflow.DataType/DOUBLE (.dataType t)))
      (is (= 0 (.numDimensions t)))
      (is (= [] (vec (.shape t)))))))

(deftest vector-tensor
  (testing "Vector tensor"
    (let [t (org.tensorflow.Tensor/create (into-array [1.0 2.0 3.0]))]
      (is (= org.tensorflow.DataType/DOUBLE (.dataType t)))
      (is (= 1 (.numDimensions t)))
      (is (= [3] (vec (.shape t)))))))

(deftest graph-variable
  (testing "Graph variable"
    (let [g (org.tensorflow.Graph.)]
      (let [x (-> (.opBuilder g "Variable" "x")
                (.setAttr "dtype" org.tensorflow.DataType/DOUBLE)
                (.setAttr "shape" (org.tensorflow.Shape/scalar))
                (.build))]
        x))))

(deftest graph-constant
  (testing "Graph constant"
    (let [g (org.tensorflow.Graph.)
          t (org.tensorflow.Tensor/create 123.0)]
      (-> (.opBuilder g "Const" "k")
        (.setAttr "dtype" (.dataType t))
        (.setAttr "value" t)
        (.build)))))

Create graph constant

Create graph constant


(ns warehouse.subs
  (:require
   [warehouse.util :as util]
   [warehouse.infinite-scroll.db :as scroll]
   [warehouse.search.db :as search]
   [re-frame.core :refer [reg-sub subscribe]]
   [warehouse.search.db :as search]))

(reg-sub
 :visible-components
 (fn
   [db _]
   (if (search/filter-active?)
     (select-keys (:components db) (map #(get % "ref") (search/filter-search)))
     (:components db))))

(reg-sub
 :infinite-scroll-state
 (fn
   [db _]
   (:infinite-scroll db)))

(reg-sub
 :scroll-data-visible-components
 (fn [_ _]
   [(subscribe [:visible-components])
    (subscribe [:infinite-scroll-state])])
 (fn [[vc s] _]
   {:page (:page s)
    :pages-count (:pages-count s)
    :records-per-page 100}))

(reg-sub
 :scroll-visible-components
 (fn [_ _]
   [(subscribe [:scroll-data-visible-components])
    (subscribe [:visible-components])])
 (fn [[sd vc] _]
   (scroll/filter-by-data vc sd)))

(reg-sub
 :active-tab
 (fn
   [db _]
   (:page db)))

(reg-sub
 :state
 (fn
   [db _]
   db))

(reg-sub
 :state-data-uri
 (fn
   [db _]
   (->> db
        (util/state->document)
        (clj->js)
        (.stringify js/JSON)
        (.encodeURIComponent js/window)
        (str "data:text/json;charset=utf-8,"))))

(reg-sub
 :change-sets
 (fn
   [db _]
   (:change-sets db)))

(ns warehouse.subs
  (:require
   [warehouse.util :as util]
   [warehouse.infinite-scroll.db :as scroll]
   [warehouse.search.db :as search]
   [re-frame.core :refer [reg-sub subscribe]]
   [warehouse.search.db :as search]))

(reg-sub
 :visible-components
 (fn
   [db _]
   (if (search/filter-active? db)
     (select-keys (:components db) (map #(get % "ref") (search/filter-search db)))
     (:components db))))

(reg-sub
 :infinite-scroll-state
 (fn
   [db _]
   (:infinite-scroll db)))

(reg-sub
 :scroll-data-visible-components
 (fn [_ _]
   [(subscribe [:visible-components])
    (subscribe [:infinite-scroll-state])])
 (fn [[vc s] _]
   {:page (:page s)
    :pages-count (:pages-count s)
    :records-per-page 100}))

(reg-sub
 :scroll-visible-components
 (fn [_ _]
   [(subscribe [:scroll-data-visible-components])
    (subscribe [:visible-components])])
 (fn [[sd vc] _]
   (scroll/filter-by-data vc sd)))

(reg-sub
 :active-tab
 (fn
   [db _]
   (:page db)))

(reg-sub
 :state
 (fn
   [db _]
   db))

(reg-sub
 :state-data-uri
 (fn
   [db _]
   (->> db
        (util/state->document)
        (clj->js)
        (.stringify js/JSON)
        (.encodeURIComponent js/window)
        (str "data:text/json;charset=utf-8,"))))

(reg-sub
 :change-sets
 (fn
   [db _]
   (:change-sets db)))

Fix visible components sub

[frontend]: Fix visible components sub


(ns cruncher.views
  (:require [om.next :as om :refer-macros [defui]]
            [om.dom :as dom :include-macros true]
            [goog.dom :as gdom]
            [cruncher.communication.auth :as auth]
            [cruncher.communication.favorites :as favorites]
            [cruncher.communication.main :as com]
            [cruncher.communication.progress :as progress]
            [cruncher.communication.evolutions :as evolutions]
            [cruncher.moves.main :as moves]
            [cruncher.selections :as selections]
            [cruncher.shredder.main :as shredder]
            [cruncher.utils.extensions]
            [cruncher.utils.lib :as lib]
            [cruncher.utils.views :as vlib]))

;;;; Auxiliary
(defn favorite-td [id favorite]
  (dom/span #js {:className "pointer"
                 :onClick   #(favorites/toggle-favorite id favorite)}
            (if favorite (vlib/fa-icon "fa-star") (vlib/fa-icon "fa-star-o"))))

;;;; Controls
(defui Controls
  Object
  (render [this]
    (dom/div nil
             (dom/div #js {:className "row"}
                      (dom/div #js {:className "col-md-6"}
                               (dom/p #js {:className "lead"} "Controls")
                               (vlib/button-primary #(com/route :get-all-pokemon) "Get all Pokemon")
                               (vlib/button-primary #(shredder/power-on this) (dom/span nil (vlib/fa-icon "fa-eraser") " Crunch selected Pokemon")))
                      (dom/div #js {:className "col-md-6"}
                               (dom/p #js {:className "lead"} "Information")
                               (dom/div nil (:evolution-number (om/props this)) " Evolutions available")))
             (dom/br nil) (dom/br nil)
             (selections/controls (om/props this))
             (dom/br nil) (dom/br nil)
             (dom/div nil (progress/progress-bar (om/props this))))))
(def controls (om/factory Controls))

;;;; Messages
(defui ErrorMessage
  Object
  (render [this]
    (when (lib/error?)
      (dom/div #js {:className "alert alert-warning"}
               (dom/a #js {:href         "#"
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (dom/strong nil "Error: ")
               (lib/get-error)))))
(def error-message (om/factory ErrorMessage))

(defui InfoMessage
  Object
  (render [this]
    (when (lib/info?)
      (dom/div #js {:className "alert alert-success"}
               (dom/a #js {:href         "#"
                           :onClick      #(lib/info! nil)
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (lib/get-info)))))
(def info-message (om/factory InfoMessage))

;;;; Poketable
(defui PokeTableEntryDetails
  Object
  (render [this]
    (let [pokemon (om/props this)]
      (dom/tr #js {:id        (str "poketable-row-details-" (:id pokemon))
                   :className "collapse"}
              (dom/td #js {:className "well"})
              (dom/td #js {:className "well" :colSpan 12}
                      (dom/div #js {:className "row"}
                               (dom/div #js {:className "col-md-4"} "Evolves to:")
                               (dom/div #js {:className "col-md-8"} (if (lib/pokemon-evolution pokemon)
                                                                      (lib/pokemon-evolution pokemon)
                                                                      "None")))
                      (dom/div #js {:className "row"}
                               (dom/div #js {:className "col-md-4"} "Available Candy:")
                               (dom/div #js {:className "col-md-8"} (:candy pokemon)))
                      (dom/div #js {:className "row"}
                               (dom/div #js {:className "col-md-4"} "Available Evolutions:")
                               (dom/div #js {:className "col-md-2"} (lib/calc-evolutions pokemon))
                               (if (not= (lib/calc-evolutions pokemon) 0)
                                 (dom/div #js {:className "col-md-6"} (dom/button #js {:className "btn btn-sm btn-info"
                                                                                :type      "button"
                                                                                :onClick   #(evolutions/evolve (:id pokemon))}
                                                                                "Evolve!")))))))))
(def poketable-entry-details (om/factory PokeTableEntryDetails {}))

(defui PokeTableEntry
  Object
  (render [this]
    (let [pokemon (om/props this)]
      (dom/tr #js {:id              (str "poketable-row-" (:id pokemon))
                   :className       "poketable-row"
                   :data-favorite   (:favorite pokemon)
                   :data-id         (:id pokemon)
                   :data-iv-perfect (:individual_percentage pokemon)
                   :data-cp         (:cp pokemon)}
              (dom/td nil
                      (dom/div #js {:className "checkbox"})
                      (dom/label nil
                                 (dom/input #js {:id        (str "poketable-checkbox-" (:id pokemon))
                                                 :className "poketable-checkbox"
                                                 :type      "checkbox"
                                                 :value     (:id pokemon)})))
              (dom/td nil (favorite-td (:id pokemon) (:favorite pokemon)))
              (dom/td nil (:pokemon_id pokemon))
              (dom/td nil (dom/img #js {:src (str "img/pokemon/models/" (:pokemon_id pokemon) ".png") :className "pokemon-image-thumb"}))
              (dom/td nil (:name pokemon))
              (dom/td nil (:nickname pokemon))
              (dom/td nil (:cp pokemon))
              (dom/td nil (:health pokemon))
              (dom/td nil (:individual_percentage pokemon))
              (dom/td nil (:individual_attack pokemon))
              (dom/td nil (:individual_defense pokemon))
              (dom/td nil (:individual_stamina pokemon))
              (dom/td nil (dom/button #js {:className     "btn btn-sm btn-info"
                                           :type          "button"
                                           :data-toggle   "collapse"
                                           :data-target   (str "#poketable-row-details-" (:id pokemon))
                                           :aria-expanded "false"
                                           :aria-controls (str "poketable-row-details-" (:id pokemon))}
                                      "Details"))))))
(def poketable-entry (om/factory PokeTableEntry {}))

(defui PokeTable
  Object
  (render [this]
    (dom/div #js {:id "poketable"}
             (dom/div nil (controls (om/props this)))
             (dom/br nil)
             (dom/table #js {:className "table table-hover"}
                        (dom/thead nil
                                   (dom/tr nil
                                           (dom/th nil "")
                                           (vlib/sortable-table-header :favorite "Fav.")
                                           (vlib/sortable-table-header :pokemon_id "#")
                                           (dom/th nil "")
                                           (vlib/sortable-table-header :name "Name")
                                           (vlib/sortable-table-header :nickname "Nickname")
                                           (vlib/sortable-table-header :cp "CP")
                                           (vlib/sortable-table-header :health "Health")
                                           (vlib/sortable-table-header :individual_percentage "IV % Perfect")
                                           (vlib/sortable-table-header :individual_attack "IV Attack")
                                           (vlib/sortable-table-header :individual_defense "IV Defense")
                                           (vlib/sortable-table-header :individual_stamina "IV Stamina")
                                           (dom/th nil "")))
                        (dom/tbody nil
                                   (interleave
                                     (map #(poketable-entry (lib/merge-react-key %)) (lib/inventory-pokemon))
                                     (map #(poketable-entry-details (lib/merge-react-key %)) (lib/inventory-pokemon)))))
             #_(let [jquery (js* "$")]
                 (.stickyTableHeaders (jquery "#poketable"))))))
(def poketable (om/factory PokeTable {}))

;;;; Other
(defui Header
  Object
  (render [this]
    (dom/div nil
             (dom/div #js {:className "page-header"}
                      (dom/div #js {:className "pull-right"}
                               (vlib/login-indicator (om/props this)))
                      (dom/h1 nil "Poké-Cruncher"))
             (dom/span #js {:className "pull-right"} (vlib/loader (om/props this)))
             (dom/ul nil
                     (dom/li nil
                             "If you have 2-factor Auth enabled in your Google Account, please add an "
                             (dom/a #js {:href   "https://security.google.com/settings/security/apppasswords?pli=1"
                                         :target "_blank"}
                                    "app-password")
                             " to your account")
                     (dom/li nil "Click on the table headers to sort the data")
                     (dom/li nil "Crunching Pokemon really means you're sending them away -- "
                             (dom/strong nil "there is no possibility to get them back!!!"))
                     (dom/li nil "Enter a location near you to prevent a softban.")
                     (dom/li nil "Automated Pokemon crunching takes between 2 and 3 seconds per pokemon to prevent robotic behaviour."))
             (dom/hr nil))))
(def header (om/factory Header))

(defn google-ptc-switch [this]
  (dom/form #js {:id   "google-ptc-switch"
                 :role "form"}
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(vlib/commit-component-state this :service "google")
                                       :name    "google-ptc-switch"})
                       "Google")
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(vlib/commit-component-state this :service "ptc")
                                       :name    "google-ptc-switch"})
                       "Pokemon Trainer Club")))

(defn validate-login-button
  "Show Login button and disable it when one of these fields is empty."
  [email password location service]
  (let [not-empty? (and
                     (pos? (count email))
                     (pos? (count password))
                     (pos? (count location))
                     (pos? (count service)))]
    (vlib/button-primary #(auth/ajax-login email password location service) not-empty? "Login")))

(defui Login
  Object
  (render [this]
    ;; TODO return empty string if om/get-state is empty
    (let [email (om/get-state this :email)
          password (om/get-state this :password)
          location (om/get-state this :location)
          service (om/get-state this :service)]
      (dom/div #js {:className "row"}
               (dom/div #js {:className "col-md-6 col-md-offset-3"}
                        (vlib/panel-wrapper
                          (dom/div nil
                                   (dom/h5 #js {:className "text-center"} "Login")
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-user fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(vlib/commit-component-state this :email %)
                                                            :value       email
                                                            :placeholder "email / PTC Username"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-key fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(vlib/commit-component-state this :password %)
                                                            :value       password
                                                            :type        "password"
                                                            :placeholder "password"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-map-marker fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(vlib/commit-component-state this :location %)
                                                            :value       location
                                                            :placeholder "Düsseldorf, Germany"}))
                                   (google-ptc-switch this)
                                   (validate-login-button email password location service))))))))
(def login (om/factory Login))

(defn view-dispatcher
  "Dispatch current template in main view by the app state."
  [this]
  (let [view (lib/current-view)]
    (cond
      (= view :login) (login (om/props this))
      (not (lib/logged-in?)) (login (om/props this))
      :else (poketable (om/props this)))))

(defui Main
  Object
  (render [this]
    (dom/div nil
             (dom/div nil (header (om/props this)))
             (dom/div nil (error-message (om/props this)))
             (dom/div nil (info-message (om/props this)))
             (view-dispatcher this)
             (dom/div nil (vlib/back-to-top))
             #_(dom/div nil (poketable (om/props this)))
             #_(dom/div nil (login)))))

(ns cruncher.views
  (:require [om.next :as om :refer-macros [defui]]
            [om.dom :as dom :include-macros true]
            [goog.dom :as gdom]
            [cruncher.communication.auth :as auth]
            [cruncher.communication.favorites :as favorites]
            [cruncher.communication.main :as com]
            [cruncher.communication.progress :as progress]
            [cruncher.communication.evolutions :as evolutions]
            [cruncher.moves.main :as moves]
            [cruncher.selections :as selections]
            [cruncher.shredder.main :as shredder]
            [cruncher.utils.extensions]
            [cruncher.utils.lib :as lib]
            [cruncher.utils.views :as vlib]))

;;;; Auxiliary
(defn favorite-td [id favorite]
  (dom/span #js {:className "pointer"
                 :onClick   #(favorites/toggle-favorite id favorite)}
            (if favorite (vlib/fa-icon "fa-star") (vlib/fa-icon "fa-star-o"))))

;;;; Controls
(defui Controls
  Object
  (render [this]
    (dom/div nil
             (dom/div #js {:className "row"}
                      (dom/div #js {:className "col-md-6"}
                               (dom/p #js {:className "lead"} "Controls")
                               (vlib/button-primary #(com/route :get-all-pokemon) "Get all Pokemon")
                               (vlib/button-primary #(shredder/power-on this) (dom/span nil (vlib/fa-icon "fa-eraser") " Crunch selected Pokemon")))
                      (dom/div #js {:className "col-md-6"}
                               (dom/p #js {:className "lead"} "Information")
                               (dom/div nil (:evolution-number (om/props this)) " Evolutions available")))
             (dom/br nil) (dom/br nil)
             (selections/controls (om/props this))
             (dom/br nil) (dom/br nil)
             (dom/div nil (progress/progress-bar (om/props this))))))
(def controls (om/factory Controls))

;;;; Messages
(defui ErrorMessage
  Object
  (render [this]
    (when (lib/error?)
      (dom/div #js {:className "alert alert-warning"}
               (dom/a #js {:href         "#"
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (dom/strong nil "Error: ")
               (lib/get-error)))))
(def error-message (om/factory ErrorMessage))

(defui InfoMessage
  Object
  (render [this]
    (when (lib/info?)
      (dom/div #js {:className "alert alert-success"}
               (dom/a #js {:href         "#"
                           :onClick      #(lib/info! nil)
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (lib/get-info)))))
(def info-message (om/factory InfoMessage))

;;;; Poketable
(defui PokeTableEntryDetails
  Object
  (render [this]
    (let [pokemon (om/props this)]
      (dom/tr #js {:id        (str "poketable-row-details-" (:id pokemon))
                   :className "collapse"}
              (dom/td #js {:className "well"})
              (dom/td #js {:className "well" :colSpan 12}
                      (dom/div #js {:className "row"}
                               (dom/div #js {:className "col-md-6"}
                                        (dom/div #js {:className "row"}
                                                 (dom/div #js {:className "col-md-4"} "Health:")
                                                 (dom/div #js {:className "col-md-8"} (:health pokemon)))
                                        (dom/div #js {:className "row"}
                                                 (dom/div #js {:className "col-md-4"} "Evolves to:")
                                                 (dom/div #js {:className "col-md-8"} (if (lib/pokemon-evolution pokemon)
                                                                                (lib/pokemon-evolution pokemon)
                                                                                "None")))
                                        (dom/div #js {:className "row"}
                                                 (dom/div #js {:className "col-md-4"} "Available Candy:")
                                                 (dom/div #js {:className "col-md-8"} (:candy pokemon)))
                                        (dom/div #js {:className "row"}
                                                 (dom/div #js {:className "col-md-4"} "Available Evolutions:")
                                                 (dom/div #js {:className "col-md-2"} (lib/calc-evolutions pokemon))))
                               (dom/div #js {:className "col-md-6"}
                                        (dom/div #js {:className "row"}
                                                 (dom/div #js {:className "col-md-12"}
                                                          (if (not= (lib/calc-evolutions pokemon) 0)
                                                            (dom/button #js {:className "btn btn-sm btn-info"
                                                                             :type      "button"
                                                                             :onClick   #(evolutions/evolve (:id pokemon))}
                                                                        "Evolve!")))))))))))
(def poketable-entry-details (om/factory PokeTableEntryDetails {}))

(defui PokeTableEntry
  Object
  (render [this]
    (let [pokemon (om/props this)]
      (dom/tr #js {:id              (str "poketable-row-" (:id pokemon))
                   :className       "poketable-row"
                   :data-favorite   (:favorite pokemon)
                   :data-id         (:id pokemon)
                   :data-iv-perfect (:individual_percentage pokemon)
                   :data-cp         (:cp pokemon)}
              (dom/td nil
                      (dom/div #js {:className "checkbox"})
                      (dom/label nil
                                 (dom/input #js {:id        (str "poketable-checkbox-" (:id pokemon))
                                                 :className "poketable-checkbox"
                                                 :type      "checkbox"
                                                 :value     (:id pokemon)})))
              (dom/td nil (favorite-td (:id pokemon) (:favorite pokemon)))
              (dom/td nil (:pokemon_id pokemon))
              (dom/td nil (dom/img #js {:src (str "img/pokemon/models/" (:pokemon_id pokemon) ".png") :className "pokemon-image-thumb"}))
              (dom/td nil (:name pokemon))
              (dom/td nil (:nickname pokemon))
              (dom/td nil (:cp pokemon))
              (dom/td nil (:health pokemon))
              (dom/td nil (:individual_percentage pokemon))
              (dom/td nil (:individual_attack pokemon))
              (dom/td nil (:individual_defense pokemon))
              (dom/td nil (:individual_stamina pokemon))
              (dom/td nil (dom/button #js {:className     "btn btn-sm btn-info"
                                           :type          "button"
                                           :data-toggle   "collapse"
                                           :data-target   (str "#poketable-row-details-" (:id pokemon))
                                           :aria-expanded "false"
                                           :aria-controls (str "poketable-row-details-" (:id pokemon))}
                                      "Details"))))))
(def poketable-entry (om/factory PokeTableEntry {}))

(defui PokeTable
  Object
  (render [this]
    (dom/div #js {:id "poketable"}
             (dom/div nil (controls (om/props this)))
             (dom/br nil)
             (dom/table #js {:className "table table-hover"}
                        (dom/thead nil
                                   (dom/tr nil
                                           (dom/th nil "")
                                           (vlib/sortable-table-header :favorite "Fav.")
                                           (vlib/sortable-table-header :pokemon_id "#")
                                           (dom/th nil "")
                                           (vlib/sortable-table-header :name "Name")
                                           (vlib/sortable-table-header :nickname "Nickname")
                                           (vlib/sortable-table-header :cp "CP")
                                           (vlib/sortable-table-header :health "Health")
                                           (vlib/sortable-table-header :individual_percentage "IV % Perfect")
                                           (vlib/sortable-table-header :individual_attack "IV Attack")
                                           (vlib/sortable-table-header :individual_defense "IV Defense")
                                           (vlib/sortable-table-header :individual_stamina "IV Stamina")
                                           (dom/th nil "")))
                        (dom/tbody nil
                                   (interleave
                                     (map #(poketable-entry (lib/merge-react-key %)) (lib/inventory-pokemon))
                                     (map #(poketable-entry-details (lib/merge-react-key %)) (lib/inventory-pokemon)))))
             #_(let [jquery (js* "$")]
                 (.stickyTableHeaders (jquery "#poketable"))))))
(def poketable (om/factory PokeTable {}))

;;;; Other
(defui Header
  Object
  (render [this]
    (dom/div nil
             (dom/div #js {:className "page-header"}
                      (dom/div #js {:className "pull-right"}
                               (vlib/login-indicator (om/props this)))
                      (dom/h1 nil "Poké-Cruncher"))
             (dom/span #js {:className "pull-right"} (vlib/loader (om/props this)))
             (dom/ul nil
                     (dom/li nil
                             "If you have 2-factor Auth enabled in your Google Account, please add an "
                             (dom/a #js {:href   "https://security.google.com/settings/security/apppasswords?pli=1"
                                         :target "_blank"}
                                    "app-password")
                             " to your account")
                     (dom/li nil "Click on the table headers to sort the data")
                     (dom/li nil "Crunching Pokemon really means you're sending them away -- "
                             (dom/strong nil "there is no possibility to get them back!!!"))
                     (dom/li nil "Enter a location near you to prevent a softban.")
                     (dom/li nil "Automated Pokemon crunching takes between 2 and 3 seconds per pokemon to prevent robotic behaviour."))
             (dom/hr nil))))
(def header (om/factory Header))

(defn google-ptc-switch [this]
  (dom/form #js {:id   "google-ptc-switch"
                 :role "form"}
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(vlib/commit-component-state this :service "google")
                                       :name    "google-ptc-switch"})
                       "Google")
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(vlib/commit-component-state this :service "ptc")
                                       :name    "google-ptc-switch"})
                       "Pokemon Trainer Club")))

(defn validate-login-button
  "Show Login button and disable it when one of these fields is empty."
  [email password location service]
  (let [not-empty? (and
                     (pos? (count email))
                     (pos? (count password))
                     (pos? (count location))
                     (pos? (count service)))]
    (vlib/button-primary #(auth/ajax-login email password location service) not-empty? "Login")))

(defui Login
  Object
  (render [this]
    ;; TODO return empty string if om/get-state is empty
    (let [email (om/get-state this :email)
          password (om/get-state this :password)
          location (om/get-state this :location)
          service (om/get-state this :service)]
      (dom/div #js {:className "row"}
               (dom/div #js {:className "col-md-6 col-md-offset-3"}
                        (vlib/panel-wrapper
                          (dom/div nil
                                   (dom/h5 #js {:className "text-center"} "Login")
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-user fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(vlib/commit-component-state this :email %)
                                                            :value       email
                                                            :placeholder "email / PTC Username"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-key fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(vlib/commit-component-state this :password %)
                                                            :value       password
                                                            :type        "password"
                                                            :placeholder "password"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-map-marker fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(vlib/commit-component-state this :location %)
                                                            :value       location
                                                            :placeholder "Düsseldorf, Germany"}))
                                   (google-ptc-switch this)
                                   (validate-login-button email password location service))))))))
(def login (om/factory Login))

(defn view-dispatcher
  "Dispatch current template in main view by the app state."
  [this]
  (let [view (lib/current-view)]
    (cond
      (= view :login) (login (om/props this))
      (not (lib/logged-in?)) (login (om/props this))
      :else (poketable (om/props this)))))

(defui Main
  Object
  (render [this]
    (dom/div nil
             (dom/div nil (header (om/props this)))
             (dom/div nil (error-message (om/props this)))
             (dom/div nil (info-message (om/props this)))
             (view-dispatcher this)
             (dom/div nil (vlib/back-to-top))
             #_(dom/div nil (poketable (om/props this)))
             #_(dom/div nil (login)))))

Tidy up

Tidy up


(ns vault.tool.main
  (:require
    [mvxcvi.directive :refer [command execute]]
    [puget.printer :refer [pprint cprint]]
    [vault.system :as sys]
    (vault.tool
      [blob :as blob-tool]
      [data :as data-tool]))
  #_ (:gen-class :main true))

;; UTILITY ACTIONS

(defn- debug-command
  [opts args]
  (cprint opts)
  (cprint args))

(defn- not-yet-implemented
  [opts args]
  (binding [*out* *err*]
    (println "This command is not yet implemented")))

;; COMMAND STRUCTURE

(def commands
  (command "vault [global opts] <command> [command args]"
    "Command-line tool for the vault data store."

    ["-v" "--verbose" "Show extra debugging messages."]
    ["-h" "--help"    "Show usage information."]

    (init [opts]
      (assoc opts :blob-store sys/blobs))

    (command "blob <action> [args]"
      "Low-level commands dealing with data blobs."

      (command "list [opts]"
        "Enumerate the stored blobs."

        ["-a" "--after" "Start enumerating blobs lexically following the given string."]
        ["-n" "--limit" "Limit the number of results returned." :parse-fn #(Integer/parseInt %)]

        (action blob-tool/list-blobs))

      (command "stat <hash-id> [hash-id ...]"
        "Show information about a stored blob."

        [nil "--pretty" "Format the info over multiple lines for easier viewing."
         :default true]

        (action blob-tool/stat-blob))

      (command "get <hash-id>"
        "Print the contents of a blob to stdout."
        (action blob-tool/get-blob))

      (command "put <source>"
        "Store a blob of data and print the resulting hash-id. If source is '-',
              data will be read from stdin. Otherwise, it should be a file to read
              content from."
        (action blob-tool/put-blob)))

    (command "data <action> [args]"
      "Interact with object entities and data."

      (command "show <hash-id> [hash-id ...]"
        "Inspect the contents of the given blobs, pretty-printing EDN values and
              showing hex for binary blobs."

        ["-b" "--binary" "Print blobs as binary even if they appear to be textual."]

        (action data-tool/show-blob))

      (command "create [args]"
        "Create a new object."

        ["-t" "--time" "Set the time to create the object root with. Defaults to the current time."]
        ["-i" "--id" "Set an identity for the object root. Defaults to a random string."]
        ["-a" "--attribute" "Provide an initial set of attributes for the object."]

        (action not-yet-implemented))

      (command "update <entity> <type> [args]"
        "Apply an update to an existing object."

        (action not-yet-implemented)))))

(defn -main [& args]
  (execute commands args))

(ns vault.tool.main
  (:require
    [mvxcvi.directive :refer [command execute]]
    [puget.printer :refer [pprint cprint]]
    [vault.system :as sys]
    (vault.tool
      [blob :as blob-tool]
      [data :as data-tool]))
  #_ (:gen-class :main true))

;; UTILITY ACTIONS

(defn- debug-command
  [opts args]
  (cprint opts)
  (cprint args))

(defn- not-yet-implemented
  [opts args]
  (binding [*out* *err*]
    (println "This command is not yet implemented")))

;; COMMAND STRUCTURE

(def commands
  (command "vault [global opts] <command> [command args]"
    "Command-line tool for the vault data store."

    ["-v" "--verbose" "Show extra debugging messages."]
    ["-h" "--help"    "Show usage information."]

    (init [opts]
      (assoc opts :blob-store sys/blobs))

    (command "blob <action> [args]"
      "Low-level commands dealing with data blobs."

      (command "list [opts]"
        "Enumerate the stored blobs."

        ["-a" "--after" "Start enumerating blobs lexically following the given string."]
        ["-n" "--limit" "Limit the number of results returned." :parse-fn #(Integer/parseInt %)]

        (action blob-tool/list-blobs))

      (command "stat <hash-id> [hash-id ...]"
        "Show information about a stored blob."

        [nil "--pretty" "Format the info over multiple lines for easier viewing."
         :default true]

        (action blob-tool/stat-blob))

      (command "get <hash-id>"
        "Print the contents of a blob to stdout."
        (action blob-tool/get-blob))

      (command "put <source>"
        "Store a blob of data and print the resulting hash-id. If source is '-',
              data will be read from stdin. Otherwise, it should be a file to read
              content from."
        (action blob-tool/put-blob)))

    (command "data <action> [args]"
      "Interact with object entities and data."

      (command "show <hash-id> [hash-id ...]"
        "Inspect the contents of the given blobs, pretty-printing EDN values and
              showing hex for binary blobs."

        ["-b" "--binary" "Print blobs as binary even if they appear to be textual."]

        (action data-tool/show-blob))

      (command "create [args]"
        "Create a new object."

        ["-t" "--time" "Set the time to create the object root with. Defaults to the current time."]
        ["-i" "--id" "Set an identity for the object root. Defaults to a random string."]
        ["-a" "--attribute" "Provide an initial set of attributes for the object."]

        (action not-yet-implemented))

      (command "update <entity> <type> [args]"
        "Apply an update to an existing object."

        (action not-yet-implemented)))

    (command "search <query>"
      "Search entity attributes for properties."

      (action not-yet-implemented))))

(defn -main [& args]
  (execute commands args))

Add search command placeholder to tool.

Add search command placeholder to tool.


(ns zookeeper-exp1.test-util
  (:require [zookeeper-exp1.util :refer :all]
            [clojure.test :refer :all]
            [zookeeper-exp1.buddy-circle :refer :all]
            [zookeeper :as zk])
  (:import [org.apache.curator.test TestingServer]))

(def client (atom nil))

(defn create-root-znode
  [client]
  (zk/create client root-znode-path :persistent? true))

(defn setup-embedded-zk [f]
  (let [server (TestingServer. port)]
    (reset! client (connect))
    (create-root-znode @client)
    (f)
    (.close server)))

(deftest lazy-contains?-test
  (testing "contains the element"
    (is (true? (lazy-contains? [1 2 3] 1)))
    (is (false? (lazy-contains? [2 3] 1)))
    (is (true? (lazy-contains? [nil 2 3] nil)))
    (is (false? (lazy-contains? nil nil)))))

(ns zookeeper-exp1.test-util
  (:require [zookeeper-exp1.util :refer :all]
            [zookeeper-exp1.run-state-machine :as rsm]
            [clojure.test :refer :all]
            [zookeeper :as zk])
  (:import [org.apache.curator.test TestingServer]))

(def client (atom nil))

(defn create-root-znode
  [client]
  (zk/create client rsm/root-znode-path :persistent? true))

(defn setup-embedded-zk [f]
  (let [server (TestingServer. port)]
    (reset! client (zk/connect (str "127.0.0.1:" 2181)))
    (create-root-znode @client)
    (f)
    (.close server)))

(deftest lazy-contains?-test
  (testing "contains the element"
    (is (true? (lazy-contains? [1 2 3] 1)))
    (is (false? (lazy-contains? [2 3] 1)))
    (is (true? (lazy-contains? [nil 2 3] nil)))
    (is (false? (lazy-contains? nil nil)))))

fix test

fix test


;; Copyright 2008-2014 Red Hat, Inc, and individual contributors.
;;
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 2.1 of
;; the License, or (at your option) any later version.
;;
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

(ns immutant.repl
  "Provides tools for starting nrepl servers."
  (:require [immutant.util         :as util]
            [immutant.registry     :as registry]
            [immutant.logging      :as log]))

(defn ^:private fix-port [port]
  (if (string? port)
    (Integer. port)
    port))

(defn stop-nrepl
  "Stops the given nrepl server."
  [server]
  (log/info "Stopping nrepl for" (util/app-name))
  (.close server))

(defn start-nrepl
  "Starts an nrepl server on the given port and interface.
   The interface can be an ip address string, or an alias to one of
   the interfaces defined by the AS: :public, :management,
   or :unsecure. If no interface is provided, it binds to
   the :management interface (which is 127.0.0.1 by
   default). Registers an at-exit handler to shutdown nrepl on
   undeploy, and returns a server that can be passed to stop-nrepl to
   shut it down manually."
  ([interface port]
     (let [{{:keys [nrepl-middleware nrepl-handler]} :repl-options}
         (registry/get :project)
         require-resolve #(do (-> % namespace symbol require)
                              (resolve %))
         interface-address (or (util/lookup-interface-address interface)
                               interface
                               (util/management-interface-address))]
       (if (nil? interface-address)
         (log/warn "Invalid interface address for nREPL; use :nrepl-interface")
         (do
           (log/info "Starting nREPL for" (util/app-name)
                     "at" (str interface-address ":" port))
           (future (require 'clj-stacktrace.repl 'complete.core))
           (when (and nrepl-middleware nrepl-handler)
             (throw (IllegalArgumentException.
                     "Can only use one of :nrepl-handler or :nrepl-middleware")))
           (let [handler (or (and nrepl-handler (require-resolve nrepl-handler))
                             (->> nrepl-middleware
                                  (map #(cond
                                         (var? %) %
                                         (symbol? %) (require-resolve %)
                                         (list? %) (eval %)))
                                  (apply (util/try-resolve
                                          'clojure.tools.nrepl.server/default-handler))))]
             (when-let [server ((util/try-resolve 'clojure.tools.nrepl.server/start-server)
                                :handler handler
                                :port (fix-port port)
                                :bind interface-address)]
               (util/at-exit (partial stop-nrepl server))
               server))))))
  ([port]
   (start-nrepl nil port)))

(defn ^:private spit-nrepl-files
  [port file]
  (doseq [f (map util/app-relative
                 (if file
                   [file]
                   [".nrepl-port" "target/repl-port"]))]
    (.mkdirs (.getParentFile f))
    (spit f port)
    (.deleteOnExit f)))

(defn ^{:internal true :no-doc true} init-repl
  "Looks for nrepl-port value in the given config, and starts
the appropriate servers."
  [config]
  (let [port (:nrepl-port config (if (util/dev-mode?) 0 nil))
        interface (:nrepl-interface config)]
    (if (or port interface)
      (if-let [nrepl (start-nrepl interface (or port 0))]
        (let [ss (-> nrepl deref :ss)
              host (-> ss .getInetAddress .getHostAddress)
              bound-port (.getLocalPort ss)]
          (log/info "nREPL bound to" (str host ":" bound-port))
          (spit-nrepl-files bound-port (:nrepl-port-file config)))))))

;; Copyright 2008-2014 Red Hat, Inc, and individual contributors.
;;
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation; either version 2.1 of
;; the License, or (at your option) any later version.
;;
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; if not, write to the Free
;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA, or see the FSF site: http://www.fsf.org.

(ns immutant.repl
  "Provides tools for starting nrepl servers."
  (:require [immutant.util         :as util]
            [immutant.registry     :as registry]
            [immutant.logging      :as log]))

(defn ^:private fix-port [port]
  (if (string? port)
    (Integer. port)
    port))

(defn stop-nrepl
  "Stops the given nrepl server."
  [server]
  (log/info "Stopping nrepl for" (util/app-name))
  (.close server))

(defn start-nrepl
  "Starts an nrepl server on the given port and interface.
   The interface can be an ip address string, or an alias to one of
   the interfaces defined by the AS: :public, :management,
   or :unsecure. If no interface is provided, it binds to
   the :management interface (which is 127.0.0.1 by
   default). Registers an at-exit handler to shutdown nrepl on
   undeploy, and returns a server that can be passed to stop-nrepl to
   shut it down manually."
  ([interface port]
     (let [{{:keys [nrepl-middleware nrepl-handler]} :repl-options}
         (registry/get :project)
         require-resolve #(do (-> % namespace symbol require)
                              (resolve %))
         interface-address (or (util/lookup-interface-address interface)
                               interface
                               (util/management-interface-address))]
       (if (nil? interface-address)
         (log/warn "Invalid interface address for nREPL; use :nrepl-interface")
         (do
           (log/info "Starting nREPL for" (util/app-name)
                     "at" (str interface-address ":" port))
           (future (require 'clj-stacktrace.repl 'complete.core))
           (when (and nrepl-middleware nrepl-handler)
             (throw (IllegalArgumentException.
                     "Can only use one of :nrepl-handler or :nrepl-middleware")))
           (let [handler (or (and nrepl-handler (require-resolve nrepl-handler))
                             (->> nrepl-middleware
                                  (map #(cond
                                         (var? %) %
                                         (symbol? %) (require-resolve %)
                                         (list? %) (eval %)))
                                  (apply (util/try-resolve
                                          'clojure.tools.nrepl.server/default-handler))))]
             (when-let [server ((util/try-resolve 'clojure.tools.nrepl.server/start-server)
                                :handler handler
                                :port (fix-port port)
                                :bind interface-address)]
               (util/at-exit (partial stop-nrepl server))
               server))))))
  ([port]
   (start-nrepl nil port)))

(defn ^:private spit-nrepl-files
  [port file]
  (doseq [f (map util/app-relative
                 (if file
                   [file]
                   [".nrepl-port" "target/repl-port"]))]
    (.mkdirs (.getParentFile f))
    (spit f port)
    (.deleteOnExit f)))

(defn ^{:internal true :no-doc true} init-repl
  "Looks for nrepl-port value in the given config, and starts
the appropriate servers."
  [config]
  (let [ring-nrepl-config (-> (registry/get :project) :ring :nrepl)
        port (or (:nrepl-port config)
                 (and (:start? ring-nrepl-config)
                      (:port ring-nrepl-config))
                 (if (util/dev-mode?) 0 nil))
        interface (:nrepl-interface config)]
    (if (or port interface)
      (if-let [nrepl (start-nrepl interface (or port 0))]
        (let [ss (-> nrepl deref :ss)
              host (-> ss .getInetAddress .getHostAddress)
              bound-port (.getLocalPort ss)]
          (log/info "nREPL bound to" (str host ":" bound-port))
          (spit-nrepl-files bound-port (:nrepl-port-file config)))))))

Use ring's nrepl port setting if present


(ns comic-reader.server
  (:gen-class)
  (:require [compojure.core :as c]
            [compojure.route :as route]
            [environ.core :refer [env]]
            [hiccup.page :as page]
            [ring.adapter.jetty :refer [run-jetty]]
            [ring.middleware.edn :refer [wrap-edn-params]]
            [ring.middleware.params :refer [wrap-params]]))

(defn edn-response [data & [status]]
  {:status (or status 200)
   :headers {"Content-Type" "application/edn"}
   :body (pr-str data)})

(c/defroutes routes
  (c/GET "/" [] (page/html5
                 [:head
                  (page/include-css "css/normalize.css"
                                    "css/foundation.min.css"
                                    "css/app.css")
                  (page/include-js "js/vendor/modernizr.js")]
                 [:body
                  [:div.row
                   [:div#app.small-12.columns]]
                  [:input#history_state {:type "hidden"}]
                  (page/include-js "js/vendor/jquery.js"
                                   "js/vendor/fastclick.js"
                                   "js/foundation.min.js"
                                   "js/compiled/main.js")]))

  (c/context "/api/v1" []
    (c/GET "/sites" []
      (edn-response
       ))

    (c/GET "/comics/:site" [site]
      )

    (c/GET "/pages/:site/:comic/:chapter{\\d+}/:page{\\d+}"
        request
      )

    (c/POST "/img" {{:keys [site]
                     {:keys [chapter page url]} :page-info}
                    :edn-params
                    :as request}
      ))

  (route/resources "/"))

(def app (-> routes
             wrap-params
             wrap-edn-params))

(defn run-web-server [& [port]]
  (let [port (Integer. (or port (env :port) 10555))]
    (print "Starting web server on port" port ".\n")
    (run-jetty app {:port port :join? false})))

(defn -main [& [port]]
  (run-web-server port))

(ns comic-reader.server
  (:gen-class)
  (:require [compojure.core :as c]
            [compojure.route :as route]
            [com.stuartsierra.component :as component]
            [environ.core :refer [env]]
            [hiccup.page :as page]
            [ring.adapter.jetty :refer [run-jetty]]
            [ring.middleware.edn :refer [wrap-edn-params]]
            [ring.middleware.params :refer [wrap-params]])
  (:import org.eclipse.jetty.server.Server))

(defn edn-response [data & [status]]
  {:status (or status 200)
   :headers {"Content-Type" "application/edn"}
   :body (pr-str data)})

(c/defroutes routes
  (c/GET "/" [] (page/html5
                 [:head
                  (page/include-css "css/normalize.css"
                                    "css/foundation.min.css"
                                    "css/app.css")
                  (page/include-js "js/vendor/modernizr.js")]
                 [:body
                  [:div.row
                   [:div#app.small-12.columns]]
                  [:input#history_state {:type "hidden"}]
                  (page/include-js "js/vendor/jquery.js"
                                   "js/vendor/fastclick.js"
                                   "js/foundation.min.js"
                                   "js/compiled/main.js")]))

  (c/context "/api/v1" []
    (c/GET "/sites" []
      (edn-response
       ))

    (c/GET "/comics/:site" [site]
      )

    (c/GET "/pages/:site/:comic/:chapter{\\d+}/:page{\\d+}"
        request
      )

    (c/POST "/img" {{:keys [site]
                     {:keys [chapter page url]} :page-info}
                    :edn-params
                    :as request}
      ))

  (route/resources "/"))

(def app (-> routes
             wrap-params
             wrap-edn-params))

(defrecord WebServer [app port ^Server server site-scraper]
  component/Lifecycle

  (start [component]
    (if server
      component
      (do
        (println "Starting web server...")
        (assoc component
               :server (run-jetty app {:port port
                                       :join? false})))))

  (stop [component]
    (if (not server)
      component
      (do
        (when (or (not (.isStopped server))
                  (not (.isStopping server)))
          (println "Shutting down web server...")
          (.stop server))
        (assoc component :server nil)))))

(defn new-server [app port]
  (map->WebServer {:app app
                   :port port}))

(defn run-web-server [& [port]]
  (let [port (Integer. (or port (env :port) 10555))]
    (print "Starting web server on port" port ".\n")
    (run-jetty app {:port port :join? false})))

(defn -main [& [port]]
  (run-web-server port))

Create a WebServer component

Create a WebServer component


(in-ns 'test.core)

(deftest astrolabe-memory
  "Astrolabe - Gain 1 memory"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Astrolabe" 3)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Astrolabe")
    (is (= 5 (:memory (get-runner))) "Gain 1 memory")))

(deftest astrolabe-draw
  "Astrolabe - Draw on new server install"
  (do-game
    (new-game (default-corp [(qty "Snare!" 3)])
              (default-runner [(qty "Astrolabe" 3) (qty "Sure Gamble" 3) (qty "Cloak" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Astrolabe")
    (take-credits state :runner 3)
    ;; corp's turn. install something from HQ to trigger Astrolabe draw
    (play-from-hand state :corp "Snare!" "New remote")
    (is (= 5 (count (:hand (get-runner)))) "Drew 1 card from server install")
    ;; install over the old server; make sure nothing is drawn
    (play-from-hand state :corp "Snare!" "Server 0")
    (is (= 5 (count (:hand (get-runner)))) "Did not draw")
    (is (= 1 (count (:deck (get-runner)))) "1 card left in deck")))

(deftest brain-chip
  "Brain Chip handsize and memory limit"
  (do-game
   (new-game (default-corp)
             (default-runner [(qty "Brain Chip" 1)]))
   (take-credits state :corp)
   (play-from-hand state :runner "Brain Chip")
   (swap! state assoc-in [:runner :agenda-point] -2) ; hard set ap
   (is (= (core/hand-size state :runner) 5) "Hand size unaffected")
   (is (= (get-in @state [:runner :memory]) 4) "Memory limit unaffected")
   (swap! state assoc-in [:runner :agenda-point] 2)
   (is (= (core/hand-size state :runner) 7) "Hand size increased by 2")
   (is (= (get-in @state [:runner :memory]) 6) "Memory limit increased by 2")
   (core/move state :runner (get-in @state [:runner :rig :hardware 0]) :discard)
   (is (= (core/hand-size state :runner) 5) "Hand size reset")
   (is (= (get-in @state [:runner :memory]) 4) "Memory limit reset")))

(deftest clone-chip
  "Test clone chip usage- outside and during run"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Datasucker" 1) (qty "Clone Chip" 2)]))
    (take-credits state :corp)
    (trash-from-hand state :runner "Datasucker")
    (play-from-hand state :runner "Clone Chip")
    (let [chip (get-in @state [:runner :rig :hardware 0])]
      (card-ability state :runner chip 0)
      (prompt-select :runner (find-card "Datasucker" (:discard (get-runner))))
      (let [ds (get-in @state [:runner :rig :program 0])]
        (is (not (nil? ds)))
        (is (= (:title ds) "Datasucker"))))))

(deftest comet-event-play
  "Comet - Play event without spending a click after first event played"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Comet" 3) (qty "Easy Mark" 2)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Comet")
    (let [comet (get-in @state [:runner :rig :hardware 0])]
      (play-from-hand state :runner "Easy Mark")
      (is (= true (:comet-event (core/get-card state comet)))) ; Comet ability enabled
      (card-ability state :runner comet 0)
      (is (= (:cid comet) (-> @state :runner :prompt first :card :cid)))
      (prompt-select :runner (find-card "Easy Mark" (:hand (get-runner))))
      (is (= 7 (:credit (get-runner))))
      (is (= 2 (:click (get-runner))))
      (is (nil? (:comet-event (core/get-card state comet))) "Comet ability disabled"))))

(deftest dinosaurus-strength-boost-mu-savings
  "Dinosaurus - Boost strength of hosted icebreaker; keep MU the same when hosting or trashing hosted breaker"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Dinosaurus" 1) (qty "Battering Ram" 1)]))
    (take-credits state :corp)
    (core/gain state :runner :credit 5)
    (play-from-hand state :runner "Dinosaurus")
    (let [dino (get-in @state [:runner :rig :hardware 0])]
      (card-ability state :runner dino 0)
      (prompt-select :runner (find-card "Battering Ram" (:hand (get-runner))))
      (is (= 2 (:click (get-runner))))
      (is (= 0 (:credit (get-runner))))
      (is (= 4 (:memory (get-runner))) "Battering Ram 2 MU not deducted from available MU")
      (let [ram (first (:hosted (refresh dino)))]
        (is (= 5 (:current-strength (refresh ram)))
            "Dinosaurus giving +2 strength to Battering Ram")
        ;; Trash Battering Ram
        (core/move state :runner (find-card "Battering Ram" (:hosted (refresh dino))) :discard)
        (is (= 4 (:memory (get-runner))) "Battering Ram 2 MU not added to available MU")))))

(deftest feedback-filter
  "Feedback Filter - Prevent net and brain damage"
  (do-game
    (new-game (default-corp [(qty "Data Mine" 1)
                             (qty "Cerebral Overwriter" 1)
                             (qty "Mushin No Shin" 1)])
              (default-runner [(qty "Feedback Filter" 2) (qty "Sure Gamble" 3)]))
    (play-from-hand state :corp "Mushin No Shin")
    (prompt-select :corp (find-card "Cerebral Overwriter" (:hand (get-corp))))
    (play-from-hand state :corp "Data Mine" "Server 1")
    (let [co (get-content state :remote1 0)
          dm (get-ice state :remote1 0)]
      (is (= 3 (:advance-counter (refresh co))) "3 advancements on Overwriter")
      (take-credits state :corp)
      (play-from-hand state :runner "Sure Gamble")
      (play-from-hand state :runner "Feedback Filter")
      (is (= 7 (:credit (get-runner))))
      (let [ff (get-in @state [:runner :rig :hardware 0])]
        (run-on state "Server 1")
        (core/rez state :corp dm)
        (card-ability state :corp dm 0)
        (card-ability state :runner ff 0)
        (prompt-choice :runner "Done")
        (is (= 3 (count (:hand (get-runner)))) "1 net damage prevented")
        (is (= 4 (:credit (get-runner))))
        (run-successful state)
        (prompt-choice :corp "Yes") ; pay 3 to fire Overwriter
        (prompt-choice :runner "Yes") ; trash Overwriter for 0 to get to prevention prompt
        (card-ability state :runner ff 1)
        (prompt-choice :runner "Done")
        (is (= 1 (:brain-damage (get-runner))) "2 of the 3 brain damage prevented")
        (is (= 2 (count (:hand (get-runner)))))
        (is (empty? (get-in @state [:runner :rig :hardware])) "Feedback Filter trashed")))))

(deftest grimoire
  "Grimoire - Gain 2 MU, add a free virus counter to installed virus programs"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Grimoire" 1) (qty "Imp" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Grimoire")
    (is (= 6 (:memory (get-runner))) "Gained 2 MU")
    (play-from-hand state :runner "Imp")
    (let [imp (get-in @state [:runner :rig :program 0])]
      (is (= 3 (:counter (refresh imp))) "Imp received an extra virus counter on install"))))

(deftest maya
  "Maya - Move accessed card to bottom of R&D"
  (do-game
    (new-game (default-corp [(qty "Hedge Fund" 2) (qty "Scorched Earth" 2) (qty "Snare!" 2)])
              (default-runner [(qty "Maya" 1) (qty "Sure Gamble" 3)]))
    (core/move state :corp (find-card "Scorched Earth" (:hand (get-corp))) :deck)
    (core/move state :corp (find-card "Snare!" (:hand (get-corp))) :deck)
    (take-credits state :corp)
    (play-from-hand state :runner "Maya")
    (let [maya (get-in @state [:runner :rig :hardware 0])
          accessed (first (:deck (get-corp)))]
      (run-empty-server state :rd)
      (is (= (:cid accessed) (:cid (:card (first (:prompt (get-runner)))))) "Accessing the top card of R&D")
      (card-ability state :runner maya 0)
      (is (empty? (:prompt (get-runner))) "No more prompts for runner")
      (is (not (:run @state)) "Run is ended")
      (is (= (:cid accessed) (:cid (last (:deck (get-corp))))) "Maya moved the accessed card to the bottom of R&D")
      (take-credits state :runner)
      (core/draw state :corp)
      (take-credits state :corp)
      (core/move state :corp (find-card "Snare!" (:hand (get-corp))) :deck)
      (core/move state :corp (find-card "Scorched Earth" (:hand (get-corp))) :deck)
      (let [accessed (first (:deck (get-corp)))]
        (run-empty-server state :rd)
        (prompt-choice :corp "Yes")
        (is (= 0 (count (:hand (get-runner)))) "Runner took Snare! net damage")
        (is (= (:cid accessed) (:cid (:card (first (:prompt (get-runner)))))) "Accessing the top card of R&D")
        (card-ability state :runner maya 0)
        (is (empty? (:prompt (get-runner))) "No more prompts for runner")
        (is (not (:run @state)) "Run is ended")
        (is (= (:cid accessed) (:cid (last (:deck (get-corp))))) "Maya moved the accessed card to the bottom of R&D")))))

(deftest plascrete
  "Plascrete Carapace - Prevent meat damage"
  (do-game
    (new-game (default-corp [(qty "Scorched Earth" 1)])
              (default-runner [(qty "Plascrete Carapace" 1) (qty "Sure Gamble" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Plascrete Carapace")
    (let [plas (get-in @state [:runner :rig :hardware 0])]
      (is (= 4 (:counter (refresh plas))) "4 counters on install")
      (take-credits state :runner)
      (core/gain state :runner :tag 1)
      (play-from-hand state :corp "Scorched Earth")
      (card-ability state :runner plas 0)
      (card-ability state :runner plas 0)
      (card-ability state :runner plas 0)
      (card-ability state :runner plas 0)
      (prompt-choice :runner "Done")
      (is (= 1 (count (:hand (get-runner)))) "All meat damage prevented")
      (is (empty? (get-in @state [:runner :rig :hardware])) "Plascrete depleted and trashed"))))

(deftest the-personal-touch
  "The Personal Touch - Give +1 strength to an icebreaker"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "The Personal Touch" 1)
                               (qty "Paricia" 1)
                               (qty "Faerie" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Paricia")
    (play-from-hand state :runner "Faerie")
    (let [par (get-in @state [:runner :rig :program 0])
          fae (get-in @state [:runner :rig :program 1])]
      (is (= 2 (:current-strength (refresh fae))))
      (play-from-hand state :runner "The Personal Touch")
      (prompt-select :runner par)
      (is (nil? (:hosted (refresh par))) "TPT can't be hosted on a non-icebreaker")
      (prompt-select :runner fae)
      (is (= 1 (count (:hosted (refresh fae)))) "TPT hosted on Faerie")
      (is (= 3 (:current-strength (refresh fae))) "Faerie receiving +1 strength from TPT"))))

(deftest turntable-swap
  "Turntable - Swap a stolen agenda for a scored agenda"
  (do-game
    (new-game (default-corp [(qty "Domestic Sleepers" 1) (qty "Project Vitruvius" 1)])
              (default-runner [(qty "Turntable" 1)]))
    (play-from-hand state :corp "Project Vitruvius" "New remote")
    (let [ag1 (get-content state :remote1 0)]
      (score-agenda state :corp ag1)
      (take-credits state :corp)
      (play-from-hand state :runner "Turntable")
      (is (= 3 (:credit (get-runner))))
      (let [tt (get-in @state [:runner :rig :hardware 0])]
        (run-empty-server state "HQ")
        (prompt-choice :runner "Steal")
        (is (= 0 (:agenda-point (get-runner))) "Stole Domestic Sleepers")
        (is (= true (:swap (core/get-card state tt)))) ; Turntable ability enabled by steal
        (card-ability state :runner tt 0)
        ;; Turntable prompt should be active
        (is (= (:cid tt) (-> @state :runner :prompt first :card :cid)))
        (prompt-select :runner (find-card "Project Vitruvius" (:scored (get-corp))))
        (is (= 2 (:agenda-point (get-runner))) "Took Project Vitruvius from Corp")
        (is (= 0 (:agenda-point (get-corp))) "Swapped Domestic Sleepers to Corp")
        (is (nil? (:swap (core/get-card state tt))) "Turntable ability disabled")))))

(deftest turntable-mandatory-upgrades
  "Turntable - Swap a Mandatory Upgrades away from the Corp reduces Corp clicks per turn"
  (do-game
    (new-game (default-corp [(qty "Mandatory Upgrades" 1) (qty "Project Vitruvius" 1)])
              (default-runner [(qty "Turntable" 1)]))
    (play-from-hand state :corp "Mandatory Upgrades" "New remote")
    (let [manups (get-content state :remote1 0)]
      (score-agenda state :corp manups)
      (is (= 4 (:click-per-turn (get-corp))) "Up to 4 clicks per turn")
      (take-credits state :corp)
      (play-from-hand state :runner "Turntable")
      (let [tt (get-in @state [:runner :rig :hardware 0])]
        (run-empty-server state "HQ")
        (prompt-choice :runner "Steal")
        (is (= 2 (:agenda-point (get-runner))) "Stole Project Vitruvius")
        (card-ability state :runner tt 0)
        (prompt-select :runner (find-card "Mandatory Upgrades" (:scored (get-corp))))
        (is (= 3 (:click-per-turn (get-corp))) "Back down to 3 clicks per turn")
        (is (nil? (:swap (core/get-card state tt))) "Turntable ability disabled")))))

(in-ns 'test.core)

(deftest astrolabe-memory
  "Astrolabe - Gain 1 memory"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Astrolabe" 3)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Astrolabe")
    (is (= 5 (:memory (get-runner))) "Gain 1 memory")))

(deftest astrolabe-draw
  "Astrolabe - Draw on new server install"
  (do-game
    (new-game (default-corp [(qty "Snare!" 3)])
              (default-runner [(qty "Astrolabe" 3) (qty "Sure Gamble" 3) (qty "Cloak" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Astrolabe")
    (take-credits state :runner 3)
    ;; corp's turn. install something from HQ to trigger Astrolabe draw
    (play-from-hand state :corp "Snare!" "New remote")
    (is (= 5 (count (:hand (get-runner)))) "Drew 1 card from server install")
    ;; install over the old server; make sure nothing is drawn
    (play-from-hand state :corp "Snare!" "Server 0")
    (is (= 5 (count (:hand (get-runner)))) "Did not draw")
    (is (= 1 (count (:deck (get-runner)))) "1 card left in deck")))

(deftest brain-chip
  "Brain Chip handsize and memory limit"
  (do-game
   (new-game (default-corp)
             (default-runner [(qty "Brain Chip" 1)]))
   (take-credits state :corp)
   (play-from-hand state :runner "Brain Chip")
   (swap! state assoc-in [:runner :agenda-point] -2) ; hard set ap
   (is (= (core/hand-size state :runner) 5) "Hand size unaffected")
   (is (= (get-in @state [:runner :memory]) 4) "Memory limit unaffected")
   (swap! state assoc-in [:runner :agenda-point] 2)
   (is (= (core/hand-size state :runner) 7) "Hand size increased by 2")
   (is (= (get-in @state [:runner :memory]) 6) "Memory limit increased by 2")
   (core/move state :runner (get-in @state [:runner :rig :hardware 0]) :discard)
   (is (= (core/hand-size state :runner) 5) "Hand size reset")
   (is (= (get-in @state [:runner :memory]) 4) "Memory limit reset")))

(deftest clone-chip
  "Test clone chip usage- outside and during run"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Datasucker" 1) (qty "Clone Chip" 2)]))
    (take-credits state :corp)
    (trash-from-hand state :runner "Datasucker")
    (play-from-hand state :runner "Clone Chip")
    (let [chip (get-in @state [:runner :rig :hardware 0])]
      (card-ability state :runner chip 0)
      (prompt-select :runner (find-card "Datasucker" (:discard (get-runner))))
      (let [ds (get-in @state [:runner :rig :program 0])]
        (is (not (nil? ds)))
        (is (= (:title ds) "Datasucker"))))))

(deftest comet-event-play
  "Comet - Play event without spending a click after first event played"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Comet" 3) (qty "Easy Mark" 2)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Comet")
    (let [comet (get-in @state [:runner :rig :hardware 0])]
      (play-from-hand state :runner "Easy Mark")
      (is (= true (:comet-event (core/get-card state comet)))) ; Comet ability enabled
      (card-ability state :runner comet 0)
      (is (= (:cid comet) (-> @state :runner :prompt first :card :cid)))
      (prompt-select :runner (find-card "Easy Mark" (:hand (get-runner))))
      (is (= 7 (:credit (get-runner))))
      (is (= 2 (:click (get-runner))))
      (is (nil? (:comet-event (core/get-card state comet))) "Comet ability disabled"))))

(deftest dinosaurus-strength-boost-mu-savings
  "Dinosaurus - Boost strength of hosted icebreaker; keep MU the same when hosting or trashing hosted breaker"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Dinosaurus" 1) (qty "Battering Ram" 1)]))
    (take-credits state :corp)
    (core/gain state :runner :credit 5)
    (play-from-hand state :runner "Dinosaurus")
    (let [dino (get-in @state [:runner :rig :hardware 0])]
      (card-ability state :runner dino 0)
      (prompt-select :runner (find-card "Battering Ram" (:hand (get-runner))))
      (is (= 2 (:click (get-runner))))
      (is (= 0 (:credit (get-runner))))
      (is (= 4 (:memory (get-runner))) "Battering Ram 2 MU not deducted from available MU")
      (let [ram (first (:hosted (refresh dino)))]
        (is (= 5 (:current-strength (refresh ram)))
            "Dinosaurus giving +2 strength to Battering Ram")
        ;; Trash Battering Ram
        (core/move state :runner (find-card "Battering Ram" (:hosted (refresh dino))) :discard)
        (is (= 4 (:memory (get-runner))) "Battering Ram 2 MU not added to available MU")))))

(deftest feedback-filter
  "Feedback Filter - Prevent net and brain damage"
  (do-game
    (new-game (default-corp [(qty "Data Mine" 1)
                             (qty "Cerebral Overwriter" 1)
                             (qty "Mushin No Shin" 1)])
              (default-runner [(qty "Feedback Filter" 2) (qty "Sure Gamble" 3)]))
    (play-from-hand state :corp "Mushin No Shin")
    (prompt-select :corp (find-card "Cerebral Overwriter" (:hand (get-corp))))
    (play-from-hand state :corp "Data Mine" "Server 1")
    (let [co (get-content state :remote1 0)
          dm (get-ice state :remote1 0)]
      (is (= 3 (:advance-counter (refresh co))) "3 advancements on Overwriter")
      (take-credits state :corp)
      (play-from-hand state :runner "Sure Gamble")
      (play-from-hand state :runner "Feedback Filter")
      (is (= 7 (:credit (get-runner))))
      (let [ff (get-in @state [:runner :rig :hardware 0])]
        (run-on state "Server 1")
        (core/rez state :corp dm)
        (card-ability state :corp dm 0)
        (card-ability state :runner ff 0)
        (prompt-choice :runner "Done")
        (is (= 3 (count (:hand (get-runner)))) "1 net damage prevented")
        (is (= 4 (:credit (get-runner))))
        (run-successful state)
        (prompt-choice :corp "Yes") ; pay 3 to fire Overwriter
        (card-ability state :runner ff 1)
        (prompt-choice :runner "Done")
        (prompt-choice :runner "Yes") ; trash Overwriter for 0
        (is (= 1 (:brain-damage (get-runner))) "2 of the 3 brain damage prevented")
        (is (= 2 (count (:hand (get-runner)))))
        (is (empty? (get-in @state [:runner :rig :hardware])) "Feedback Filter trashed")))))

(deftest grimoire
  "Grimoire - Gain 2 MU, add a free virus counter to installed virus programs"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "Grimoire" 1) (qty "Imp" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Grimoire")
    (is (= 6 (:memory (get-runner))) "Gained 2 MU")
    (play-from-hand state :runner "Imp")
    (let [imp (get-in @state [:runner :rig :program 0])]
      (is (= 3 (:counter (refresh imp))) "Imp received an extra virus counter on install"))))

(deftest maya
  "Maya - Move accessed card to bottom of R&D"
  (do-game
    (new-game (default-corp [(qty "Hedge Fund" 2) (qty "Scorched Earth" 2) (qty "Snare!" 2)])
              (default-runner [(qty "Maya" 1) (qty "Sure Gamble" 3)]))
    (core/move state :corp (find-card "Scorched Earth" (:hand (get-corp))) :deck)
    (core/move state :corp (find-card "Snare!" (:hand (get-corp))) :deck)
    (take-credits state :corp)
    (play-from-hand state :runner "Maya")
    (let [maya (get-in @state [:runner :rig :hardware 0])
          accessed (first (:deck (get-corp)))]
      (run-empty-server state :rd)
      (is (= (:cid accessed) (:cid (:card (first (:prompt (get-runner)))))) "Accessing the top card of R&D")
      (card-ability state :runner maya 0)
      (is (empty? (:prompt (get-runner))) "No more prompts for runner")
      (is (not (:run @state)) "Run is ended")
      (is (= (:cid accessed) (:cid (last (:deck (get-corp))))) "Maya moved the accessed card to the bottom of R&D")
      (take-credits state :runner)
      (core/draw state :corp)
      (take-credits state :corp)
      (core/move state :corp (find-card "Snare!" (:hand (get-corp))) :deck)
      (core/move state :corp (find-card "Scorched Earth" (:hand (get-corp))) :deck)
      (let [accessed (first (:deck (get-corp)))]
        (run-empty-server state :rd)
        (prompt-choice :corp "Yes")
        (is (= 0 (count (:hand (get-runner)))) "Runner took Snare! net damage")
        (is (= (:cid accessed) (:cid (:card (first (:prompt (get-runner)))))) "Accessing the top card of R&D")
        (card-ability state :runner maya 0)
        (is (empty? (:prompt (get-runner))) "No more prompts for runner")
        (is (not (:run @state)) "Run is ended")
        (is (= (:cid accessed) (:cid (last (:deck (get-corp))))) "Maya moved the accessed card to the bottom of R&D")))))

(deftest plascrete
  "Plascrete Carapace - Prevent meat damage"
  (do-game
    (new-game (default-corp [(qty "Scorched Earth" 1)])
              (default-runner [(qty "Plascrete Carapace" 1) (qty "Sure Gamble" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Plascrete Carapace")
    (let [plas (get-in @state [:runner :rig :hardware 0])]
      (is (= 4 (:counter (refresh plas))) "4 counters on install")
      (take-credits state :runner)
      (core/gain state :runner :tag 1)
      (play-from-hand state :corp "Scorched Earth")
      (card-ability state :runner plas 0)
      (card-ability state :runner plas 0)
      (card-ability state :runner plas 0)
      (card-ability state :runner plas 0)
      (prompt-choice :runner "Done")
      (is (= 1 (count (:hand (get-runner)))) "All meat damage prevented")
      (is (empty? (get-in @state [:runner :rig :hardware])) "Plascrete depleted and trashed"))))

(deftest the-personal-touch
  "The Personal Touch - Give +1 strength to an icebreaker"
  (do-game
    (new-game (default-corp)
              (default-runner [(qty "The Personal Touch" 1)
                               (qty "Paricia" 1)
                               (qty "Faerie" 1)]))
    (take-credits state :corp)
    (play-from-hand state :runner "Paricia")
    (play-from-hand state :runner "Faerie")
    (let [par (get-in @state [:runner :rig :program 0])
          fae (get-in @state [:runner :rig :program 1])]
      (is (= 2 (:current-strength (refresh fae))))
      (play-from-hand state :runner "The Personal Touch")
      (prompt-select :runner par)
      (is (nil? (:hosted (refresh par))) "TPT can't be hosted on a non-icebreaker")
      (prompt-select :runner fae)
      (is (= 1 (count (:hosted (refresh fae)))) "TPT hosted on Faerie")
      (is (= 3 (:current-strength (refresh fae))) "Faerie receiving +1 strength from TPT"))))

(deftest turntable-swap
  "Turntable - Swap a stolen agenda for a scored agenda"
  (do-game
    (new-game (default-corp [(qty "Domestic Sleepers" 1) (qty "Project Vitruvius" 1)])
              (default-runner [(qty "Turntable" 1)]))
    (play-from-hand state :corp "Project Vitruvius" "New remote")
    (let [ag1 (get-content state :remote1 0)]
      (score-agenda state :corp ag1)
      (take-credits state :corp)
      (play-from-hand state :runner "Turntable")
      (is (= 3 (:credit (get-runner))))
      (let [tt (get-in @state [:runner :rig :hardware 0])]
        (run-empty-server state "HQ")
        (prompt-choice :runner "Steal")
        (is (= 0 (:agenda-point (get-runner))) "Stole Domestic Sleepers")
        (is (= true (:swap (core/get-card state tt)))) ; Turntable ability enabled by steal
        (card-ability state :runner tt 0)
        ;; Turntable prompt should be active
        (is (= (:cid tt) (-> @state :runner :prompt first :card :cid)))
        (prompt-select :runner (find-card "Project Vitruvius" (:scored (get-corp))))
        (is (= 2 (:agenda-point (get-runner))) "Took Project Vitruvius from Corp")
        (is (= 0 (:agenda-point (get-corp))) "Swapped Domestic Sleepers to Corp")
        (is (nil? (:swap (core/get-card state tt))) "Turntable ability disabled")))))

(deftest turntable-mandatory-upgrades
  "Turntable - Swap a Mandatory Upgrades away from the Corp reduces Corp clicks per turn"
  (do-game
    (new-game (default-corp [(qty "Mandatory Upgrades" 1) (qty "Project Vitruvius" 1)])
              (default-runner [(qty "Turntable" 1)]))
    (play-from-hand state :corp "Mandatory Upgrades" "New remote")
    (let [manups (get-content state :remote1 0)]
      (score-agenda state :corp manups)
      (is (= 4 (:click-per-turn (get-corp))) "Up to 4 clicks per turn")
      (take-credits state :corp)
      (play-from-hand state :runner "Turntable")
      (let [tt (get-in @state [:runner :rig :hardware 0])]
        (run-empty-server state "HQ")
        (prompt-choice :runner "Steal")
        (is (= 2 (:agenda-point (get-runner))) "Stole Project Vitruvius")
        (card-ability state :runner tt 0)
        (prompt-select :runner (find-card "Mandatory Upgrades" (:scored (get-corp))))
        (is (= 3 (:click-per-turn (get-corp))) "Back down to 3 clicks per turn")
        (is (nil? (:swap (core/get-card state tt))) "Turntable ability disabled")))))

Update Feedback Filter test due to prevention prompt changes.


(ns flambo.function
  (:require [serializable.fn :as sfn]
            [flambo.kryo :as kryo]
            [clojure.tools.logging :as log]
            [flambo.utils :as utils]))

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

(defn- serfn? [f]
  (= (type f) :serializable.fn/serializable-fn))

(def serialize-fn sfn/serialize)

;; XXX: memoizing here is weird because all functions in a JVM now share a single
;;      cache lookup. Maybe we could memoize in the constructor or something instead?
;; TODO: what is a good cache size here???
(def deserialize-fn (utils/lru-memoize 5000 sfn/deserialize))
(def array-of-bytes-type (Class/forName "[B"))

;; ## Generic
(defn -init
  "Save the function f in state"
  [f]
  [[] f])

(defn -call [this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

;; ## Functions
(defn mk-sym
  [fmt sym-name]
  (symbol (format fmt sym-name)))

(defmacro gen-function
  [clazz wrapper-name]
  (let [new-class-sym (mk-sym "flambo.function.%s" clazz)
        prefix-sym (mk-sym "%s-" clazz)]
    `(do
       (def ~(mk-sym "%s-init" clazz) -init)
       (def ~(mk-sym "%s-call" clazz) -call)
       (gen-class
        :name ~new-class-sym
        :extends flambo.function.AbstractFlamboFunction
        :implements [~(mk-sym "org.apache.spark.api.java.function.%s" clazz)]
        :prefix ~prefix-sym
        :init ~'init
        :state ~'state
        :constructors {[Object] []})
       (defn ~wrapper-name [f#]
         (new ~new-class-sym
              (if (serfn? f#)
                (binding [sfn/*serialize* kryo/serialize]
                  (serialize-fn f#)) f#))))))

(gen-function Function function)
(gen-function Function2 function2)
(gen-function Function3 function3)
(gen-function VoidFunction void-function)
(gen-function VoidFunction2 void-function2)
(gen-function FlatMapFunction flat-map-function)
(gen-function FlatMapFunction2 flat-map-function2)
(gen-function PairFlatMapFunction pair-flat-map-function)
(gen-function PairFunction pair-function)
(gen-function DoubleFunction double-function)
(gen-function DoubleFlatMapFunction double-flat-map-function)

;; This sucks, but I need to do it to type hint the call to .state
;; and I don't think I can do that from the generic -call I used above.

(defn Function-call [^flambo.function.Function this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn Function2-call [^flambo.function.Function2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn Function3-call [^flambo.function.Function2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn VoidFunction-call [^flambo.function.VoidFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn VoidFunction2-call [^flambo.function.VoidFunction2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn FlatMapFunction-call [^flambo.function.FlatMapFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn FlatMapFunction2-call [^flambo.function.FlatMapFunction2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn PairFlatMapFunction-call [^flambo.function.PairFlatMapFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn PairFunction-call [^flambo.function.PairFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn DoubleFunction-call [^flambo.function.DoubleFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(defn DoubleFlatMapFunction-call [^flambo.function.DoubleFlatMapFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (log/trace "CLASS" (type this))
    (log/trace "META" (meta f))
    (log/trace "XS" xs)
    (apply f xs)))

(ns flambo.function
  (:require [serializable.fn :as sfn]
            [flambo.kryo :as kryo]
            [flambo.utils :as utils]))

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

(defn- serfn? [f]
  (= (type f) :serializable.fn/serializable-fn))

(def serialize-fn sfn/serialize)

;; XXX: memoizing here is weird because all functions in a JVM now share a single
;;      cache lookup. Maybe we could memoize in the constructor or something instead?
;; TODO: what is a good cache size here???
(def deserialize-fn (utils/lru-memoize 5000 sfn/deserialize))
(def array-of-bytes-type (Class/forName "[B"))

;; ## Generic
(defn -init
  "Save the function f in state"
  [f]
  [[] f])

(defn -call [this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

;; ## Functions
(defn mk-sym
  [fmt sym-name]
  (symbol (format fmt sym-name)))

(defmacro gen-function
  [clazz wrapper-name]
  (let [new-class-sym (mk-sym "flambo.function.%s" clazz)
        prefix-sym (mk-sym "%s-" clazz)]
    `(do
       (def ~(mk-sym "%s-init" clazz) -init)
       (def ~(mk-sym "%s-call" clazz) -call)
       (gen-class
        :name ~new-class-sym
        :extends flambo.function.AbstractFlamboFunction
        :implements [~(mk-sym "org.apache.spark.api.java.function.%s" clazz)]
        :prefix ~prefix-sym
        :init ~'init
        :state ~'state
        :constructors {[Object] []})
       (defn ~wrapper-name [f#]
         (new ~new-class-sym
              (if (serfn? f#)
                (binding [sfn/*serialize* kryo/serialize]
                  (serialize-fn f#)) f#))))))

(gen-function Function function)
(gen-function Function2 function2)
(gen-function Function3 function3)
(gen-function VoidFunction void-function)
(gen-function VoidFunction2 void-function2)
(gen-function FlatMapFunction flat-map-function)
(gen-function FlatMapFunction2 flat-map-function2)
(gen-function PairFlatMapFunction pair-flat-map-function)
(gen-function PairFunction pair-function)
(gen-function DoubleFunction double-function)
(gen-function DoubleFlatMapFunction double-flat-map-function)

;; This sucks, but I need to do it to type hint the call to .state
;; and I don't think I can do that from the generic -call I used above.

(defn Function-call [^flambo.function.Function this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn Function2-call [^flambo.function.Function2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn Function3-call [^flambo.function.Function2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn VoidFunction-call [^flambo.function.VoidFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn VoidFunction2-call [^flambo.function.VoidFunction2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn FlatMapFunction-call [^flambo.function.FlatMapFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn FlatMapFunction2-call [^flambo.function.FlatMapFunction2 this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn PairFlatMapFunction-call [^flambo.function.PairFlatMapFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn PairFunction-call [^flambo.function.PairFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn DoubleFunction-call [^flambo.function.DoubleFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

(defn DoubleFlatMapFunction-call [^flambo.function.DoubleFlatMapFunction this & xs]
  (let [fn-or-serfn (.state this)
        f (if (instance? array-of-bytes-type fn-or-serfn)
            (binding [sfn/*deserialize* kryo/deserialize]
              (deserialize-fn fn-or-serfn))
            fn-or-serfn)]
    (apply f xs)))

remove logging in flambo.function

remove logging in flambo.function