(ns minreact.core
  (:require [cljsjs.react]
            [goog.object :as obj]
            [clojure.set :as set])
  (:require-macros [minreact.core :refer [genspec defreact]])
  (:refer-clojure :exclude [set!]))

(def ^:private state-key "__minreact_state")

(def ^:private props-key "__minreact_props")

(defn minreact-state
  "Return the minreact state of pure React component state s, not-found
  if not present"
  ([s] (minreact-state s nil))
  ([s not-found]
   (or (some-> s (obj/get state-key)) not-found)))

(defn minreact-props
  "Return the minreact props of pure React component props p, not-found
  if not present"
  ([p] (minreact-props p nil))
  ([p not-found]
   (or (some-> p (obj/get props-key)) not-found)))

(defn state
  "Return the components current state"
  [c]
  (minreact-state (.-state c)))

(defn props
  "Return the components current props"
  [c]
  (minreact-props (.-props c)))

(defn transact-state!
  "Set the components state to f applied to its current state and
  args."
  [c f & args]
  (.setState c (fn [react-state _]
                 (js-obj state-key
                         (apply f (minreact-state react-state) args)))))

;; NOTE om korks: Grepping large om codebases shows that in 99% of the
;; cases om/set-state! and om/update-state! are used with a single key
;; --
(defn update-state!
  "Set the components state at k to f applied to its current state and
  args. See also: transact!"
  [c k f & args]
  (apply transact! c update k f args))

(defn set-state!
  "Set the components state to newval, at k if provided."
  ([c newval]
   (.setState c (js-obj state-key newval)))
  ([c k newval]
   (transact! c assoc k newval)))

(def reserved-ks [:key :ref :dangerouslySetInnerHTML])

(defn- extract-reserved [props]
  (cond (map? props)
        [(let [obj (js-obj)]
           (doseq [k reserved-ks]
             (when-let [v (get props k)]
               (aset obj (name k) v)))
           obj)
         (apply dissoc props reserved-ks)]

        (object? props)
        (let [obj (js-obj)]
          (doseq [k (map name reserved-ks)]
            (when-let [v (obj/get props k)]
              (aset obj k v)
              (js-delete props k)))
          [obj props])

        :else
        [(js-obj) props]))

(def default-methods
  "Minreact default methods"
  (genspec
   props
   :state state
   (fn getDefaultProps []
     (js-obj props-key nil))
   (fn getInitialState []
     nil)
   (fn shouldComponentUpdate [next-props next-state]
     (or (not= next-props props)
         (not= next-state state)))))

(defn- install-watch [c iref]
  (set-state! c iref @iref)
  (add-watch iref ::watch
             (fn [_ r _ n]
               (set-state! c r n))))

(defn- uninstall-watch [c iref]
  (remove-watch iref ::watch)
  (transact! c iref dissoc iref))

(defreact watch-irefs
  "React component that watches changes of irefs and invokes
  render-child with their values."
  [render-child & irefs]
  :state kvs
  (fn getInitialState [] {})
  (fn componentDidMount []
    (run! (partial install-watch this) irefs))
  (fn componentWillReceiveProps [[_ & next-irefs]]
    (let [irefs (set irefs)
          next-irefs (set next-irefs)
          removed (set/difference irefs next-irefs)
          added (set/difference next-irefs irefs)]
      (run! (partial install-watch this) added)
      (run! (partial uninstall-watch this) removed)))
  (fn render []
    (->> irefs
         (map kvs)
         (apply render-child))))

(ns minreact.core
  (:require [cljsjs.react]
            [goog.object :as obj]
            [clojure.set :as set])
  (:require-macros [minreact.core :refer [genspec defreact]])
  (:refer-clojure :exclude [set!]))

(def ^:private state-key "__minreact_state")

(def ^:private props-key "__minreact_props")

(defn minreact-state
  "Return the minreact state of pure React component state s, not-found
  if not present"
  ([s] (minreact-state s nil))
  ([s not-found]
   (or (some-> s (obj/get state-key)) not-found)))

(defn minreact-props
  "Return the minreact props of pure React component props p, not-found
  if not present"
  ([p] (minreact-props p nil))
  ([p not-found]
   (or (some-> p (obj/get props-key)) not-found)))

(defn state
  "Return the components current state"
  [c]
  (minreact-state (.-state c)))

(defn props
  "Return the components current props"
  [c]
  (minreact-props (.-props c)))

(defn transact-state!
  "Set the components state to f applied to its current state and
  args."
  [c f & args]
  (.setState c (fn [react-state _]
                 (js-obj state-key
                         (apply f (minreact-state react-state) args)))))

;; NOTE om korks: Grepping large om codebases shows that in 99% of the
;; cases om/set-state! and om/update-state! are used with a single key
;; --
(defn update-state!
  "Set the components state at k to f applied to its current state and
  args. See also: transact!"
  [c k f & args]
  (apply transact! c update k f args))

(defn set-state!
  "Set the components state to newval, at k if provided."
  ([c newval]
   (.setState c (js-obj state-key newval)))
  ([c k newval]
   (transact! c assoc k newval)))

(def reserved-ks [:key :ref :dangerouslySetInnerHTML])

(defn- extract-reserved [props]
  (cond (map? props)
        [(let [obj (js-obj)]
           (doseq [k reserved-ks]
             (when-let [v (get props k)]
               (aset obj (name k) v)))
           obj)
         (apply dissoc props reserved-ks)]

        (object? props)
        (let [obj (js-obj)]
          (doseq [k (map name reserved-ks)]
            (when-let [v (obj/get props k)]
              (aset obj k v)
              (js-delete props k)))
          [obj props])

        :else
        [(js-obj) props]))

(def ^:private default-methods
  "Minreact default methods"
  (genspec
   props
   :state state
   (fn getDefaultProps []
     (js-obj props-key nil))
   (fn getInitialState []
     nil)
   (fn shouldComponentUpdate [next-props next-state]
     (or (not= next-props props)
         (not= next-state state)))))

(defn- install-watch [c iref]
  (set-state! c iref @iref)
  (add-watch iref ::watch
             (fn [_ r _ n]
               (set-state! c r n))))

(defn- uninstall-watch [c iref]
  (remove-watch iref ::watch)
  (transact! c iref dissoc iref))

(defreact watch-irefs
  "React component that watches changes of irefs and invokes
  render-child with their values."
  [render-child & irefs]
  :state kvs
  (fn getInitialState [] {})
  (fn componentDidMount []
    (run! (partial install-watch this) irefs))
  (fn componentWillReceiveProps [[_ & next-irefs]]
    (let [irefs (set irefs)
          next-irefs (set next-irefs)
          removed (set/difference irefs next-irefs)
          added (set/difference next-irefs irefs)]
      (run! (partial install-watch this) added)
      (run! (partial uninstall-watch this) removed)))
  (fn render []
    (->> irefs
         (map kvs)
         (apply render-child))))

make default methods private

make default methods private


(ns buddy.crypto.hashers.pbkdf2
  (:require [buddy.crypto.hashers.protocols :refer [IHasher]]
            [buddy.crypto.core :refer :all]
            [clojure.string :refer [split]])
  (:import (javax.crypto.spec PBEKeySpec)
           (javax.crypto SecretKeyFactory)))

(defn- make-pbkdf2
  [password salt iterations]
  {:pre [(or (nil? salt) (bytes? salt))]}
  (let [saltbytes        (if (nil? salt) (random-bytes 12) salt)
        passwordarray     (.toCharArray password)
        pbe-keyspec       (PBEKeySpec. passwordarray saltbytes iterations 160)]
    (-> (SecretKeyFactory/getInstance "PBKDF2WithHmacSHA1")
        (.generateSecret pbe-keyspec)
        (.getEncoded)
        (bytes->hex))))

(defn make-password
  "Encrypts a raw string password using
  pbkdf2_sha1 algorithm and return formatted
  string."
  [pw & [{:keys [salt iterations] :or {iterations 10000}}]]
  {:pre [(or (nil? salt) (bytes? salt))]}

  (let [bsalt         (if (nil? salt) (random-bytes 12) salt)
        password      (make-pbkdf2 pw bsalt iterations)
        ssalt         (bytes->hex bsalt)]
    (format "pbkdf2_sha1$%s$%s$%s" (bytes->hex bsalt) iterations password)))

(defn check-password
  "Check if a unencrypted password matches
  with another encrypted password."
  [attempt encrypted]
  (let [[t s i p] (split encrypted #"\$")]
    (if (not= t "pbkdf2_sha1")
      (throw (IllegalArgumentException. "invalid type of hasher"))
      (let [salt        (hex->bytes s)
            iterations  (Integer/parseInt i)]
        (= (make-pbkdf2 attempt salt iterations) p)))))

(defrecord Pbkdf2 [iterations]
  IHasher
  (verify [_ attempt encrypted]
    (check-password attempt encrypted))
  (make-hash [_ password salt]
    (make-password password {:salt (str->bytes salt) :iterations iterations}))
  (make-hash [_ password]
    (make-password password {:iterations iterations})))

(ns buddy.crypto.hashers.pbkdf2
  (:require [buddy.crypto.hashers.protocols :refer [IHasher]]
            [buddy.crypto.core :refer :all]
            [clojure.string :refer [split]])
  (:import (javax.crypto.spec PBEKeySpec)
           (javax.crypto SecretKeyFactory)))

(defn- make-pbkdf2
  [password salt iterations]
  {:pre [(or (nil? salt) (bytes? salt))]}
  (let [saltbytes        (if (nil? salt) (random-bytes 12) salt)
        passwordarray     (.toCharArray password)
        pbe-keyspec       (PBEKeySpec. passwordarray saltbytes iterations 160)]
    (-> (SecretKeyFactory/getInstance "PBKDF2WithHmacSHA1")
        (.generateSecret pbe-keyspec)
        (.getEncoded)
        (bytes->hex))))

(defn make-password
  "Encrypts a raw string password using
  pbkdf2_sha1 algorithm and return formatted
  string."
  [pw & [{:keys [salt iterations] :or {iterations 10000}}]]
  {:pre [(or (nil? salt) (bytes? salt))]}

  (let [bsalt         (if (nil? salt) (random-bytes 12) salt)
        password      (make-pbkdf2 pw bsalt iterations)]
    (format "pbkdf2_sha1$%s$%s$%s" (bytes->hex bsalt) iterations password)))

(defn check-password
  "Check if a unencrypted password matches
  with another encrypted password."
  [attempt encrypted]
  (let [[t s i p] (split encrypted #"\$")]
    (if (not= t "pbkdf2_sha1")
      (throw (IllegalArgumentException. "invalid type of hasher"))
      (let [salt        (hex->bytes s)
            iterations  (Integer/parseInt i)]
        (= (make-pbkdf2 attempt salt iterations) p)))))

(defrecord Pbkdf2 [iterations]
  IHasher
  (verify [_ attempt encrypted]
    (check-password attempt encrypted))
  (make-hash [_ password salt]
    (make-password password {:salt (str->bytes salt) :iterations iterations}))
  (make-hash [_ password]
    (make-password password {:iterations iterations})))

Remove unused line.

Remove unused line.


(ns circle.backend.nodes.circle
  (:require pallet.core
            pallet.phase
            [pallet.action.user :as user]
            [pallet.action.directory :as directory]
            [pallet.action.package :as package]
            [pallet.action.remote-file :as remote-file]
            [pallet.crate.automated-admin-user :as automated-admin-user]
            [pallet.crate.git :as git]
            [pallet.crate.lein :as lein]
            [pallet.crate.java :as java]
            [pallet.crate.ssh-key :as ssh-key]
            [pallet.crate.network-service :as network-service]
            [pallet.crate.postgres :as postgres]
            [circle.backend.nodes :as nodes]))

;; The node configuration to build the circle box

(def circle-group
  (pallet.core/group-spec
   "circle"
   :node-spec (pallet.core/node-spec
               :hardware {:hardware-id "m1.small"} ;; require m1.small or larger right now, because of https://bugs.launchpad.net/ubuntu/+source/linux-ec2/+bug/634487
               :image {:os-family :ubuntu
                       :location-id "us-east-1"
                       :image-id "us-east-1/ami-06ad526f"}
               :network {:inbound-ports [22 80 8080]})
   :phases {:bootstrap (pallet.phase/phase-fn
                        (automated-admin-user/automated-admin-user))
            :configure (pallet.phase/phase-fn
                        (package/package-source "ubuntu-archive"
                                                ;; by default, EC2
                                                ;; ubuntu images only
                                                ;; use ubuntu mirrors
                                                ;; hosted on EC2,
                                                ;; which sometimes go
                                                ;; down. Add this as
                                                ;; another mirror for
                                                ;; reliability
                                                :aptitude {:url "http://us.archive.ubuntu.com/ubuntu/"
                                                           :scopes ["main" "natty-updates" "universe" "multiverse"]}) ;; TODO the natty is specific to 11.04, change later.
                        (java/java :sun :jdk)
                        (git/git)
                        (postgres/settings (postgres/settings-map {:version "8.4"
                                                                   :permissions [{:connection-type "local" :database "all" :user "all" :auth-method "trust"}
                                                                                {:connection-type "host" :database "all" :user "all" :ip-mask "127.0.0.1/32" :auth-method "trust"}
                                                                                {:connection-type "host" :database "all" :user "all" :ip-mask "::1/128" :auth-method "trust"}]}))

                        (postgres/postgres)
                        (postgres/initdb)
                        (postgres/hba-conf)
                        (postgres/service :action :restart)
                        (postgres/create-database "circleci")
                        ;;users
                        (user/user "circle"
                                   :action :create
                                   :shell :bash
                                   :create-home true
                                   :groups #{"circle"})
                        (directory/directory "/home/circle/.ssh/"
                                             :create :action
                                             :path true
                                             :owner "circle"
                                             :group "circle")
                        (ssh-key/install-key "circle"
                                             "id_rsa"
                                             (slurp "www.id_rsa")
                                             (slurp "www.id_rsa.pub"))
                        (ssh-key/authorize-key "circle"
                                               (slurp "www.id_rsa.pub"))
                        (pallet.crate.network-service/wait-for-port-listen 5432)
                        (lein/lein)
                        (remote-file/remote-file "/home/circle/.ssh/config" :content "Host github.com\n\tStrictHostKeyChecking no\n"
                                                 :owner "circle"
                                                 :group "circle"
                                                 :mode "644"))}))

(defn start
  "start a new circle instance"
  []
  (nodes/converge {circle-group 1}))

(defn stop
  "start a new circle instance"
  []
  (nodes/converge {circle-group 0}))

(ns circle.backend.nodes.circle
  (:require pallet.core
            pallet.phase
            [pallet.action.user :as user]
            [pallet.action.directory :as directory]
            [pallet.action.package :as package]
            [pallet.action.remote-file :as remote-file]
            [pallet.crate.automated-admin-user :as automated-admin-user]
            [pallet.crate.git :as git]
            [pallet.crate.lein :as lein]
            [pallet.crate.java :as java]
            [pallet.crate.ssh-key :as ssh-key]
            [pallet.crate.network-service :as network-service]
            [pallet.crate.postgres :as postgres]
            [pallet.crate.nginx :as nginx]
            [circle.backend.nodes :as nodes]))

;; The node configuration to build the circle box

(def circle-group
  (pallet.core/group-spec
   "circle"
   :node-spec (pallet.core/node-spec
               :hardware {:hardware-id "m1.small"} ;; require m1.small or larger right now, because of https://bugs.launchpad.net/ubuntu/+source/linux-ec2/+bug/634487
               :image {:os-family :ubuntu
                       :location-id "us-east-1"
                       :image-id "us-east-1/ami-06ad526f"}
               :network {:inbound-ports [22 80 8080]})
   :phases {:bootstrap (pallet.phase/phase-fn
                        (automated-admin-user/automated-admin-user))
            :configure (pallet.phase/phase-fn
                        (package/package-source "ubuntu-archive"
                                                ;; by default, EC2
                                                ;; ubuntu images only
                                                ;; use ubuntu mirrors
                                                ;; hosted on EC2,
                                                ;; which sometimes go
                                                ;; down. Add this as
                                                ;; another mirror for
                                                ;; reliability
                                                :aptitude {:url "http://us.archive.ubuntu.com/ubuntu/"
                                                           :scopes ["main" "natty-updates" "universe" "multiverse"]}) ;; TODO the natty is specific to 11.04, change later.
                        (package/packages :aptitude ["nginx"])
                        (java/java :sun :jdk)
                        (git/git)
                        ;; (nginx/nginx :version "1.1.5")
                        (nginx/site "circle"
                                    :listen 80
                                    :server_name "circle"
                                    :locations [{:location "/"
                                                 :proxy_pass "http://localhost:8080"
                                                 :proxy_headers {"X-Real-IP" "\\$remote_addr"
                                                                 "X-Forwarded-For" "\\$proxy_add_x_forwarded_for"
                                                                 "Host" "\\$http_host"}}])
                        (nginx/site "default" :action :disable)
                        (postgres/settings (postgres/settings-map {:version "8.4"
                                                                   :permissions [{:connection-type "local" :database "all" :user "all" :auth-method "trust"}
                                                                                {:connection-type "host" :database "all" :user "all" :ip-mask "127.0.0.1/32" :auth-method "trust"}
                                                                                {:connection-type "host" :database "all" :user "all" :ip-mask "::1/128" :auth-method "trust"}]}))

                        (postgres/postgres)
                        (postgres/initdb)
                        (postgres/hba-conf)
                        (postgres/service :action :restart)
                        (postgres/create-database "circleci")
                        ;;users
                        (user/user "circle"
                                   :action :create
                                   :shell :bash
                                   :create-home true
                                   :groups #{"circle"})
                        (directory/directory "/home/circle/.ssh/"
                                             :create :action
                                             :path true
                                             :owner "circle"
                                             :group "circle")
                        (ssh-key/install-key "circle"
                                             "id_rsa"
                                             (slurp "www.id_rsa")
                                             (slurp "www.id_rsa.pub"))
                        (ssh-key/authorize-key "circle"
                                               (slurp "www.id_rsa.pub"))
                        (pallet.crate.network-service/wait-for-port-listen 5432)
                        (lein/lein)
                        (remote-file/remote-file "/home/circle/.ssh/config" :content "Host github.com\n\tStrictHostKeyChecking no\n"
                                                 :owner "circle"
                                                 :group "circle"
                                                 :mode "644"))}))

(defn start
  "start a new circle instance"
  []
  (nodes/converge {circle-group 1}))

(defn stop
  "start a new circle instance"
  []
  (nodes/converge {circle-group 0}))

Add nginx to the box, have it proxy for jetty


(ns asciinema-player.view
  (:require [clojure.string :as string]
            [asciinema-player.util :as util]
            [asciinema-player.fullscreen :as fullscreen]))

(defn fg-color [fg bold?]
  (if (and fg bold? (< fg 8)) (+ fg 8) fg))

(defn bg-color [bg blink?]
  (if (and bg blink? (< bg 8)) (+ bg 8) bg))

(defn part-class-name [{:keys [fg bg bold blink underline inverse cursor]}]
  (let [fg (fg-color fg bold)
        bg (bg-color bg blink)
        final-fg (if inverse (or bg "bg") fg)
        final-bg (if inverse (or fg "fg") bg)
        fg-class (if final-fg (str "fg-" final-fg))
        bg-class (if final-bg (str "bg-" final-bg))
        bold-class (if bold "bright")
        underline-class (if underline "underline")
        cursor-class (when cursor "cursor")
        classes (remove nil? [fg-class bg-class bold-class underline-class cursor-class])]
    (string/join " " classes)))

(defn part [p]
  [:span {:class-name (part-class-name (last p))} (first p)])

(defn line [parts]
  [:span.line (map-indexed (fn [idx p] ^{:key idx} [part p]) parts)])

(defn terminal-class-name [font-size]
  (str "font-" font-size))

(defn split-part-with-cursor [[text attrs] position]
  (let [left-chars (take position text)
        left-part (if (seq left-chars) [(apply str left-chars) attrs])
        center-part [(nth text position) (assoc attrs :cursor true)]
        right-chars (drop (inc position) text)
        right-part (if (seq right-chars) [(apply str right-chars) attrs])]
    (remove nil? (vector left-part center-part right-part))))

(defn insert-cursor [parts cursor-x]
  (loop [left [] right parts idx cursor-x]
    (let [[text attrs :as part] (first right)
          len (count text)]
      (if (<= len idx)
        (recur (conj left part) (rest right) (- idx len))
        (concat left (split-part-with-cursor part idx) (rest right))))))

(defn terminal [font-size lines {cursor-x :x cursor-y :y cursor-visible :visible}]
  [:pre.asciinema-terminal {:class-name (terminal-class-name font-size)}
   (map (fn [[idx parts]]
          (let [cursor-x (when (and cursor-visible (= idx cursor-y)) cursor-x)
                parts (if cursor-x (insert-cursor parts cursor-x) parts)]
            ^{:key idx} [line parts]))
        lines)])

(def logo-raw-svg "<defs> <mask id=\"small-triangle-mask\"> <rect width=\"100%\" height=\"100%\" fill=\"white\"/> <polygon points=\"508.01270189221935 433.01270189221935, 208.0127018922194 259.8076211353316, 208.01270189221927 606.217782649107\" fill=\"black\"></polygon> </mask> </defs> <polygon points=\"808.0127018922194 433.01270189221935, 58.01270189221947 -1.1368683772161603e-13, 58.01270189221913 866.0254037844386\" mask=\"url(#small-triangle-mask)\" fill=\"white\"></polygon> <polyline points=\"481.2177826491071 333.0127018922194, 134.80762113533166 533.0127018922194\" stroke=\"white\" stroke-width=\"90\"></polyline>")

(defn logo-play-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 866.0254037844387 866.0254037844387" :class-name "icon" :dangerouslySetInnerHTML {:__html logo-raw-svg}}])

(defn play-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M1,0 L11,6 L1,12 Z"}]])

(defn pause-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M1,0 L4,0 L4,12 L1,12 Z"}]
    [:path {:d "M8,0 L11,0 L11,12 L8,12 Z"}]])

(defn expand-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M12,0 L7,0 L9,2 L7,4 L8,5 L10,3 L12,5 Z"}]
    [:path {:d "M0,12 L0,7 L2,9 L4,7 L5,8 L3,10 L5,12 Z"}]])

(defn shrink-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M7,5 L7,0 L9,2 L11,0 L12,1 L10,3 L12,5 Z"}]
    [:path {:d "M5,7 L0,7 L2,9 L0,11 L1,12 L3,10 L5,12 Z"}]])

(defn playback-control-button [playing? dispatch]
  (let [on-click (fn [e]
                   (.preventDefault e)
                   (dispatch [:toggle-play]))]
    [:span.playback-button {:on-click on-click} [(if playing? pause-icon play-icon)]]))

(defn pad2 [number]
  (if (< number 10) (str "0" number) number))

(defn format-time [seconds]
  (let [m (.floor js/Math (/ seconds 60))
        s (.floor js/Math (mod seconds 60))]
    (str (pad2 m) ":" (pad2 s))))

(defn elapsed-time [current-time]
  (format-time current-time))

(defn remaining-time [current-time total-time]
  (str "-" (format-time (- total-time current-time))))

(defn timer [current-time total-time]
  [:span.timer
    [:span.time-elapsed (elapsed-time current-time)]
    [:span.time-remaining (remaining-time current-time total-time)]])

(defn fullscreen-toggle-button []
  (let [on-click (fn [e]
                   (.preventDefault e)
                   (fullscreen/toggle (-> e .-currentTarget .-parentNode .-parentNode .-parentNode)))]
    [:span.fullscreen-button {:on-click on-click} [expand-icon] [shrink-icon]]))

(defn element-local-mouse-x [e]
  (let [rect (-> e .-currentTarget .getBoundingClientRect)]
    (- (.-clientX e) (.-left rect))))

(defn progress-bar [progress dispatch]
  (let [on-mouse-down (fn [e]
                        (.preventDefault e)
                        (let [bar-width (-> e .-currentTarget .-offsetWidth)
                              mouse-x (util/adjust-to-range (element-local-mouse-x e) 0 bar-width)
                              position (/ mouse-x bar-width)]
                          (dispatch [:seek position])))]
    [:span.progressbar
      [:span.bar {:on-mouse-down on-mouse-down}
        [:span.gutter
          [:span {:style {:width (str (* 100 progress) "%")}}]]]]))

(defn control-bar [playing? current-time total-time dispatch]
  [:div.control-bar
    [playback-control-button playing? dispatch]
    [timer current-time total-time]
    [fullscreen-toggle-button]
    [progress-bar (/ current-time total-time) dispatch]])

(defn start-overlay [dispatch]
  (let [on-click (fn [e]
                   (.preventDefault e)
                   (dispatch [:toggle-play]))]
    [:div.start-prompt {:on-click on-click}
      [:div.play-button
        [:div
          [:span
            [logo-play-icon]]]]]))

(defn loading-overlay []
  [:div.loading
    [:div.loader]])

(defn player-class-name [theme-name]
  (str "asciinema-theme-" (or theme-name "tango")))

(defn player-style [] {})

(defn handle-dom-event [dispatch event-mapper dom-event]
  (when-let [[event-name & _ :as event] (event-mapper dom-event)]
    (.preventDefault dom-event)
    (if (= event-name :toggle-fullscreen) ; has to be processed synchronously
      (fullscreen/toggle (.-currentTarget dom-event))
      (dispatch event))))

(defn key-press->event [dom-event]
  (case (.-key dom-event)
    " " [:toggle-play]
    "f" [:toggle-fullscreen]
    "0" [:seek 0.0]
    "1" [:seek 0.1]
    "2" [:seek 0.2]
    "3" [:seek 0.3]
    "4" [:seek 0.4]
    "5" [:seek 0.5]
    "6" [:seek 0.6]
    "7" [:seek 0.7]
    "8" [:seek 0.8]
    "9" [:seek 0.9]
    ">" [:speed-up]
    "<" [:speed-down]
    nil))

(defn key-down->event [dom-event]
  (case (.-which dom-event)
    37 [:rewind]
    39 [:fast-forward]
    nil))

(defn player [state dispatch]
  (let [{:keys [font-size theme lines cursor stop current-time duration loading frames]} @state
        on-key-press (partial handle-dom-event dispatch key-press->event)
        on-key-down (partial handle-dom-event dispatch key-down->event)
        class-name (player-class-name theme)
        playing? (boolean stop)]
    [:div.asciinema-player-wrapper {:tab-index -1 :on-key-press on-key-press :on-key-down on-key-down}
      [:div.asciinema-player {:class-name class-name :style (player-style)}
        [terminal font-size lines cursor]
        [control-bar playing? current-time duration dispatch]
        (when-not (or loading frames) [start-overlay dispatch])
        (when loading [loading-overlay])]]))

(ns asciinema-player.view
  (:require [clojure.string :as string]
            [asciinema-player.util :as util]
            [asciinema-player.fullscreen :as fullscreen]))

(defn fg-color [fg bold?]
  (if (and fg bold? (< fg 8)) (+ fg 8) fg))

(defn bg-color [bg blink?]
  (if (and bg blink? (< bg 8)) (+ bg 8) bg))

(defn part-class-name [{:keys [fg bg bold blink underline inverse cursor]}]
  (let [fg (fg-color fg bold)
        bg (bg-color bg blink)
        final-fg (if inverse (or bg "bg") fg)
        final-bg (if inverse (or fg "fg") bg)
        fg-class (if final-fg (str "fg-" final-fg))
        bg-class (if final-bg (str "bg-" final-bg))
        bold-class (when bold "bright")
        underline-class (when underline "underline")
        cursor-class (when cursor "cursor")
        classes (remove nil? [fg-class bg-class bold-class underline-class cursor-class])]
    (string/join " " classes)))

(defn part [p]
  [:span {:class-name (part-class-name (last p))} (first p)])

(defn line [parts]
  [:span.line (map-indexed (fn [idx p] ^{:key idx} [part p]) parts)])

(defn terminal-class-name [font-size]
  (str "font-" font-size))

(defn split-part-with-cursor [[text attrs] position]
  (let [left-chars (take position text)
        left-part (if (seq left-chars) [(apply str left-chars) attrs])
        center-part [(nth text position) (assoc attrs :cursor true)]
        right-chars (drop (inc position) text)
        right-part (if (seq right-chars) [(apply str right-chars) attrs])]
    (remove nil? (vector left-part center-part right-part))))

(defn insert-cursor [parts cursor-x]
  (loop [left [] right parts idx cursor-x]
    (let [[text attrs :as part] (first right)
          len (count text)]
      (if (<= len idx)
        (recur (conj left part) (rest right) (- idx len))
        (concat left (split-part-with-cursor part idx) (rest right))))))

(defn terminal [font-size lines {cursor-x :x cursor-y :y cursor-visible :visible}]
  [:pre.asciinema-terminal {:class-name (terminal-class-name font-size)}
   (map (fn [[idx parts]]
          (let [cursor-x (when (and cursor-visible (= idx cursor-y)) cursor-x)
                parts (if cursor-x (insert-cursor parts cursor-x) parts)]
            ^{:key idx} [line parts]))
        lines)])

(def logo-raw-svg "<defs> <mask id=\"small-triangle-mask\"> <rect width=\"100%\" height=\"100%\" fill=\"white\"/> <polygon points=\"508.01270189221935 433.01270189221935, 208.0127018922194 259.8076211353316, 208.01270189221927 606.217782649107\" fill=\"black\"></polygon> </mask> </defs> <polygon points=\"808.0127018922194 433.01270189221935, 58.01270189221947 -1.1368683772161603e-13, 58.01270189221913 866.0254037844386\" mask=\"url(#small-triangle-mask)\" fill=\"white\"></polygon> <polyline points=\"481.2177826491071 333.0127018922194, 134.80762113533166 533.0127018922194\" stroke=\"white\" stroke-width=\"90\"></polyline>")

(defn logo-play-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 866.0254037844387 866.0254037844387" :class-name "icon" :dangerouslySetInnerHTML {:__html logo-raw-svg}}])

(defn play-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M1,0 L11,6 L1,12 Z"}]])

(defn pause-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M1,0 L4,0 L4,12 L1,12 Z"}]
    [:path {:d "M8,0 L11,0 L11,12 L8,12 Z"}]])

(defn expand-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M12,0 L7,0 L9,2 L7,4 L8,5 L10,3 L12,5 Z"}]
    [:path {:d "M0,12 L0,7 L2,9 L4,7 L5,8 L3,10 L5,12 Z"}]])

(defn shrink-icon []
  [:svg {:version "1.1" :xmlns "http://www.w3.org/2000/svg" :view-box "0 0 12 12" :class-name "icon"}
    [:path {:d "M7,5 L7,0 L9,2 L11,0 L12,1 L10,3 L12,5 Z"}]
    [:path {:d "M5,7 L0,7 L2,9 L0,11 L1,12 L3,10 L5,12 Z"}]])

(defn playback-control-button [playing? dispatch]
  (let [on-click (fn [e]
                   (.preventDefault e)
                   (dispatch [:toggle-play]))]
    [:span.playback-button {:on-click on-click} [(if playing? pause-icon play-icon)]]))

(defn pad2 [number]
  (if (< number 10) (str "0" number) number))

(defn format-time [seconds]
  (let [m (.floor js/Math (/ seconds 60))
        s (.floor js/Math (mod seconds 60))]
    (str (pad2 m) ":" (pad2 s))))

(defn elapsed-time [current-time]
  (format-time current-time))

(defn remaining-time [current-time total-time]
  (str "-" (format-time (- total-time current-time))))

(defn timer [current-time total-time]
  [:span.timer
    [:span.time-elapsed (elapsed-time current-time)]
    [:span.time-remaining (remaining-time current-time total-time)]])

(defn fullscreen-toggle-button []
  (let [on-click (fn [e]
                   (.preventDefault e)
                   (fullscreen/toggle (-> e .-currentTarget .-parentNode .-parentNode .-parentNode)))]
    [:span.fullscreen-button {:on-click on-click} [expand-icon] [shrink-icon]]))

(defn element-local-mouse-x [e]
  (let [rect (-> e .-currentTarget .getBoundingClientRect)]
    (- (.-clientX e) (.-left rect))))

(defn progress-bar [progress dispatch]
  (let [on-mouse-down (fn [e]
                        (.preventDefault e)
                        (let [bar-width (-> e .-currentTarget .-offsetWidth)
                              mouse-x (util/adjust-to-range (element-local-mouse-x e) 0 bar-width)
                              position (/ mouse-x bar-width)]
                          (dispatch [:seek position])))]
    [:span.progressbar
      [:span.bar {:on-mouse-down on-mouse-down}
        [:span.gutter
          [:span {:style {:width (str (* 100 progress) "%")}}]]]]))

(defn control-bar [playing? current-time total-time dispatch]
  [:div.control-bar
    [playback-control-button playing? dispatch]
    [timer current-time total-time]
    [fullscreen-toggle-button]
    [progress-bar (/ current-time total-time) dispatch]])

(defn start-overlay [dispatch]
  (let [on-click (fn [e]
                   (.preventDefault e)
                   (dispatch [:toggle-play]))]
    [:div.start-prompt {:on-click on-click}
      [:div.play-button
        [:div
          [:span
            [logo-play-icon]]]]]))

(defn loading-overlay []
  [:div.loading
    [:div.loader]])

(defn player-class-name [theme-name]
  (str "asciinema-theme-" (or theme-name "tango")))

(defn player-style [] {})

(defn handle-dom-event [dispatch event-mapper dom-event]
  (when-let [[event-name & _ :as event] (event-mapper dom-event)]
    (.preventDefault dom-event)
    (if (= event-name :toggle-fullscreen) ; has to be processed synchronously
      (fullscreen/toggle (.-currentTarget dom-event))
      (dispatch event))))

(defn key-press->event [dom-event]
  (case (.-key dom-event)
    " " [:toggle-play]
    "f" [:toggle-fullscreen]
    "0" [:seek 0.0]
    "1" [:seek 0.1]
    "2" [:seek 0.2]
    "3" [:seek 0.3]
    "4" [:seek 0.4]
    "5" [:seek 0.5]
    "6" [:seek 0.6]
    "7" [:seek 0.7]
    "8" [:seek 0.8]
    "9" [:seek 0.9]
    ">" [:speed-up]
    "<" [:speed-down]
    nil))

(defn key-down->event [dom-event]
  (case (.-which dom-event)
    37 [:rewind]
    39 [:fast-forward]
    nil))

(defn player [state dispatch]
  (let [{:keys [font-size theme lines cursor stop current-time duration loading frames]} @state
        on-key-press (partial handle-dom-event dispatch key-press->event)
        on-key-down (partial handle-dom-event dispatch key-down->event)
        class-name (player-class-name theme)
        playing? (boolean stop)]
    [:div.asciinema-player-wrapper {:tab-index -1 :on-key-press on-key-press :on-key-down on-key-down}
      [:div.asciinema-player {:class-name class-name :style (player-style)}
        [terminal font-size lines cursor]
        [control-bar playing? current-time duration dispatch]
        (when-not (or loading frames) [start-overlay dispatch])
        (when loading [loading-overlay])]]))

Use "when" when appropriate

Use "when" when appropriate


(ns circle.workers.test-github
  (:use circle.backend.build.test-utils)
  (:require [circle.model.build :as build])
  (:use [circle.util.mongo])
  (:require [somnium.congomongo :as mongo])
  (:use midje.sweet)
  (:use circle.workers.github))

(test-ns-setup)

(fact "start-build-from-hook works with dummy project"
  (let [json circle-dummy-project-json-str
        build (start-build-from-hook nil nil nil json)]
    (-> @build :vcs_url) => truthy
    (-> build (build/successful?)) => true
    (-> @build :build_num) => integer?))

(fact "builds started from the hook have a start time"
  ;; this test added because of production failure, 2012/02/10
  (let [json circle-dummy-project-json-str
        build (start-build-from-hook nil nil nil json)
        build-row (mongo/fetch-one :builds :where {:_id (-> @build :_id)})]
    (-> @build :start_time) => truthy
    build-row => truthy
    (-> build-row :start_time) => truthy))

(fact "authorization-url works"
  (-> "http://localhost:3000/hooks/repos" authorization-url) =>
  "https://github.com/login/oauth/authorize?client_id=586bf699b48f69a09d8c&scope=repo&redirect_uri=http%3A%2F%2Flocalhost%3A3000%2Fhooks%2Frepos"
  (provided (circle.env/env) => :test))

(ns circle.workers.test-github
  (:use circle.backend.build.test-utils)
  (:require [circle.model.build :as build])
  (:use [circle.util.mongo])
  (:require [somnium.congomongo :as mongo])
  (:use midje.sweet)
  (:use circle.workers.github))

(test-ns-setup)

(fact "start-build-from-hook works with dummy project"
  (let [json circle-dummy-project-json-str
        build (start-build-from-hook json)]
    (-> @build :vcs_url) => truthy
    (-> build (build/successful?)) => true
    (-> @build :build_num) => integer?))

(fact "builds started from the hook have a start time"
  ;; this test added because of production failure, 2012/02/10
  (let [json circle-dummy-project-json-str
        build (start-build-from-hook json)
        build-row (mongo/fetch-one :builds :where {:_id (-> @build :_id)})]
    (-> @build :start_time) => truthy
    build-row => truthy
    (-> build-row :start_time) => truthy))

(fact "authorization-url works"
  (-> "http://localhost:3000/hooks/repos" authorization-url) =>
  "https://github.com/login/oauth/authorize?client_id=586bf699b48f69a09d8c&scope=repo&redirect_uri=http%3A%2F%2Flocalhost%3A3000%2Fhooks%2Frepos"
  (provided (circle.env/env) => :test))

Update the test to match the new signature


(ns ^:figwheel-always triboard.core-test
  (:require-macros
    [cljs.test :refer (is deftest testing)]
    [clojure.test.check.clojure-test :refer [defspec]]
    )
  (:require
    [cljs.spec :as s]
    [cljs.spec.test :as stest :include-macros true]
    ;;[cljs.spec.impl.gen :as sgen]
    [cljs.test :as test]
    [clojure.test.check :as tc]
    [clojure.test.check.generators :as gen]
    [clojure.test.check.properties :as prop :include-macros true]
    [triboard.logic.constants :as cst]
    [triboard.logic.board :as board]
    [triboard.logic.game :as game]
    [triboard.logic.move :as move]
    [triboard.logic.player :as player]
    [triboard.logic.scores :as scores]
    [triboard.logic.turn :as turn]
    ))

;; ----------------------------------------------------------------------------
;; Utils
;; ----------------------------------------------------------------------------

(defn play-moves
  [init-game moves]
  (reduce game/play-move init-game moves))

(defn current-score
  [game]
  (:scores (game/current-turn game)))

(defn sum-player-scores
  [score]
  (transduce (map second) + score))

(defn check-spec-test
  [spec-res]
  (let [res (stest/summarize-results spec-res)]
    (= (:total res) (:check-passed res))))

;; ----------------------------------------------------------------------------
;; Example based tests
;; ----------------------------------------------------------------------------

(deftest example-passing-test
  (testing "trivial assumption"
    (is (= 1 1))))

;; ----------------------------------------------------------------------------
;; Generators
;; ----------------------------------------------------------------------------

(def coord-gen (s/gen ::board/coord))

(def initial-empty-cell-count
  (- (* cst/board-width cst/board-height) (* 4 cst/init-block-count)))

(def game-gen
  (gen/fmap
    (fn [coord] (play-moves (game/new-game) coord))
    (gen/vector coord-gen 0 initial-empty-cell-count)))

;; ----------------------------------------------------------------------------
;; BOARD
;; ----------------------------------------------------------------------------

(deftest test-pick-n-cells-for-each-player
  (let [elements (range 1 100)]
    (testing "Pick 2 elements for each player"
      (is (=
            [[1 :blue] [2 :blue] [3 :red] [4 :red]
             [5 :green] [6 :green] [7 :wall] [8 :wall]]
            (vec (board/pick-n-cells-for-each-player 2 elements))))
      )))

;; ----------------------------------------------------------------------------
;; SCORE
;; ----------------------------------------------------------------------------

(deftest score-todo-test
  (testing "trivial assumption"
    (is (= 1 1))))

(defn prop-update-score
  [score conversion]
  (=
    (scores/update-scores score conversion)
    (scores/update-scores-with score conversion (constantly 1))
    ))

(defspec test-prop-update-score 100
  (prop/for-all [score (s/gen ::scores/scores)
                 conversion (s/gen ::move/conversion)]
    (prop-update-score score conversion)))

;; ----------------------------------------------------------------------------
;; Property based tests
;; ----------------------------------------------------------------------------

#_(
    (deftest board-test
      (is (check-spec-test (stest/check `board/empty-cells)))
      (is (check-spec-test (stest/check `board/to-iterable))))

    (deftest scores-test
      (is (check-spec-test (stest/check `scores/update-scores))))

    (deftest move-test
      (is (check-spec-test (stest/check `move/all-available-moves)))
      (is (check-spec-test (stest/check `move/apply-conversion))))
    )

(defn valid-game-transition?
  [old-game new-game move]
  (let [old-scores (current-score old-game)
        new-scores (current-score new-game)]
    (and
      (= (sum-player-scores old-scores) (- (sum-player-scores new-scores) 1))
      )))

(defn game-move-properties
  [old-game]
  (prop/for-all [coord coord-gen]
    (let [new-game (game/play-move old-game coord)]
      (or
        (= old-game new-game)                               ;; TODO - test contained in empty cells
        (valid-game-transition? old-game new-game coord)
        ))))

(defn game-undo-properties
  [old-game]
  (prop/for-all [coord coord-gen]
    (let [new-game (game/play-move old-game coord)]
      (or
        (= old-game new-game)
        (= old-game (game/undo-player-move new-game (fn [_] false)))
        ))))

(defspec try-move-from-valid-game 100
  (prop/for-all [g game-gen] (game-move-properties g)))

(defspec try-undo-from-valid-game 100
  (prop/for-all [g game-gen] (game-undo-properties g)))

;; ----------------------------------------------------------------------------
;; Running the tests
;; ----------------------------------------------------------------------------

;; To run full instrumented tests
;; (require '[cljs.spec.test])
;; (cljs.spec.test/instrument)
;; (cljs.spec.test/unstrument)

(test/run-tests)

(ns ^:figwheel-always triboard.core-test
  (:require-macros
    [cljs.test :refer (is deftest testing)]
    [clojure.test.check.clojure-test :refer [defspec]]
    )
  (:require
    [cljs.spec :as s]
    [cljs.spec.test :as stest :include-macros true]
    ;;[cljs.spec.impl.gen :as sgen]
    [cljs.test :as test]
    [clojure.test.check :as tc]
    [clojure.test.check.generators :as gen]
    [clojure.test.check.properties :as prop :include-macros true]
    [triboard.logic.constants :as cst]
    [triboard.logic.board :as board]
    [triboard.logic.game :as game]
    [triboard.logic.move :as move]
    [triboard.logic.player :as player]
    [triboard.logic.scores :as scores]
    [triboard.logic.turn :as turn]
    ))

;; ----------------------------------------------------------------------------
;; Utils
;; ----------------------------------------------------------------------------

(defn play-moves
  [init-game moves]
  (reduce game/play-move init-game moves))

(defn current-score
  [game]
  (:scores (game/current-turn game)))

(defn sum-player-scores
  [score]
  (transduce (map second) + score))

(defn check-spec-test
  [spec-res]
  (let [res (stest/summarize-results spec-res)]
    (= (:total res) (:check-passed res))))

;; ----------------------------------------------------------------------------
;; Example based tests
;; ----------------------------------------------------------------------------

(deftest example-passing-test
  (testing "trivial assumption"
    (is (= 1 1))))

;; ----------------------------------------------------------------------------
;; Generators
;; ----------------------------------------------------------------------------

(def coord-gen (s/gen ::board/coord))

(def initial-empty-cell-count
  (- (* cst/board-width cst/board-height) (* 4 cst/init-block-count)))

(def game-gen
  (gen/fmap
    (fn [coord] (play-moves (game/new-game) coord))
    (gen/vector coord-gen 0 initial-empty-cell-count)))

;; ----------------------------------------------------------------------------
;; BOARD
;; ----------------------------------------------------------------------------

(deftest test-pick-n-cells-for-each-player
  (let [elements (range 1 100)]
    (testing "Pick 2 elements for each player"
      (is (=
            [[1 :blue] [2 :blue] [3 :red] [4 :red]
             [5 :green] [6 :green] [7 :wall] [8 :wall]]
            (vec (board/pick-n-cells-for-each-player 2 elements))))
      )))

;; ----------------------------------------------------------------------------
;; SCORE
;; ----------------------------------------------------------------------------

(deftest score-todo-test
  (testing "trivial assumption"
    (is (= 1 1))))

;; ----------------------------------------------------------------------------
;; Property based tests
;; ----------------------------------------------------------------------------

#_(
    (deftest board-test
      (is (check-spec-test (stest/check `board/empty-cells)))
      (is (check-spec-test (stest/check `board/to-iterable))))

    (deftest scores-test
      (is (check-spec-test (stest/check `scores/update-scores))))

    (deftest move-test
      (is (check-spec-test (stest/check `move/all-available-moves)))
      (is (check-spec-test (stest/check `move/apply-conversion))))
    )

(defn valid-game-transition?
  [old-game new-game move]
  (let [old-scores (current-score old-game)
        new-scores (current-score new-game)]
    (and
      (= (sum-player-scores old-scores) (- (sum-player-scores new-scores) 1))
      )))

(defn game-move-properties
  [old-game]
  (prop/for-all [coord coord-gen]
    (let [new-game (game/play-move old-game coord)]
      (or
        (= old-game new-game)                               ;; TODO - test contained in empty cells
        (valid-game-transition? old-game new-game coord)
        ))))

(defn game-undo-properties
  [old-game]
  (prop/for-all [coord coord-gen]
    (let [new-game (game/play-move old-game coord)]
      (or
        (= old-game new-game)
        (= old-game (game/undo-player-move new-game (fn [_] false)))
        ))))

(defspec try-move-from-valid-game 100
  (prop/for-all [g game-gen] (game-move-properties g)))

(defspec try-undo-from-valid-game 100
  (prop/for-all [g game-gen] (game-undo-properties g)))

;; ----------------------------------------------------------------------------
;; Running the tests
;; ----------------------------------------------------------------------------

;; To run full instrumented tests
;; (require '[cljs.spec.test])
;; (cljs.spec.test/instrument)
;; (cljs.spec.test/unstrument)

(test/run-tests)

remove useless test

remove useless test


(ns docker-clojure.core-test
  (:require [clojure.test :refer :all]
            [docker-clojure.core :refer :all]
            [clojure.string :as str]))

(deftest default-distro-test
  (testing "jdk-version 8 gets stretch"
    (is (= "stretch" (default-distro 8))))
  (testing "jdk-version 11 gets stretch"
    (is (= "stretch" (default-distro 11))))
  (testing "other versions get slim-buster"
    (is (= "slim-buster" (default-distro 12)))
    (is (= "slim-buster" (default-distro 13)))
    (is (= "slim-buster" (default-distro 14)))))

(deftest image-variants-test
  (testing "generates the expected set of variants"
    (let [variants (image-variants #{8 11 13 14}
                                   #{"stretch" "slim-buster" "alpine"}
                                   {"lein"       "2.9.1"
                                    "boot"       "2.8.3"
                                    "tools-deps" "1.10.1.469"})]
      (is (contains? variants
                     {:jdk-version 11, :distro "slim-buster", :build-tool "lein"
                      :base-image "openjdk:11-slim-buster"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "lein-2.9.1-slim-buster", :build-tool-version "2.9.1"}))
      (is (contains? variants
                     {:jdk-version 11, :distro "slim-buster", :build-tool "boot"
                      :base-image "openjdk:11-slim-buster"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "boot-2.8.3-slim-buster", :build-tool-version "2.8.3"}))
      (is (contains? variants
                     {:jdk-version 11, :distro "slim-buster"
                      :base-image "openjdk:11-slim-buster"
                      :build-tool "tools-deps"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "tools-deps-1.10.1.469-slim-buster"
                      :build-tool-version "1.10.1.469"}))
      (is (contains? variants
                     {:jdk-version 11, :distro "stretch", :build-tool "lein"
                      :base-image "openjdk:11-stretch"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "lein-2.9.1", :build-tool-version "2.9.1"}))
      (is (contains? variants
                     {:jdk-version 11, :distro "stretch", :build-tool "boot"
                      :base-image "openjdk:11-stretch"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "boot-2.8.3", :build-tool-version "2.8.3"}))
      (is (contains? variants
                     {:jdk-version 11, :distro "stretch"
                      :base-image "openjdk:11-stretch"
                      :build-tool "tools-deps"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "tools-deps-1.10.1.469"
                      :build-tool-version "1.10.1.469"}))
      (is (contains? variants
                     {:jdk-version 8, :distro "slim-buster", :build-tool "lein"
                      :base-image "openjdk:8-slim-buster"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-8-lein-2.9.1-slim-buster", :build-tool-version "2.9.1"}))
      (is (contains? variants
                     {:jdk-version 8, :distro "slim-buster", :build-tool "boot"
                      :base-image "openjdk:8-slim-buster"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-8-boot-2.8.3-slim-buster", :build-tool-version "2.8.3"}))
      (is (contains? variants
                     {:jdk-version 8, :distro "slim-buster"
                      :build-tool "tools-deps"
                      :base-image "openjdk:8-slim-buster"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-8-tools-deps-1.10.1.469-slim-buster"
                      :build-tool-version "1.10.1.469"}))
      (is (contains? variants
                     {:jdk-version 13, :distro "slim-buster", :build-tool "lein"
                      :base-image "openjdk:13-slim-buster"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-13-lein-2.9.1"
                      :build-tool-version "2.9.1"}))
      (is (contains? variants
                     {:jdk-version 14, :distro "alpine", :build-tool "lein"
                      :base-image "openjdk:14-alpine"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-14-lein-2.9.1-alpine"
                      :build-tool-version "2.9.1"}))
      (is (contains? variants
                     {:jdk-version 14, :distro "alpine", :build-tool "boot"
                      :base-image "openjdk:14-alpine"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-14-boot-2.8.3-alpine"
                      :build-tool-version "2.8.3"}))
      (is (contains? variants
                     {:jdk-version 14, :distro "alpine"
                      :base-image "openjdk:14-alpine"
                      :build-tool "tools-deps"
                      :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                      :docker-tag "openjdk-14-tools-deps-1.10.1.469-alpine"
                      :build-tool-version "1.10.1.469"})))))

(deftest variant-map-test
  (testing "returns the expected map version of the image variant list"
    (with-redefs [build-tools {"build-tool" "1.2.3"}]
      (is (= {:jdk-version        8
              :base-image         "openjdk:8-distro"
              :distro             "distro"
              :build-tool         "build-tool"
              :docker-tag         "openjdk-8-build-tool-1.2.3-distro"
              :build-tool-version "1.2.3"
              :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"}
             (variant-map '(8 "distro" "build-tool")))))))

(deftest exclude?-test
  (testing "excludes variant that matches all key-values in any exclusion"
    (is (exclude? #{{:base-image "bad"}
                    {:base-image "not-great", :build-tool "woof"}}
                  {:base-image "not-great" :build-tool "woof"
                   :build-tool-version "1.2.3"})))
  (testing "does not exclude partial matches"
    (is (not (exclude? #{{:base-image "bad", :build-tool "woof"}}
                       {:base-image "bad", :build-tool "boot"})))))

(deftest docker-tag-test
  (testing "default java version is left out"
    (is (not (str/includes? (docker-tag {:jdk-version 11})
                            "openjdk-11"))))
  (testing "non-default version is added as a prefix"
    (is (str/starts-with? (docker-tag {:jdk-version 13})
                          "openjdk-13")))
  (testing "default distro is left out"
    (is (not (str/includes? (docker-tag {:jdk-version 13
                                         :distro "slim-buster"})
                            "slim-buster"))))
  (testing "alpine is added as a suffix"
    (is (str/ends-with? (docker-tag {:jdk-version 8
                                     :distro "alpine"})
                        "alpine")))
  (testing "build tool is included"
    (is (str/includes? (docker-tag {:jdk-version 11
                                    :build-tool "lein"})
                       "lein")))
  (testing "build tool version is included"
    (is (str/includes? (docker-tag {:jdk-version 11
                                    :build-tool "boot"
                                    :build-tool-version "2.8.1"})
                       "2.8.1"))))

(ns docker-clojure.core-test
  (:require [clojure.test :refer :all]
            [docker-clojure.core :refer :all]
            [clojure.string :as str]))

(deftest default-distro-test
  (testing "jdk-version 8 gets stretch"
    (is (= "stretch" (default-distro 8))))
  (testing "jdk-version 11 gets stretch"
    (is (= "stretch" (default-distro 11))))
  (testing "other versions get slim-buster"
    (is (= "slim-buster" (default-distro 12)))
    (is (= "slim-buster" (default-distro 13)))
    (is (= "slim-buster" (default-distro 14)))))

(deftest image-variants-test
  (testing "generates the expected set of variants"
    (let [variants (image-variants #{8 11 13 14}
                                   #{"stretch" "slim-buster" "alpine"}
                                   {"lein"       "2.9.1"
                                    "boot"       "2.8.3"
                                    "tools-deps" "1.10.1.469"})]
      (are [v] (contains? variants v)
            {:jdk-version 11, :distro "slim-buster", :build-tool "lein"
                 :base-image "openjdk:11-slim-buster"
                 :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                 :docker-tag "lein-2.9.1-slim-buster", :build-tool-version "2.9.1"}
            {:jdk-version 11, :distro "slim-buster", :build-tool "boot"
                :base-image "openjdk:11-slim-buster"
                :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                :docker-tag "boot-2.8.3-slim-buster", :build-tool-version "2.8.3"}
            {:jdk-version 11, :distro "slim-buster"
                :base-image "openjdk:11-slim-buster"
                :build-tool "tools-deps"
                :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                :docker-tag "tools-deps-1.10.1.469-slim-buster"
                :build-tool-version "1.10.1.469"}
            {:jdk-version 11, :distro "stretch", :build-tool "lein"
                :base-image "openjdk:11-stretch"
                :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                :docker-tag "lein-2.9.1", :build-tool-version "2.9.1"}
            {:jdk-version 11, :distro "stretch", :build-tool "boot"
                :base-image "openjdk:11-stretch"
                :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
                :docker-tag "boot-2.8.3", :build-tool-version "2.8.3"}
            {:jdk-version 11, :distro "stretch"
             :base-image "openjdk:11-stretch"
             :build-tool "tools-deps"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "tools-deps-1.10.1.469"
             :build-tool-version "1.10.1.469"}
            {:jdk-version 8, :distro "slim-buster", :build-tool "lein"
             :base-image "openjdk:8-slim-buster"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-8-lein-2.9.1-slim-buster", :build-tool-version "2.9.1"}
            {:jdk-version 8, :distro "slim-buster", :build-tool "boot"
             :base-image "openjdk:8-slim-buster"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-8-boot-2.8.3-slim-buster", :build-tool-version "2.8.3"}
            {:jdk-version 8, :distro "slim-buster"
             :build-tool "tools-deps"
             :base-image "openjdk:8-slim-buster"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-8-tools-deps-1.10.1.469-slim-buster"
             :build-tool-version "1.10.1.469"}
            {:jdk-version 13, :distro "slim-buster", :build-tool "lein"
             :base-image "openjdk:13-slim-buster"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-13-lein-2.9.1"
             :build-tool-version "2.9.1"}
            {:jdk-version 14, :distro "alpine", :build-tool "lein"
             :base-image "openjdk:14-alpine"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-14-lein-2.9.1-alpine"
             :build-tool-version "2.9.1"}
            {:jdk-version 14, :distro "alpine", :build-tool "boot"
             :base-image "openjdk:14-alpine"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-14-boot-2.8.3-alpine"
             :build-tool-version "2.8.3"}
            {:jdk-version 14, :distro "alpine"
             :base-image "openjdk:14-alpine"
             :build-tool "tools-deps"
             :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"
             :docker-tag "openjdk-14-tools-deps-1.10.1.469-alpine"
             :build-tool-version "1.10.1.469"}))))

(deftest variant-map-test
  (testing "returns the expected map version of the image variant list"
    (with-redefs [build-tools {"build-tool" "1.2.3"}]
      (is (= {:jdk-version        8
              :base-image         "openjdk:8-distro"
              :distro             "distro"
              :build-tool         "build-tool"
              :docker-tag         "openjdk-8-build-tool-1.2.3-distro"
              :build-tool-version "1.2.3"
              :maintainer "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>"}
             (variant-map '(8 "distro" "build-tool")))))))

(deftest exclude?-test
  (testing "excludes variant that matches all key-values in any exclusion"
    (is (exclude? #{{:base-image "bad"}
                    {:base-image "not-great", :build-tool "woof"}}
                  {:base-image "not-great" :build-tool "woof"
                   :build-tool-version "1.2.3"})))
  (testing "does not exclude partial matches"
    (is (not (exclude? #{{:base-image "bad", :build-tool "woof"}}
                       {:base-image "bad", :build-tool "boot"})))))

(deftest docker-tag-test
  (testing "default java version is left out"
    (is (not (str/includes? (docker-tag {:jdk-version 11})
                            "openjdk-11"))))
  (testing "non-default version is added as a prefix"
    (is (str/starts-with? (docker-tag {:jdk-version 13})
                          "openjdk-13")))
  (testing "default distro is left out"
    (is (not (str/includes? (docker-tag {:jdk-version 13
                                         :distro "slim-buster"})
                            "slim-buster"))))
  (testing "alpine is added as a suffix"
    (is (str/ends-with? (docker-tag {:jdk-version 8
                                     :distro "alpine"})
                        "alpine")))
  (testing "build tool is included"
    (is (str/includes? (docker-tag {:jdk-version 11
                                    :build-tool "lein"})
                       "lein")))
  (testing "build tool version is included"
    (is (str/includes? (docker-tag {:jdk-version 11
                                    :build-tool "boot"
                                    :build-tool-version "2.8.1"})
                       "2.8.1"))))

Use are for image-variants-test

Use are for image-variants-test


(ns clj-money.import.gnucash
  (:refer-clojure :exclude [update])
  (:require [clojure.java.io :as io]
            [clojure.pprint :refer [pprint]]
            [clojure.set :refer [rename-keys]]
            [clj-time.core :as t]
            [clj-xpath.core :refer :all]
            [clj-money.util :refer [pprint-and-return]]
            [clj-money.import :refer [read-source]])
  (:import java.util.zip.GZIPInputStream))

(defn- parse-date
  [string-date]
  (when-let [match (re-find #"^(\d{4})-(\d{2})-(\d{2})" string-date)]
    (apply t/local-date (->> match
                             rest
                             (map #(Integer. %))))))

(defn- parse-decimal
  [string-decimal]
  (when-let [match (re-find #"(\d+)\/(\d+)" string-decimal)]
    (apply / (->> match
                  rest
                  (map bigdec)))))

(def ^:private namespace-map
  {"gnc"        "http://www.gnucash.org/XML/gnc"
   "act"        "http://www.gnucash.org/XML/act"
   "trn"        "http://www.gnucash.org/XML/trn"
   "ts"         "http://www.gnucash.org/XML/ts"
   "split"      "http://www.gnucash.org/XML/split"
   "bgt"        "http://www.gnucash.org/XML/bgt"
   "recurrence" "http://www.gnucash.org/XML/recurrence"
   "slot"       "http://www.gnucash.org/XML/slot"
   "cd"         "http://www.gnucash.org/XML/cd"})

(defmulti process-node
  (fn [_ node]
    (:tag node)))

(defn- process-node-attribute
  [node result {:keys [attribute xpath transform-fn]}]
  (let [transform-fn (if transform-fn
                       transform-fn
                       identity)
        raw-value ($x:text? xpath node)
        value (transform-fn raw-value)]
    (assoc result attribute value)))

(defn- node->model
  [node attributes]
  (reduce (partial process-node-attribute node) {} attributes))

(def ^:private account-types-map
  {"ASSET"      :asset
   "BANK"       :asset
   "INCOME"     :income
   "EXPENSE"    :expense
   "LIABILITY"  :liability
   "CREDIT"     :liability})

(def ^:private account-attributes
  [{:attribute :name
    :xpath "act:name"}
   {:attribute :type
    :xpath "act:type"
    :transform-fn account-types-map}
   {:attribute :id
    :xpath "act:id"}
   {:attribute :parent-id
    :xpath "act:parent"}])

(def ^:private ignored-accounts #{"Assets" "Liabilities" "Equity" "Income" "Expenses"})

(defn- include-account?
  [account]
  (and (:type account)
       (not (ignored-accounts (:name account)))))

(defmethod process-node :gnc:account
  [callback node]
  (let [account (node->model node account-attributes)]
    (when (include-account? account)
      (callback account :account))))

(def ^:private budget-attributes
  [{:attribute :id
    :xpath "bgt:id"}
   {:attribute :name
    :xpath "bgt:name"}
   {:attribute :start-date
    :xpath "bgt:recurrence/recurrence:start/gdate"
    :transform-fn parse-date}
   {:attribute :period
    :xpath "bgt:recurrence/recurrence:period_type"
    :transform-fn keyword}
   {:attribute :period-count
    :xpath "bgt:num-periods"
    :transform-fn #(Integer. %)}])

(def ^:private budget-item-attributes
  [{:attribute :account-id
    :xpath "slot:key"}])

(def ^:private budget-item-period-attributes
  [{:attribute :index
    :xpath "slot:key"
    :transform-fn #(Integer. %)}
   {:attribute :amount
    :xpath "slot:value"
    :transform-fn parse-decimal}])

(defn- node->budget-item-period
  [node]
  (with-namespace-context namespace-map
    (node->model node budget-item-period-attributes)))

(defn- node->budget-item
  [node]
  (with-namespace-context namespace-map
    (-> node
        (node->model budget-item-attributes)
        (assoc :periods (->> node
                             ($x "slot:value/slot")
                             (map node->budget-item-period)
                             (into #{}))))))

(defmethod process-node :gnc:budget
  [callback node]
  (-> node
      (node->model budget-attributes)
      (assoc :items (map node->budget-item ($x "bgt:slots/slot" node)))
      (callback :budget)))

(defmethod process-node :gnc:count-data
  [callback node]
  (let [declaration {:record-type (keyword (-> node :attrs :cd:type))
                     :record-count (Integer. (:text node))}]
    (callback (cond-> declaration
                (= :account (:record-type declaration))
                (update-in [:record-count] #(- % 5)))
              :declaration)))

(def ^:private transaction-item-attributes
  [{:attribute :account-id
    :xpath "split:account"}
   {:attribute :reconciled
    :xpath "split:reconciled-state"
    :transform-fn #(= "y" %)}
   {:attribute :amount
    :xpath "split:value"
    :transform-fn parse-decimal}
   {:attribute :action
    :xpath "split:value"
    :transform-fn #(if (= \- (first %))
                     :credit
                     :debit)}])

(defn- node->transaction-item
  [node]
  ; I'm not sure why I need to add the namespace
  ; context again here
  (with-namespace-context namespace-map
    (node->model node transaction-item-attributes)))

(def ^:private transaction-attributes
  [{:attribute :id
    :xpath "trn:id"}
   {:attribute :transaction-date
    :xpath "trn:date-posted/ts:date"
    :transform-fn parse-date}
   {:attribute :description
    :xpath "trn:description"}])

(defn- node->transaction
  [node]
  (-> node
      (node->model transaction-attributes)
      (assoc :items (->> ($x "trn:splits/trn:split" node)
                         (map node->transaction-item)))))

(defmethod process-node :gnc:transaction
  [callback node]
  (callback (node->transaction node) :transaction))

(defmethod read-source :gnucash
  [_ input callback]
  (with-namespace-context namespace-map
    (let [xml (->> (GZIPInputStream. input)
                   io/reader
                   slurp
                   xml->doc)]
      (doseq [node ($x "/gnc-v2/gnc:book/gnc:count-data | /gnc-v2/gnc:book/gnc:account | /gnc-v2/gnc:book/gnc:transaction | /gnc-v2/gnc:book/gnc:budget" xml)]
        (process-node callback node)))))

(ns clj-money.import.gnucash
  (:refer-clojure :exclude [update])
  (:require [clojure.java.io :as io]
            [clojure.pprint :refer [pprint]]
            [clojure.set :refer [rename-keys]]
            [clojure.tools.logging :as log]
            [clj-time.core :as t]
            [clj-xpath.core :refer :all]
            [clj-money.util :refer [pprint-and-return]]
            [clj-money.import :refer [read-source]])
  (:import java.util.zip.GZIPInputStream))

(defn- parse-date
  [string-date]
  (when-let [match (re-find #"^(\d{4})-(\d{2})-(\d{2})" string-date)]
    (apply t/local-date (->> match
                             rest
                             (map #(Integer. %))))))

(defn- parse-decimal
  [string-decimal]
  (when-let [match (re-find #"(\d+)\/(\d+)" string-decimal)]
    (apply / (->> match
                  rest
                  (map bigdec)))))

(def ^:private namespace-map
  {"gnc"        "http://www.gnucash.org/XML/gnc"
   "act"        "http://www.gnucash.org/XML/act"
   "trn"        "http://www.gnucash.org/XML/trn"
   "ts"         "http://www.gnucash.org/XML/ts"
   "split"      "http://www.gnucash.org/XML/split"
   "bgt"        "http://www.gnucash.org/XML/bgt"
   "recurrence" "http://www.gnucash.org/XML/recurrence"
   "slot"       "http://www.gnucash.org/XML/slot"
   "cd"         "http://www.gnucash.org/XML/cd"})

(defmulti process-node
  (fn [_ node]
    (:tag node)))

(defn- process-node-attribute
  [node result {:keys [attribute xpath transform-fn]}]
  (let [transform-fn (if transform-fn
                       transform-fn
                       identity)
        raw-value ($x:text? xpath node)
        value (transform-fn raw-value)]
    (assoc result attribute value)))

(defn- node->model
  [node attributes]
  (reduce (partial process-node-attribute node) {} attributes))

(def ^:private account-types-map
  {"ASSET"      :asset
   "BANK"       :asset
   "INCOME"     :income
   "EXPENSE"    :expense
   "LIABILITY"  :liability
   "CREDIT"     :liability})

(def ^:private account-attributes
  [{:attribute :name
    :xpath "act:name"}
   {:attribute :type
    :xpath "act:type"
    :transform-fn #((get account-types-map % :equity))}
   {:attribute :id
    :xpath "act:id"}
   {:attribute :parent-id
    :xpath "act:parent"}])

(def ^:private ignored-accounts #{"Assets" "Liabilities" "Equity" "Income" "Expenses"})

(defn- include-account?
  [account]
  (not (ignored-accounts (:name account))))

(defmethod process-node :gnc:account
  [callback node]
  (let [account (node->model node account-attributes)]
    (if (include-account? account)
      (callback account :account)
      (log/debug "ignore account" account))))

(def ^:private budget-attributes
  [{:attribute :id
    :xpath "bgt:id"}
   {:attribute :name
    :xpath "bgt:name"}
   {:attribute :start-date
    :xpath "bgt:recurrence/recurrence:start/gdate"
    :transform-fn parse-date}
   {:attribute :period
    :xpath "bgt:recurrence/recurrence:period_type"
    :transform-fn keyword}
   {:attribute :period-count
    :xpath "bgt:num-periods"
    :transform-fn #(Integer. %)}])

(def ^:private budget-item-attributes
  [{:attribute :account-id
    :xpath "slot:key"}])

(def ^:private budget-item-period-attributes
  [{:attribute :index
    :xpath "slot:key"
    :transform-fn #(Integer. %)}
   {:attribute :amount
    :xpath "slot:value"
    :transform-fn parse-decimal}])

(defn- node->budget-item-period
  [node]
  (with-namespace-context namespace-map
    (node->model node budget-item-period-attributes)))

(defn- node->budget-item
  [node]
  (with-namespace-context namespace-map
    (-> node
        (node->model budget-item-attributes)
        (assoc :periods (->> node
                             ($x "slot:value/slot")
                             (map node->budget-item-period)
                             (into #{}))))))

(defmethod process-node :gnc:budget
  [callback node]
  (-> node
      (node->model budget-attributes)
      (assoc :items (map node->budget-item ($x "bgt:slots/slot" node)))
      (callback :budget)))

(defmethod process-node :gnc:count-data
  [callback node]
  (let [declaration {:record-type (keyword (-> node :attrs :cd:type))
                     :record-count (Integer. (:text node))}]
    (callback (cond-> declaration
                (= :account (:record-type declaration))
                (update-in [:record-count] #(- % 5)))
              :declaration)))

(def ^:private transaction-item-attributes
  [{:attribute :account-id
    :xpath "split:account"}
   {:attribute :reconciled
    :xpath "split:reconciled-state"
    :transform-fn #(= "y" %)}
   {:attribute :amount
    :xpath "split:value"
    :transform-fn parse-decimal}
   {:attribute :action
    :xpath "split:value"
    :transform-fn #(if (= \- (first %))
                     :credit
                     :debit)}])

(defn- node->transaction-item
  [node]
  ; I'm not sure why I need to add the namespace
  ; context again here
  (with-namespace-context namespace-map
    (node->model node transaction-item-attributes)))

(def ^:private transaction-attributes
  [{:attribute :id
    :xpath "trn:id"}
   {:attribute :transaction-date
    :xpath "trn:date-posted/ts:date"
    :transform-fn parse-date}
   {:attribute :description
    :xpath "trn:description"}])

(defn- node->transaction
  [node]
  (-> node
      (node->model transaction-attributes)
      (assoc :items (->> ($x "trn:splits/trn:split" node)
                         (map node->transaction-item)))))

(defmethod process-node :gnc:transaction
  [callback node]
  (callback (node->transaction node) :transaction))

(defmethod read-source :gnucash
  [_ input callback]
  (with-namespace-context namespace-map
    (let [xml (->> (GZIPInputStream. input)
                   io/reader
                   slurp
                   xml->doc)]
      (doseq [node ($x "/gnc-v2/gnc:book/gnc:count-data | /gnc-v2/gnc:book/gnc:account | /gnc-v2/gnc:book/gnc:transaction | /gnc-v2/gnc:book/gnc:budget" xml)]
        (process-node callback node)))))

change handling for ignored accounts

change handling for ignored accounts


(ns ceres.communicator
  (:require [goog.net.XhrIo :as xhr]
            [goog.net.WebSocket]
            [goog.net.WebSocket.EventType :as event-type]
            [goog.events :as events]
            [cljs.reader :refer [read-string]]
            [cljs.core.async :as async :refer [<! >! chan close! put!]])
  (:require-macros [cljs.core.async.macros :refer [go alt! go-loop]]))

(defn connect!
  "Connects with websocket"
  ([uri] (connect! uri {}))
  ([uri {:keys [in out] :or {in chan out chan}}]
      (let [on-connect (chan)
            in (in)
            out (out)
            websocket (goog.net.WebSocket.)]
        (.log js/console "establishing websocket ...")
        (doto websocket
          (events/listen event-type/MESSAGE
                         (fn [m]
                              (let [data (read-string (.-message m))]
                                (put! out data))))
          (events/listen event-type/OPENED
                         (fn []
                           (close! on-connect)
                           (.log js/console "channel opened")
                           (go-loop []
                                    (let [data (<! in)]
                                      (if-not (nil? data)
                                        (do (.send websocket (pr-str data))
                                            (recur))
                                        (do (close! out)
                                            (.close websocket)))))))
          (events/listen event-type/CLOSED
                         (fn []
                            (.log js/console "channel closed")
                            (close! in)
                            (close! out)))
          (events/listen event-type/ERROR (fn [e] (.log js/console (str "ERROR:" e))))
          (.open uri))
        (go
          (<! on-connect)
          {:uri uri :websocket websocket :in in :out out}))))

(ns ceres.communicator
  (:require [goog.net.XhrIo :as xhr]
            [goog.net.WebSocket]
            [goog.net.WebSocket.EventType :as event-type]
            [goog.events :as events]
            [cljs.reader :refer [read-string]]
            [cljs.core.async :as async :refer [<! >! chan close! put!]])
  (:require-macros [cljs.core.async.macros :refer [go alt! go-loop]]))

(defn connect!
  "Connects with websocket"
  ([uri] (connect! uri {}))
  ([uri {:keys [in out] :or {in chan out chan}}]
      (let [on-connect (chan)
            in (in)
            out (out)
            websocket (goog.net.WebSocket.)]
        (.log js/console "establishing websocket ...")
        (doto websocket
          (events/listen event-type/MESSAGE
                         (fn [m]
                              (let [data (read-string (.-message m))]
                                (put! out data))))
          (events/listen event-type/OPENED
                         (fn []
                           (close! on-connect)
                           (.log js/console "channel opened")
                           (go-loop []
                                    (let [data (<! in)]
                                      (if-not (nil? data)
                                        (do (.send websocket (pr-str data))
                                            (recur))
                                        (do (close! out)
                                            (.close websocket)))))))
          (events/listen event-type/CLOSED
                         (fn []
                            (.log js/console "channel closed")
                            (close! in)
                            (close! out)))
          (events/listen event-type/ERROR (fn [e] (.log js/console (str "ERROR:" (.-message e)))))
          (.open uri))
        (go
          (<! on-connect)
          {:uri uri :websocket websocket :in in :out out}))))

print socket error message

print socket error message


(ns duratom.backends
  (:require [duratom.utils :as ut])
  (:import (java.io File IOException Closeable)
           (clojure.lang Agent Atom)))

(defprotocol ICommiter
  (commit! [this f ef]))

(defn- sync-commit*
  [c f handle-error]
  (try
    (f c)
    (catch Exception e
      (handle-error e))))

(extend-protocol ICommiter
  Agent  ;; asynchronous
  (commit!
    [this f handle-error]
    (if (some? handle-error)
      ;; delegate to the synchronous Atom(applicable to duratom recommits),
      ;; or Object(applicable to all duragent commits) implementation
      (commit! (deref this) f handle-error)
      (send-off this f)))
  Atom   ;; synchronous
  (commit! [this f handle-error]
    (sync-commit* this f handle-error))
  Object ;; synchronous
  (commit! [this f handle-error]
    (sync-commit* this f handle-error))
  )

(defprotocol IStorageBackend
  (snapshot [this])
  (commit   [this] ;; applicable only to duratom re-commits via the error-handler
            [this x])
  (cleanup  [this]))

(defn safe-cleanup!
  [storage release lock]
  (when-not (release)
    (ut/with-locking lock
      (cleanup storage)
      (release true))))

(defn- get-error-handler
  [backend]
  (some-> (meta backend) :error-handler))

(defn- ?deref
  [state x]
  (if (= ::deref x)
    @state
    x))

;; ===============================<LOCAL FILE>===========================================
(defn- save-to-file!
  [write-it! path v]
  (let [tmp-file-name (str path ".tmp")]
    (write-it! tmp-file-name v)           ;; write data to a temp file
    (ut/move-file! tmp-file-name path)))  ;; and move it atomically

(defrecord FileBackend [^File file read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (let [path (.getPath file)]
      (when-not (zero? (.length file))
        (try (read-it! path)
             (catch Exception e
               (throw (ex-info (str "Unable to read data from file " path "!")
                               {:file-path path}
                               e)))))))
  (commit [this]
    (commit this ::deref)) ;; duratom recommits only down this path
  (commit [this x]
    ;; synchronous backends always have an error-handler in their meta
    ;; asynchronous ones MAY have one (for synchronous re-committing)
    (let [f (fn [state]
              (save-to-file! write-it! (.getPath file) (?deref state x))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (or (.delete file) ;; simply delete the file
        (throw (IOException. (str "Could not delete " (.getPath file))))))
  )

;;===================================<PGSQL>=====================================

(defn- save-to-db! [db-config table-name row-id write-it! x]
  (ut/update-or-insert! db-config table-name {:id row-id :value (write-it! x)} ["id = ?" row-id]))

(defrecord PGSQLBackend [config table-name row-id read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (ut/get-pgsql-value config table-name row-id read-it!))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (save-to-db! config table-name row-id write-it! (?deref state x))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (ut/delete-relevant-row! config table-name row-id)) ;;drop the relevant row
  )

;;==========================<AMAZON-S3>=============================================

(defn- save-to-s3!
  [credentials bucket k write-it! x]
  (ut/store-value-to-s3 credentials bucket k (write-it! x)))

(defrecord S3Backend [credentials bucket k metadata read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (ut/get-value-from-s3 credentials bucket k metadata read-it!))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (save-to-s3! credentials bucket k write-it! (?deref state x))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (ut/delete-object-from-s3 credentials bucket k)) ;;drop the whole object
  )

;;==========================<REDIS>=============================================

(defrecord RedisBackend [conn key-name read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (read-it! (ut/redis-get conn key-name)))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (ut/redis-set conn key-name (write-it! (?deref state x)))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (ut/redis-del conn key-name)))

;;================================<file.io>======================================

(defrecord FileIOBackend [http-post key-duratom expiry read-it! write-it! committer]
  IStorageBackend
  (snapshot [this]
    (when-let [ret (some-> @key-duratom ut/fileIO-get! read-it!)]
      (reset! key-duratom nil)
      (commit this) ;; reading it deleted it so re-upload it
      ret))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (let [previous-k @key-duratom
                    new-k (ut/fileIO-post! http-post (write-it! (?deref state x)))]
                (reset! key-duratom new-k)
                (ut/fileIO-get! previous-k) ;; delete previous
                state))]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (some-> @key-duratom ut/fileIO-get!)
    (.close ^Closeable key-duratom)
    )
  )

(ns duratom.backends
  (:require [duratom.utils :as ut])
  (:import (java.io File IOException Closeable)
           (clojure.lang Agent Atom)))

(defprotocol ICommiter
  (commit! [this f ef]))

(defn- sync-commit*
  [c f handle-error]
  (try
    (f c)
    (catch Exception e
      (handle-error e))))

(extend-protocol ICommiter
  Agent  ;; asynchronous
  (commit!
    [this f handle-error]
    (if (some? handle-error)
      ;; delegate to the synchronous Atom(applicable to duratom recommits),
      ;; or Object(applicable to all duragent commits) implementation
      (commit! (deref this) f handle-error)
      (send-off this f)))
  Atom   ;; synchronous
  (commit! [this f handle-error]
    (sync-commit* this f handle-error))
  Object ;; synchronous
  (commit! [this f handle-error]
    (sync-commit* this f handle-error))
  )

(defprotocol IStorageBackend
  (snapshot [this])
  (commit   [this] ;; applicable only to duratom re-commits via the error-handler
            [this x])
  (cleanup  [this]))

(defn safe-cleanup!
  [storage release lock]
  (when-not (release)
    (ut/with-locking lock
      (cleanup storage)
      (release true))))

(defn- get-error-handler
  [backend]
  (some-> (meta backend) :error-handler))

(defn- ?deref
  [state x]
  (if (= ::deref x)
    @state
    x))

;; ===============================<LOCAL FILE>===========================================
(defn- save-to-file!
  [write-it! path v]
  (let [tmp-file-name (str path ".tmp")]
    (write-it! tmp-file-name v)           ;; write data to a temp file
    (ut/move-file! tmp-file-name path)))  ;; and move it atomically

(defrecord FileBackend [^File file read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (let [path (.getPath file)]
      (when-not (zero? (.length file))
        (try (read-it! path)
             (catch Exception e
               (throw (ex-info (str "Unable to read data from file " path "!")
                               {:file-path path}
                               e)))))))
  (commit [this]
    (commit this ::deref)) ;; duratom recommits only down this path
  (commit [this x]
    ;; synchronous backends always have an error-handler in their meta
    ;; asynchronous ones MAY have one (for synchronous re-committing)
    (let [f (fn [state]
              (save-to-file! write-it! (.getPath file) (?deref state x))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (or (.delete file) ;; simply delete the file
        (throw (IOException. (str "Could not delete " (.getPath file))))))
  )

;;===================================<PGSQL>=====================================

(defn- save-to-db! [db-config table-name row-id write-it! x]
  (ut/update-or-insert! db-config table-name {:id row-id :value (write-it! x)} ["id = ?" row-id]))

(defrecord PGSQLBackend [config table-name row-id read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (ut/get-pgsql-value config table-name row-id read-it!))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (save-to-db! config table-name row-id write-it! (?deref state x))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (ut/delete-relevant-row! config table-name row-id)) ;;drop the relevant row
  )

;;==========================<AMAZON-S3>=============================================

(defn- save-to-s3!
  [credentials bucket k write-it! x]
  (ut/store-value-to-s3 credentials bucket k (write-it! x)))

(defrecord S3Backend [credentials bucket k metadata read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (ut/get-value-from-s3 credentials bucket k metadata read-it!))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (save-to-s3! credentials bucket k write-it! (?deref state x))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (ut/delete-object-from-s3 credentials bucket k)) ;;drop the whole object
  )

;;==========================<REDIS>=============================================

(defrecord RedisBackend [conn key-name read-it! write-it! committer]
  IStorageBackend
  (snapshot [_]
    (read-it! (ut/redis-get conn key-name)))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (ut/redis-set conn key-name (write-it! (?deref state x)))
              state)]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (ut/redis-del conn key-name)))

;;================================<file.io>======================================

(defrecord FileIOBackend [http-post key-duratom expiry read-it! write-it! committer]
  IStorageBackend
  (snapshot [this]
    (when-let [ret (some-> @key-duratom ut/fileIO-get! read-it!)]
      (reset! key-duratom nil)
      (commit this) ;; reading it deleted it so re-upload it
      ret))
  (commit [this]
    (commit this ::deref))
  (commit [this x]
    (let [f (fn [state]
              (let [previous-k @key-duratom
                    new-k (ut/fileIO-post! http-post (write-it! (?deref state x)) expiry)]
                (reset! key-duratom new-k)
                (ut/fileIO-get! previous-k) ;; delete previous
                state))]
      (commit! committer f (get-error-handler this))))
  (cleanup [_]
    (some-> @key-duratom ut/fileIO-get!)
    (.close ^Closeable key-duratom)
    )
  )

fix typo

fix typo