(ns clj-kafka.producer
  (:import [kafka.javaapi.producer Producer ProducerData]
           [kafka.producer ProducerConfig]
           [kafka.message Message])
  (:use [clj-kafka.core :only (as-properties)]))

(defn producer
  "Creates a Producer. m is the configuration
   serializer.class : default is kafka.serializer.DefaultEncoder
   zk.connect       : Zookeeper connection. e.g. localhost:2181 "
  [m]
  ^Producer (Producer. (ProducerConfig. (as-properties m))))

(defn message
  "Creates a message with the specified payload.
   payload : bytes for the message payload. e.g. (.getBytes \"hello, world\")"
  [^:bytes payload]
  (Message. payload))

(defn send-messages
  "Sends a message.
   topic   : a string
   msgs    : a single message, or sequence of messages to send"
  [^Producer producer ^String topic msgs]
  (.send producer (ProducerData. topic msgs)))

(defprotocol ToMessage
  "Protocol to be extended to convert types to encoded Message objects"
  (to-message [x] "Creates a Message instance"))

(extend-protocol ToMessage
  String
  (to-message [x] (message (.getBytes x))))

(ns clj-kafka.producer
  (:import [kafka.javaapi.producer Producer ProducerData]
           [kafka.producer ProducerConfig]
           [kafka.message Message])
  (:use [clj-kafka.core :only (as-properties)]))

(defn producer
  "Creates a Producer. m is the configuration
   serializer.class : default is kafka.serializer.DefaultEncoder
   zk.connect       : Zookeeper connection. e.g. localhost:2181 "
  [m]
  ^Producer (Producer. (ProducerConfig. (as-properties m))))

(defn message
  "Creates a message with the specified payload.
   payload : bytes for the message payload. e.g. (.getBytes \"hello, world\")"
  [#^bytes payload]
  (Message. payload))

(defn send-messages
  "Sends a message.
   topic   : a string
   msgs    : a single message, or sequence of messages to send"
  [^Producer producer ^String topic msgs]
  (.send producer (ProducerData. topic msgs)))

(defprotocol ToMessage
  "Protocol to be extended to convert types to encoded Message objects"
  (to-message [x] "Creates a Message instance"))

(extend-protocol ToMessage
  String
  (to-message [x] (message (.getBytes x))))

change type hint in message

change type hint in message


(ns cglossa.core
  (:require [reagent.core :as reagent :refer [atom]]
            [plumbing.core :as plumbing :refer [map-vals]]
            [cglossa.start :as start]
            [cglossa.results :as results]))

; avoid "not resolved" messages in Cursive
(declare getElementById)

(def state {:showing-results? false
            :showing-sidebar? false
            :search-view :simple
            :search-queries [{:query "[word=\"han\" %c] [word=\"er\" %c]"}
                             {:query "[word=\"de\" %c] [word=\"sa\" %c]"}]})

(def data {:corpus {:name "Leksikografisk bokmålskorpus"
                    :code "bokmal"
                    :encoding "iso-8859-1"
                    :logo "book-clip-art-3.png"
                    :langs {:lang   :no
                            :tagger :obt_bm_lbk}}})

(defonce app-state (into {} (map-vals atom state)))
(defonce app-data (into {} (map-vals atom data)))

(defn header []
  [:div.navbar.navbar-fixed-top [:div.navbar-inner [:div.container [:span.brand "Glossa"]]]])

(defn app [{:keys [showing-results?] :as s} {:keys [corpus] :as d}]
  (let [cls (if (empty? (:metadata-categories @corpus)) "span12" "span9")]
    [:div
     [header]
     [:div.container-fluid
      [:div.row-fluid
       [:div#main-content {:class-name cls}
        (if @showing-results?
          [results/main s d]
          [start/main s d])]]]
     [:div.app-footer
      [:img.textlab-logo {:src "img/tekstlab.gif"}]]]))

(defn ^:export main []
  (reagent/render-component
    (fn []
      [app app-state app-data])
    (. js/document (getElementById "app"))))

(ns cglossa.core
  (:require [reagent.core :as reagent :refer [atom]]
            [plumbing.core :as plumbing :refer [map-vals]]
            [cglossa.start :as start]
            [cglossa.results :as results]))

; avoid "not resolved" messages in Cursive
(declare getElementById)

(def state {:showing-results? false
            :showing-sidebar? false
            :search-view :simple
            :search-queries [{:query "[word=\"han\" %c] [word=\"er\" %c]"}
                             {:query "[word=\"de\" %c] [word=\"sa\" %c]"}]})

(def data {:corpus {:name "Leksikografisk bokmålskorpus"
                    :code "bokmal"
                    :encoding "iso-8859-1"
                    :logo "book-clip-art-3.png"
                    :langs {:lang   :no
                            :tagger :obt_bm_lbk}}})

(defonce app-state (into {} (map-vals atom state)))
(defonce app-data (into {} (map-vals atom data)))

(defn- header []
  [:div.navbar.navbar-fixed-top [:div.navbar-inner [:div.container [:span.brand "Glossa"]]]])

(defn app [{:keys [showing-results?] :as s} {:keys [corpus] :as d}]
  (let [cls (if (empty? (:metadata-categories @corpus)) "span12" "span9")]
    [:div
     [header]
     [:div.container-fluid
      [:div.row-fluid
       [:div#main-content {:class-name cls}
        (if @showing-results?
          [results/main s d]
          [start/main s d])]]]
     [:div.app-footer
      [:img.textlab-logo {:src "img/tekstlab.gif"}]]]))

(defn ^:export main []
  (reagent/render-component
    (fn []
      [app app-state app-data])
    (. js/document (getElementById "app"))))

Mark child component as private

Mark child component as private

This is mainly to more clearly show the "entry point" component(s) of a namespace, i.e., the ones that are used as children of components in other namespaces.


(ns html2om.core
  (:require [goog.dom :as gdom]
            [om.next :as om :refer-macros [defui]]
            [om.dom :as dom]
            [clojure.string :as string]
            [html2om.utils :as utils]
            ))

(enable-console-print!)

(println "Hello world!")

;; Components

(defui RootView
  static om/IQueryParams
  (params [_]
          {:html ""}
          )

  static om/IQuery
  (query [_]
         '[:value
           (:om-text/om-text
             {:html ?html}
             )
           ]
         )

  Object
  (render [this]
    (dom/div #js {:className "container"}
             "Enter HTML:"
             (dom/textarea #js {:className "form-control"
                                :style #js {:height "400px"}
                                :value (:value
                                         (om/props this)
                                         )
                                :onChange (fn [e]
                                            (om/transact! this
                                              `[(~'set-value
                                                  {:value ~(.. e -target -value)}
                                                  )]
                                              )
                                            )
                                }
                           )
             (dom/button #js {:className "btn btn-block"
                              :onClick (fn [e]
                                         (om/set-query! this
                                                        {:params
                                                           {:html (om/props this)}
                                                           }
                                                       )
                                         )
                                }
                         "C'mon!"
                           )
             (dom/br nil)
             (dom/br nil)
             (dom/pre #js {:className ""}
                      (:om-text/om-text (om/props this))
                      )
             )
          )
  )

;; Read & Write

(defmulti readf om/dispatch)

(defmethod readf :default
  [{:keys [state] :as env} k params]
  {:value "bar"}
  )

(defmethod readf :om-text/om-text
  [{:keys [state] :as env} k params]
  {:remote true}
  )

(defmethod readf :value
  [{:keys [state] :as env} k params]
  {:value (:value @state)}
  )

(defmulti mutatef om/dispatch)

(defmethod mutatef 'set-value
  [{:keys [state] :as env} k {:keys [value]}]
  {:action (fn [_]
             (swap! state update-in [:value]
                    (fn [old-value]
                      value
                      )
                    )
             )
   }
  )

;; Root

(def data
  (atom {:value ""}))

(def parser (om/parser {:read readf
                        :mutate mutatef
                        }))

(defn send-fn [data cb]
  (utils/edn-xhr
    {:method :post
                 :url "/api"
                 :data data
                 :on-complete (fn [x]
                                (println "calling cb" (prn-str x))
                                ; this receives {:om-text/om-text "foo"}
                                ; but dom/pre in RootView won't be updated
                                (cb x)
                                )
     }
    )
  )

(def reconciler (om/reconciler
                  {:state data
                   :parser parser
                   :send send-fn
                   }
                  ))

(om/add-root!
  reconciler
  RootView
  (gdom/getElement "app"))

(ns html2om.core
  (:require [goog.dom :as gdom]
            [om.next :as om :refer-macros [defui]]
            [om.dom :as dom]
            [clojure.string :as string]
            [html2om.utils :as utils]
            ))

(enable-console-print!)

(println "Hello world!")

;; Components

(defui RootView
  static om/IQueryParams
  (params [_]
          {:html ""}
          )

  static om/IQuery
  (query [_]
         '[:value
           (:om-text/om-text
             {:html ?html}
             )
           ]
         )

  Object
  (render [this]
          (println "render called"
                   (om/props this)
                   )
    (dom/div #js {:className "container"}
             "Enter HTML:"
             (dom/textarea #js {:className "form-control"
                                :style #js {:height "400px"}
                                :value (:value
                                         (om/props this)
                                         )
                                :onChange (fn [e]
                                            (om/transact! this
                                              `[(~'set-value
                                                  {:value ~(.. e -target -value)}
                                                  )]
                                              )
                                            )
                                }
                           )
             (dom/button #js {:className "btn btn-block"
                              :onClick (fn [e]
                                         (om/set-query! this
                                                        {:params
                                                           {:html (om/props this)}
                                                           }
                                                       )
                                         )
                                }
                         "C'mon!"
                           )
             (dom/br nil)
             (dom/br nil)
             (dom/pre #js {:className ""}
                      (:om-text/om-text (om/props this))
                      )
             )
          )
  )

;; Read & Write

(defmulti readf om/dispatch)

(defmethod readf :default
  [{:keys [state] :as env} k params]
  {:value "bar"}
  )

(defmethod readf :om-text/om-text
  [{:keys [state] :as env} k params]
  {:remote true}
  )

(defmethod readf :value
  [{:keys [state] :as env} k params]
  {:value (:value @state)}
  )

(defmulti mutatef om/dispatch)

(defmethod mutatef 'set-value
  [{:keys [state] :as env} k {:keys [value]}]
  {:action (fn [_]
             (swap! state update-in [:value]
                    (fn [old-value]
                      value
                      )
                    )
             )
   }
  )

;; Root

(def data
  (atom {:value ""}))

(def parser (om/parser {:read readf
                        :mutate mutatef
                        }))

(defn send-fn [data cb]
  (utils/edn-xhr
    {:method :post
                 :url "/api"
                 :data data
                 :on-complete (fn [x]
                                (println "calling cb" (prn-str x))
                                ; this receives {:om-text/om-text "foo"}
                                ; but dom/pre in RootView won't be updated
                                (cb x)
                                )
     }
    )
  )

(def reconciler (om/reconciler
                  {:state data
                   :parser parser
                   :send send-fn
                   }
                  ))

(om/add-root!
  reconciler
  RootView
  (gdom/getElement "app"))

debug println on render

debug println on render


(ns parkour.fs
  (:require [clojure.string :as str]
            [clojure.java.io :as io]
            [clojure.reflect :as reflect]
            [clojure.core.reducers :as r]
            [parkour (conf :as conf) (reducers :as pr)]
            [parkour.util :refer [ignore-errors returning map-vals mpartial]])
  (:import [java.net URI URL]
           [java.io File IOException InputStream OutputStream Reader Writer]
           [org.apache.hadoop.fs FileStatus FileSystem Path]
           [org.apache.hadoop.filecache DistributedCache]))

(defprotocol Coercions
  (^org.apache.hadoop.fs.Path
    -path [x] "Coerce argument to a Path; private implementation.")
  (^java.net.URI
    -uri [x] "Coerce argument to a URI; private implementation."))

(defmacro ^:private write-all
  [w & forms]
  (let [w (vary-meta w assoc :tag `Writer)]
    `(do ~@(map (fn [x] `(. ~w write ~(if (string? x) x `(str ~x)))) forms))))

(defn path
  "Coerce argument(s) to a Path, resolving successive arguments against base."
  {:tag `Path}
  ([x] (-path x))
  ([x y] (Path. (-path x) (str y)))
  ([x y & more] (apply path (path x y) more)))

(defmethod print-method Path [x w] (write-all w "#hadoop.fs/path \"" x "\""))
(defmethod print-dup Path [x w] (write-all w "#hadoop.fs/path \"" x "\""))

(defn path?
  "True iff `x` is a Path."
  [x] (instance? Path x))

(defn uri
  "Coerce argument(s) to a URI, resolving successive arguments against base."
  {:tag `URI}
  ([x] (-uri x))
  ([x y]
     (let [x (-uri x)]
       (-> x (.resolve (str (.getPath x) "/")) (.resolve (str y)))))
  ([x y & more] (apply uri (uri x y) more)))

(defmethod print-method URI [x w] (write-all w "#java.net/uri \"" x "\""))
(defmethod print-dup URI [x w] (write-all w "#java.net/uri \"" x "\""))

(defn uri?
  "True iff `x` is a URI."
  [x] (instance? URI x))

(defn path-fs
  "Hadoop filesystem for the path `p`."
  {:tag `FileSystem}
  ([p] (path-fs (conf/ig) p))
  ([conf p] (.getFileSystem (path p) (conf/ig conf))))

(extend-protocol Coercions
  String
  (-path [x]
    (if (.startsWith x "file:")
      (-path (io/file (subs x 5)))
      (Path. x)))
  (-uri [x]
    (let [uri (URI. x)]
      (condp = (.getScheme uri)
        "file" (.toURI (io/file uri))
        nil    (let [p (Path. x)]
                 (.toUri (.makeQualified p (path-fs p))))
        ,,,,,, uri)))

  Path
  (-path [x] x)
  (-uri [x] (.toUri (.makeQualified x (path-fs x))))

  URI
  (-path [x] (Path. x))
  (-uri [x] x)

  URL
  (-path [x] (Path. (str (.toURI x))))
  (-uri [x] (.toURI x))

  File
  (-path [x] (Path. (str "file:" (.getAbsolutePath x))))
  (-uri [x] (.toURI x)))

(extend-protocol io/Coercions
  Path
  (as-file [x] (io/as-file (uri x)))
  (as-url [x] (.toURL (uri x))))

(defn path-glob
  "Expand path glob `p` to set of matching paths."
  ([p] (path-glob (path-fs p) p))
  ([fs p]
     (->> (.globStatus ^FileSystem fs (path p))
          (map #(.getPath ^FileStatus %)))))

(defn path-list
  "List the entries in the directory at path `p`."
  ([p] (path-list (path-fs p) p))
  ([fs p]
     (->> (.listStatus ^FileSystem fs (path p))
          (map #(.getPath ^FileStatus %) ))))

(defn path-map
  "Return map of file basename to full path for all files in `dir`."
  ([dir] (path-map (path-fs dir) dir))
  ([fs dir]
     (let [dir (path dir)]
       (->> (.listStatus ^FileSystem fs dir)
            (r/remove #(.isDir ^FileStatus %))
            (r/map (comp (juxt #(.getName ^Path %) str)
                         #(.getPath ^FileStatus %)))
            (into {})))))

(defn path-open
  "Open an input stream on `p`, or default `fs` if not provided."
  ([p] (path-open (path-fs p) p))
  ([fs p] (.open ^FileSystem fs (path p))))

(defn input-stream
  "Open an input stream on `p`, via a Hadoop filesystem when in a
supported scheme and via `io/input-stream` when not."
  {:tag `InputStream}
  ([p] (input-stream (conf/ig) p))
  ([conf p]
     (let [p (path p)]
       (if-let [fs (ignore-errors (path-fs conf p))]
         (path-open fs p)
         (io/input-stream (io/as-url p))))))

(defn path-create
  "Create an output stream on `p` for `fs`, or default `fs` if not provided."
  ([p] (path-create (path-fs p) p))
  ([fs p] (.create ^FileSystem fs (path p))))

(extend Path
  io/IOFactory
  (assoc io/default-streams-impl
    :make-input-stream (fn [p opts]
                         (if-let [fs (or (:fs opts) (path-fs p))]
                           (io/make-input-stream (path-open fs p) opts)
                           (io/input-stream (io/as-url p))))
    :make-output-stream (fn [p opts]
                          (if-let [fs (or (:fs opts) (path-fs p))]
                            (io/make-output-stream (path-open fs p) opts)
                            (io/output-stream (io/as-url p))))))

;; Private for some reason, so copy internally
(def ^:private do-copy @#'io/do-copy)

(defmethod do-copy [Path OutputStream]
  [input output opts] (do-copy (io/input-stream input) output opts))
(defmethod do-copy [Path Writer]
  [input output opts] (do-copy (io/reader input) output opts))
(defmethod do-copy [Path File]
  [input output opts] (do-copy (io/input-stream input) output opts))
(defmethod do-copy [InputStream Path]
  [input output opts] (do-copy input (io/output-stream output) opts))
(defmethod do-copy [Reader Path]
  [input output opts] (do-copy input (io/writer output) opts))
(defmethod do-copy [File Path]
  [input output opts] (do-copy input (io/output-stream output) opts))

(def ^:dynamic *temp-dir*
  "Default path to system temporary directory on the default
filesystem.  May be overridden in configuration via the property
`parkour.temp.dir`."
  "/tmp")

(defn ^:private run-id
  "A likely-unique user- and time-based string."
  []
  (let [user (System/getProperty "user.name")
        time (System/currentTimeMillis)
        rand (rand-int Integer/MAX_VALUE)]
    (str user "-" time "-" rand)))

(defn ^:private temp-root
  [conf] (path (conf/get conf "parkour.temp.dir" *temp-dir*)))

(defn ^:private new-temp-dir
  "Return path for a new temporary directory."
  [conf] (path (temp-root conf) (run-id)))

(def ^:private cancel-doe-method?
  "True iff the `Job` class has a static factory method."
  (->> FileSystem reflect/type-reflect :members
       (some #(= 'cancelDeleteOnExit (:name %)))))

(defmacro ^:private cancel-doe
  "Macro to cancel delete-on-exit when available."
  [& args]
  (if cancel-doe-method?
    `(.cancelDeleteOnExit ~@args)))

(defn with-temp-dir*
  "Function version of `with-temp-dir`."
  ([f] (with-temp-dir* nil f))
  ([conf f]
     (let [conf (or conf (conf/ig))
           temp-dir (new-temp-dir conf)
           fs (path-fs conf temp-dir)]
       (.mkdirs fs temp-dir)
       (.deleteOnExit fs temp-dir)
       (try
         (f temp-dir)
         (finally
           (.delete fs temp-dir true)
           (cancel-doe fs temp-dir))))))

(defmacro with-temp-dir
  "Run the forms in `body` with `temp-dir` bound to a Hadoop filesystem
temporary directory path, created via the optional `conf`."
  [[temp-dir conf] & body]
  `(with-temp-dir* ~conf (fn [~temp-dir] ~@body)))

(defn ^:private split-fragment
  [^URI uri]
  (let [fragment (.getFragment uri), uri-s (str uri), n (count uri-s)
        base (subs uri-s 0 (- n (count fragment) 1))]
    [fragment (URI. base)]))

(defn distcache-files
  "Retrieve map of existing distcache entries from `conf`."
  [conf]
  (->> (DistributedCache/getCacheFiles (conf/ig conf))
       (r/map split-fragment)
       (into {})))

(defn distcache!
  "Update Hadoop `conf` to merge the `uri-map` of local file paths to
URIs into the distributed cache configuration."
  [conf uri-map]
  (let [conf (doto (conf/ig conf)
               (DistributedCache/createSymlink))]
    (->> (into (distcache-files conf) uri-map)
         (map (fn [[local remote]]
                (.resolve (uri remote) (str "#" local))))
         (str/join ",")
         (conf/assoc! conf "mapred.cache.files"))))

(defn distcacher
  "Return a function for merging the `uri-map` of local paths to URIs
into the distributed cache files of a Hadoop configuration."
  [uri-map] (mpartial distcache! uri-map))

(defn with-copies*
  "Function form of `with-copies`."
  [conf uri-map f]
  (with-temp-dir [temp-dir conf]
    (let [conf (or conf (conf/ig)), uri-map (map-vals uri uri-map)
          temp-fs (path-fs conf temp-dir)
          uri-map (reduce (fn [result [local remote]]
                            (let [temp (path temp-dir local)]
                              (returning (assoc result local (uri temp))
                                (with-open [inf (input-stream conf remote),
                                            outf (.create temp-fs temp)]
                                  (io/copy inf outf)))))
                          {} uri-map)]
      (f uri-map))))

(defmacro with-copies
  "Copy the URI values of `uri-map` to a temporary directory on the
default Hadoop filesystem, optionally specified by `conf`.  Evaluate
`body` forms with `name` bound to the map of original `uri-map` keys
to new temporary paths."
  [[name uri-map conf] & body]
  `(with-copies* ~conf ~uri-map (fn [~name] ~@body)))

(ns parkour.fs
  (:require [clojure.string :as str]
            [clojure.java.io :as io]
            [clojure.reflect :as reflect]
            [clojure.core.reducers :as r]
            [parkour (conf :as conf) (reducers :as pr)]
            [parkour.util :refer [ignore-errors returning map-vals mpartial]])
  (:import [java.net URI URL]
           [java.io File IOException InputStream OutputStream Reader Writer]
           [org.apache.hadoop.fs FileStatus FileSystem Path]
           [org.apache.hadoop.filecache DistributedCache]))

(defprotocol Coercions
  (^org.apache.hadoop.fs.Path
    -path [x] "Coerce argument to a Path; private implementation.")
  (^java.net.URI
    -uri [x] "Coerce argument to a URI; private implementation."))

(defmacro ^:private write-all
  [w & forms]
  (let [w (vary-meta w assoc :tag `Writer)]
    `(do ~@(map (fn [x] `(. ~w write ~(if (string? x) x `(str ~x)))) forms))))

(defn path
  "Coerce argument(s) to a Path, resolving successive arguments against base."
  {:tag `Path}
  ([x] (-path x))
  ([x y] (Path. (-path x) (str y)))
  ([x y & more] (apply path (path x y) more)))

(defmethod print-method Path [x w] (write-all w "#hadoop.fs/path \"" x "\""))
(defmethod print-dup Path [x w] (write-all w "#hadoop.fs/path \"" x "\""))

(defn path?
  "True iff `x` is a Path."
  [x] (instance? Path x))

(defn uri
  "Coerce argument(s) to a URI, resolving successive arguments against base."
  {:tag `URI}
  ([x] (-uri x))
  ([x y]
     (let [x (-uri x)]
       (-> x (.resolve (str (.getPath x) "/")) (.resolve (str y)))))
  ([x y & more] (apply uri (uri x y) more)))

(defmethod print-method URI [x w] (write-all w "#java.net/uri \"" x "\""))
(defmethod print-dup URI [x w] (write-all w "#java.net/uri \"" x "\""))

(defn uri?
  "True iff `x` is a URI."
  [x] (instance? URI x))

(defn path-fs
  "Hadoop filesystem for the path `p`."
  {:tag `FileSystem}
  ([p] (path-fs (conf/ig) p))
  ([conf p] (.getFileSystem (path p) (conf/ig conf))))

(extend-protocol Coercions
  String
  (-path [x]
    (if (.startsWith x "file:")
      (-path (io/file (subs x 5)))
      (Path. x)))
  (-uri [x]
    (let [uri (URI. x)]
      (condp = (.getScheme uri)
        "file" (.toURI (io/file uri))
        nil    (-uri (-path x))
        ,,,,,, uri)))

  Path
  (-path [x] x)
  (-uri [x]
    (let [fs (ignore-errors (path-fs x))]
      (-> x (cond-> fs (.makeQualified fs)) .toUri)))

  URI
  (-path [x] (Path. x))
  (-uri [x] x)

  URL
  (-path [x] (Path. (str (.toURI x))))
  (-uri [x] (.toURI x))

  File
  (-path [x] (Path. (str "file:" (.getAbsolutePath x))))
  (-uri [x] (.toURI x)))

(extend-protocol io/Coercions
  Path
  (as-file [x] (io/as-file (uri x)))
  (as-url [x] (.toURL (uri x))))

(defn path-glob
  "Expand path glob `p` to set of matching paths."
  ([p] (path-glob (path-fs p) p))
  ([fs p]
     (->> (.globStatus ^FileSystem fs (path p))
          (map #(.getPath ^FileStatus %)))))

(defn path-list
  "List the entries in the directory at path `p`."
  ([p] (path-list (path-fs p) p))
  ([fs p]
     (->> (.listStatus ^FileSystem fs (path p))
          (map #(.getPath ^FileStatus %) ))))

(defn path-map
  "Return map of file basename to full path for all files in `dir`."
  ([dir] (path-map (path-fs dir) dir))
  ([fs dir]
     (let [dir (path dir)]
       (->> (.listStatus ^FileSystem fs dir)
            (r/remove #(.isDir ^FileStatus %))
            (r/map (comp (juxt #(.getName ^Path %) str)
                         #(.getPath ^FileStatus %)))
            (into {})))))

(defn path-open
  "Open an input stream on `p`, or default `fs` if not provided."
  ([p] (path-open (path-fs p) p))
  ([fs p] (.open ^FileSystem fs (path p))))

(defn input-stream
  "Open an input stream on `p`, via a Hadoop filesystem when in a
supported scheme and via `io/input-stream` when not."
  {:tag `InputStream}
  ([p] (input-stream (conf/ig) p))
  ([conf p]
     (let [p (path p)]
       (if-let [fs (ignore-errors (path-fs conf p))]
         (path-open fs p)
         (io/input-stream (io/as-url p))))))

(defn path-create
  "Create an output stream on `p` for `fs`, or default `fs` if not provided."
  ([p] (path-create (path-fs p) p))
  ([fs p] (.create ^FileSystem fs (path p))))

(extend Path
  io/IOFactory
  (assoc io/default-streams-impl
    :make-input-stream
    , (fn [p opts]
        (if-let [fs (or (:fs opts) (ignore-errors (path-fs p)))]
          (io/make-input-stream (path-open fs p) opts)
          (io/make-input-stream (io/as-url p) opts)))
    :make-output-stream
    , (fn [p opts]
        (if-let [fs (or (:fs opts) (ignore-errors (path-fs p)))]
          (io/make-output-stream (path-create fs p) opts)
          (io/make-output-stream (io/as-url p) opts)))))

;; Private for some reason, so copy internally
(def ^:private do-copy @#'io/do-copy)

(defmethod do-copy [Path OutputStream]
  [input output opts] (do-copy (io/input-stream input) output opts))
(defmethod do-copy [Path Writer]
  [input output opts] (do-copy (io/reader input) output opts))
(defmethod do-copy [Path File]
  [input output opts] (do-copy (io/input-stream input) output opts))
(defmethod do-copy [InputStream Path]
  [input output opts] (do-copy input (io/output-stream output) opts))
(defmethod do-copy [Reader Path]
  [input output opts] (do-copy input (io/writer output) opts))
(defmethod do-copy [File Path]
  [input output opts] (do-copy input (io/output-stream output) opts))

(def ^:dynamic *temp-dir*
  "Default path to system temporary directory on the default
filesystem.  May be overridden in configuration via the property
`parkour.temp.dir`."
  "/tmp")

(defn ^:private run-id
  "A likely-unique user- and time-based string."
  []
  (let [user (System/getProperty "user.name")
        time (System/currentTimeMillis)
        rand (rand-int Integer/MAX_VALUE)]
    (str user "-" time "-" rand)))

(defn ^:private temp-root
  [conf] (path (conf/get conf "parkour.temp.dir" *temp-dir*)))

(defn ^:private new-temp-dir
  "Return path for a new temporary directory."
  [conf] (path (temp-root conf) (run-id)))

(def ^:private cancel-doe-method?
  "True iff the `Job` class has a static factory method."
  (->> FileSystem reflect/type-reflect :members
       (some #(= 'cancelDeleteOnExit (:name %)))))

(defmacro ^:private cancel-doe
  "Macro to cancel delete-on-exit when available."
  [& args]
  (if cancel-doe-method?
    `(.cancelDeleteOnExit ~@args)))

(defn with-temp-dir*
  "Function version of `with-temp-dir`."
  ([f] (with-temp-dir* nil f))
  ([conf f]
     (let [conf (or conf (conf/ig))
           temp-dir (new-temp-dir conf)
           fs (path-fs conf temp-dir)]
       (.mkdirs fs temp-dir)
       (.deleteOnExit fs temp-dir)
       (try
         (f temp-dir)
         (finally
           (.delete fs temp-dir true)
           (cancel-doe fs temp-dir))))))

(defmacro with-temp-dir
  "Run the forms in `body` with `temp-dir` bound to a Hadoop filesystem
temporary directory path, created via the optional `conf`."
  [[temp-dir conf] & body]
  `(with-temp-dir* ~conf (fn [~temp-dir] ~@body)))

(defn ^:private split-fragment
  [^URI uri]
  (let [fragment (.getFragment uri), uri-s (str uri), n (count uri-s)
        base (subs uri-s 0 (- n (count fragment) 1))]
    [fragment (URI. base)]))

(defn distcache-files
  "Retrieve map of existing distcache entries from `conf`."
  [conf]
  (->> (DistributedCache/getCacheFiles (conf/ig conf))
       (r/map split-fragment)
       (into {})))

(defn distcache!
  "Update Hadoop `conf` to merge the `uri-map` of local file paths to
URIs into the distributed cache configuration."
  [conf uri-map]
  (let [conf (doto (conf/ig conf)
               (DistributedCache/createSymlink))]
    (->> (into (distcache-files conf) uri-map)
         (map (fn [[local remote]]
                (.resolve (uri remote) (str "#" local))))
         (str/join ",")
         (conf/assoc! conf "mapred.cache.files"))))

(defn distcacher
  "Return a function for merging the `uri-map` of local paths to URIs
into the distributed cache files of a Hadoop configuration."
  [uri-map] (mpartial distcache! uri-map))

(defn with-copies*
  "Function form of `with-copies`."
  [conf uri-map f]
  (with-temp-dir [temp-dir conf]
    (let [conf (or conf (conf/ig)), uri-map (map-vals uri uri-map)
          temp-fs (path-fs conf temp-dir)
          uri-map (reduce (fn [result [local remote]]
                            (let [temp (path temp-dir local)]
                              (returning (assoc result local (uri temp))
                                (with-open [inf (input-stream conf remote),
                                            outf (.create temp-fs temp)]
                                  (io/copy inf outf)))))
                          {} uri-map)]
      (f uri-map))))

(defmacro with-copies
  "Copy the URI values of `uri-map` to a temporary directory on the
default Hadoop filesystem, optionally specified by `conf`.  Evaluate
`body` forms with `name` bound to the map of original `uri-map` keys
to new temporary paths."
  [[name uri-map conf] & body]
  `(with-copies* ~conf ~uri-map (fn [~name] ~@body)))

Fix some FileSystem/IO issues; NB -- need more tests.


(ns com.nomistech.clojure-the-language.c-800-libraries.s-106-matcher-combinators.matcher-generators-test
  (:require
   [clojure.test :refer [deftest is testing]]
   [matcher-combinators.matchers :as m]
   [matcher-combinators.test] ; adds support for `match?` and `thrown-match?` in `is` expressions
   ))

;;;; ___________________________________________________________________________
;;;; --- Notes ----

;;;; TODO: What is an `equals` matcher?
;;;; TODO: What is an `embeds` matcher?

;;;; ++use-of-mismatch++
;;;; We use `m/mismatch` to demo what would otherwise be failing tests.
;;;; Note that `m/mismatch` should generally be avoided.

;;;; ___________________________________________________________________________
;;;; ---- Scalars ----

(deftest most-scalars-use-equality-test
  ;; Most scalar values are interpreted as an `equals` matcher.
  (is (match? 37
              (+ 29 8)))
  (is (match? "abc"
              (str "a" "b" "c")))
  (is (match? :this/keyword
              (keyword "this" "keyword"))))

(deftest regular-expession-are-handled-specially-test
  (is (match? #"fox"
              "The quick brown fox jumps over the lazy dog")))

;;;; ___________________________________________________________________________
;;;; ---- Predicates ----

(deftest predicate-test
  ;; Functions are used as predicates.
  (is (match? even?
              1234))
  (is (match? not
              (= 1 2)))
  (is (match? inc ; not normally considered a predicate, but used as one here
              1)))

;;;; ___________________________________________________________________________
;;;; ---- Maps ----

(deftest maps-test

  ;; A map is interpreted as an `embeds` matcher, which ignores
  ;; un-specified keys.
  ;; - TODO: When you understand properly, maybe fix that comma.

  (testing "Bare map -- expected equal to actual"
    (is (match? {:a 1}
                {:a 1})))

  (testing "Bare map -- ignores unspecified keys"
    (is (match? {:a 1}
                {:a 1 :b 2})))

  (testing "Use m/absent to check for absence of a key"
    (is (match? {:a 1 :b m/absent}
                {:a 1}))
    (is (match? (m/mismatch ; see ++use-of-mismatch++ at top of file
                 {:a 1 :b m/absent})
                {:a 1 :b 2}))))

(deftest predicates-for-map-values-test
  (is (match? {:a even?}
              {:a 1234})))

;;;; ___________________________________________________________________________
;;;; ---- Sequences ----

(deftest sequences-test
  ;; A sequence is interpreted as an `equals` matcher, which specifies count and
  ;; order of matching elements. The elements are matched based on their types.

  (is (match? [1 2 3]
              [1 2 3]))
  (is (match? [1 even? 3]
              [1 2 3]))
  (is (match? [#"red"
               #"violet"]
              ["Roses are red"
               "Violets are ... violet"]))

  ;; Use `m/prefix` when you only care about the first n items.
  (is (match? (m/prefix [1 even?])
              [1 2 3]))

  ;; Use `m/in-any-order` when order doesn't matter.
  ;; NOTE: `m/in-any-order` is O(n!) because it compares every expected element
  ;; with every actual element in order to find a best-match for each one,
  ;; removing matched elements from both sequences as it goes.
  ;; Avoid applying this to long sequences.
  (is (match? (m/in-any-order [odd? odd? even?])
              [1 2 3])))

;;;; ___________________________________________________________________________
;;;; ---- Sets ----

(deftest sets-test
  ;; A set is interpreted as an `equals` matcher.
  ;; NOTE: matching sets is an O(n!) operation because it compares every
  ;; expected element with every actual element in order to find a best-match
  ;; for each one, removing matched elements from both sets as it goes.
  ;; Avoid applying this to large sets.

  (is (match? #{1 2 3} #{3 2 1}))
  (is (match? #{odd? even?} #{1 2}))

  ;; Use `m/set-equals` to repeat predicates.
  (is (match? (m/set-equals [odd? odd? 2]) #{1 2 3})))

;;;; ___________________________________________________________________________
;;;; ---- Nested data structures ----

(deftest nested-test
  ;; Maps, sequences and sets follow the same semantics whether at the top level
  ;; or nested within a structure.
  (is (match? {:a {:z even?}
               :b [1 even? 3]}
              {:a {:z 1234}
               :b [1 2 3]
               :c :this-is-all-very-cool})))

;;;; ___________________________________________________________________________
;;;; ---- Explicit matchers ----

(deftest match-with-explicit-matchers-test
  ;; TODO: When is this useful? Just /eg/ `(is (match? 37 (+ 29 8)))`
  ;;       works fine.
  (is (match? (m/equals 37)
              (+ 29 8)))
  (is (match? (m/regex #"fox")
              "The quick brown fox jumps over the lazy dog"))
  (is (match? (m/pred even?)
              1234)) ; TODO: I guess we need this in contexts where `even?` would not be treated as a pred -- but what are those contexts?
  )

(deftest equals-overrides-predicate-test
  (is (match? (m/equals even?)
              even?)))

(deftest equals-overrides-map-embeds-test
  (testing "Use m/equals for exact match"
    (is (match? (m/equals {:a 1 :b 2})
                {:a 1 :b 2}))
    (is (match? (m/mismatch ; see ++use-of-mismatch++ at top of file
                 (m/equals {:a 1}))
                {:a 1 :b 2}))))

(deftest predicates-within-equals-test
  (is (match? (m/equals {:a 1 :b even?})
              {:a 1 :b 1234})))

(deftest WIP-embeds-test ; TODO
  (is (match? (m/embeds [1 3 5])
              [1 2 3 4 5])))

;;;; ___________________________________________________________________________
;;;; ---- Exceptions ----

(deftest exception-matching-test
  (is (thrown-match? clojure.lang.ExceptionInfo
                     {:foo 1}
                     (throw (ex-info "Boom!" {:foo 1 :bar 2})))))

;;;; ___________________________________________________________________________
;;;; ---- More ----

;;;; TODO: There's more. Continue going through the documentation at
;;;;       https://github.com/nubank/matcher-combinators and adding
;;;;       examples here.

(ns com.nomistech.clojure-the-language.c-800-libraries.s-106-matcher-combinators.matcher-generators-test
  (:require
   [clojure.test :refer [deftest is testing]]
   [matcher-combinators.matchers :as m]
   [matcher-combinators.test] ; adds support for `match?` and `thrown-match?` in `is` expressions
   ))

;;;; ___________________________________________________________________________
;;;; --- Notes ----

;;;; TODO: What is an `equals` matcher?
;;;; TODO: What is an `embeds` matcher?

;;;; ++use-of-mismatch++
;;;; We use `m/mismatch` to demo what would otherwise be failing tests.
;;;; Note that `m/mismatch` should generally be avoided.

;;;; ___________________________________________________________________________
;;;; ---- Scalars ----

(deftest most-scalars-use-equality-test
  ;; Most scalar values are interpreted as an `equals` matcher.
  (is (match? 37
              (+ 29 8)))
  (is (match? "abc"
              (str "a" "b" "c")))
  (is (match? :this/keyword
              (keyword "this" "keyword"))))

(deftest regular-expession-are-handled-specially-test
  (is (match? #"fox"
              "The quick brown fox jumps over the lazy dog")))

;;;; ___________________________________________________________________________
;;;; ---- Predicates ----

(deftest predicate-test
  ;; Functions are used as predicates.
  (is (match? even?
              1234))
  (is (match? not
              (= 1 2)))
  (is (match? inc ; not normally considered a predicate, but used as one here
              1)))

;;;; ___________________________________________________________________________
;;;; ---- Maps ----

(deftest maps-test

  ;; A map is interpreted as an `embeds` matcher, which ignores
  ;; un-specified keys.
  ;; - TODO: When you understand properly, maybe fix that comma.

  (testing "Bare map -- expected equal to actual"
    (is (match? {:a 1}
                {:a 1})))

  (testing "Bare map -- ignores unspecified keys"
    (is (match? {:a 1}
                {:a 1 :b 2})))

  (testing "Use m/absent to check for absence of a key"
    (is (match? {:a 1 :b m/absent}
                {:a 1}))
    (is (match? (m/mismatch ; see ++use-of-mismatch++ at top of file
                 {:a 1 :b m/absent})
                {:a 1 :b 2}))))

(deftest predicates-for-map-values-test
  (is (match? {:a even?}
              {:a 1234})))

;;;; ___________________________________________________________________________
;;;; ---- Sequences ----

(deftest sequences-test
  ;; A sequence is interpreted as an `equals` matcher, which specifies count and
  ;; order of matching elements. The elements are matched based on their types.

  (is (match? [1 2 3]
              [1 2 3]))
  (is (match? [1 even? 3]
              [1 2 3]))
  (is (match? [#"red"
               #"violet"]
              ["Roses are red"
               "Violets are ... violet"]))

  ;; Use `m/prefix` when you only care about the first n items.
  (is (match? (m/prefix [1 even?])
              [1 2 3]))

  ;; Use `m/in-any-order` when order doesn't matter.
  ;; NOTE: `m/in-any-order` is O(n!) because it compares every expected element
  ;; with every actual element in order to find a best-match for each one,
  ;; removing matched elements from both sequences as it goes.
  ;; Avoid applying this to long sequences.
  (is (match? (m/in-any-order [odd? odd? even?])
              [1 2 3])))

;;;; ___________________________________________________________________________
;;;; ---- Sets ----

(deftest sets-test
  ;; A set is interpreted as an `equals` matcher.
  ;; NOTE: matching sets is an O(n!) operation because it compares every
  ;; expected element with every actual element in order to find a best-match
  ;; for each one, removing matched elements from both sets as it goes.
  ;; Avoid applying this to large sets.

  (is (match? #{1 2 3} #{3 2 1}))
  (is (match? #{odd? even?} #{1 2}))

  ;; Use `m/set-equals` to repeat predicates.
  (is (match? (m/set-equals [odd? odd? 2]) #{1 2 3})))

;;;; ___________________________________________________________________________
;;;; ---- Nested data structures ----

(deftest nested-test
  ;; Maps, sequences and sets follow the same semantics whether at the top level
  ;; or nested within a structure.
  (is (match? {:a {:z even?}
               :b [1 even? 3]}
              {:a {:z 1234}
               :b [1 2 3]
               :c :this-is-all-very-cool})))

;;;; ___________________________________________________________________________
;;;; ---- Explicit matchers ----

(deftest explicit-matchers-test
  (testing "Some examples that I think are never needed -- these are the defaults for the data types (TODO: Are there contexts where you would need these?)"
    (is (match? (m/equals 37)
                (+ 29 8)))
    (is (match? (m/regex #"fox")
                "The quick brown fox jumps over the lazy dog"))
    (is (match? (m/pred even?)
                1234))))

(deftest explicit-use-of-equals-test

  (testing "`m/equals` overrides default treatment of functions as predicates"
    (is (match? (m/equals even?)
                even?)))

  (testing "`m/equals` checks that all map entries are present"
    (is (match? (m/equals {:a 1 :b 2})
                {:a 1 :b 2}))
    (is (match? (m/mismatch ; see ++use-of-mismatch++ at top of file
                 (m/equals {:a 1}))
                {:a 1 :b 2})))

  (testing "The overriding does not effect how nested matching works"
    (is (match? (m/equals {:a 1 :b even?})
                {:a 1 :b 1234}))))

(deftest explicit-use-of-embeds-test ; TODO
  (is (match? (m/embeds [1 3 5])
              [1 2 3 4 5])))

;;;; ___________________________________________________________________________
;;;; ---- Exceptions ----

(deftest exception-matching-test
  (is (thrown-match? clojure.lang.ExceptionInfo
                     {:foo 1}
                     (throw (ex-info "Boom!" {:foo 1 :bar 2})))))

;;;; ___________________________________________________________________________
;;;; ---- More ----

;;;; TODO: There's more. Continue going through the documentation at
;;;;       https://github.com/nubank/matcher-combinators and adding
;;;;       examples here.

Improve "Explicit matchers" section

matcher-combinators: Improve "Explicit matchers" section


(ns lunch-time.screens.main-screen
  (:require [reagent.core :as r :refer [atom]]
            [re-frame.core :refer [subscribe dispatch]]
            [cljs-time.core :as time]
            [cljs-time.format :as time-format]
            [lunch-time.events]
            [lunch-time.subs]))

(def ReactNative (js/require "react-native"))

(def text (r/adapt-react-class (.-Text ReactNative)))
(def view (r/adapt-react-class (.-View ReactNative)))
(def image (r/adapt-react-class (.-Image ReactNative)))
(def touchable-highlight (r/adapt-react-class (.-TouchableHighlight ReactNative)))

(def logo-img (js/require "./images/cljs.png"))

(def format (time-format/formatter "hh:mm"))

(defn- lunch-complete? [start-time end-time]
  (and (not= @start-time nil) (not= @end-time nil)))

(defn main-screen []
  (let [start-time (subscribe [:get-start-time])
        end-time (subscribe [:get-end-time])]
    (fn []
      [view {:style {:flex-direction "column" :margin 40 :align-items "center"}}
       (when @start-time
         [text {:style {:font-size 30 :font-weight "100" :margin-bottom 20 :text-align "center"}} "Went to lunch at " (time-format/unparse format @start-time)])
       (when @end-time
         [text {:style {:font-size 30 :font-weight "100" :margin-bottom 20 :text-align "center"}} "Came back from lunch at " (time-format/unparse format @end-time)])
       (when (lunch-complete? start-time end-time)
         [text {:style {:font-size 30 :font-weight "100" :margin-bottom 20 :text-align "center"}} "You were at lunch for " (time/in-minutes (time/interval @start-time @end-time)) " minutes"])
       [image {:source logo-img
               :style  {:width 80 :height 80 :margin-bottom 30}}]
       (when (= nil @start-time)
         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
                               :on-press #(dispatch [:set-start-time (time/now)])}
          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Lunch time!"]])
       (when (and @start-time (= @end-time nil))
         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
                               :on-press #(dispatch [:set-end-time (time/now)])}
          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Back to work!"]])
       (when (lunch-complete? start-time end-time)
         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
                               :on-press #(do
                                            (dispatch [:set-end-time nil])
                                            (dispatch [:set-start-time nil]))}
          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Reset"]])])))

(ns lunch-time.screens.main-screen
  (:require [reagent.core :as r :refer [atom]]
            [re-frame.core :refer [subscribe dispatch]]
            [cljs-time.core :as time]
            [cljs-time.format :as time-format]
            [lunch-time.events]
            [lunch-time.subs]))

(def ReactNative (js/require "react-native"))

(def text (r/adapt-react-class (.-Text ReactNative)))
(def view (r/adapt-react-class (.-View ReactNative)))
(def image (r/adapt-react-class (.-Image ReactNative)))
(def touchable-highlight (r/adapt-react-class (.-TouchableHighlight ReactNative)))

(def logo-img (js/require "./images/cljs.png"))

(def format (time-format/formatter "HH:mm"))

(defn- lunch-complete? [start-time end-time]
  (and (not= @start-time nil) (not= @end-time nil)))

(defn main-screen []
  (let [start-time (subscribe [:get-start-time])
        end-time (subscribe [:get-end-time])]
    (fn []
      [view {:style {:flex-direction "column" :margin 40 :align-items "center"}}
       (when @start-time
         [text {:style {:font-size 30 :font-weight "100" :margin-bottom 20 :text-align "center"}} "Went to lunch at " (time-format/unparse format (time/to-default-time-zone @start-time))])
       (when @end-time
         [text {:style {:font-size 30 :font-weight "100" :margin-bottom 20 :text-align "center"}} "Came back from lunch at " (time-format/unparse format (time/to-default-time-zone @end-time))])
       (when (lunch-complete? start-time end-time)
         [text {:style {:font-size 30 :font-weight "100" :margin-bottom 20 :text-align "center"}} "You were at lunch for " (time/in-minutes (time/interval @start-time @end-time)) " minutes"])
       [image {:source logo-img
               :style  {:width 80 :height 80 :margin-bottom 30}}]
       (when (= nil @start-time)
         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
                               :on-press #(dispatch [:set-start-time (time/now)])}
          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Lunch time!"]])
       (when (and @start-time (= @end-time nil))
         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
                               :on-press #(dispatch [:set-end-time (time/now)])}
          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Back to work!"]])
       (when (lunch-complete? start-time end-time)
         [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5}
                               :on-press #(do
                                            (dispatch [:set-end-time nil])
                                            (dispatch [:set-start-time nil]))}
          [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Reset"]])])))

Use current time zone to display the times. Use 24h format.


(ns pc.init
  (:require pc.assets
            pc.datomic
            pc.datomic.migrations
            pc.datomic.schema
            pc.email
            pc.less
            pc.logging
            pc.models.chat-bot
            pc.nrepl
            pc.server
            pc.statsd
            pc.repl
            pc.datomic.admin-db
            pc.http.admin)
  (:gen-class))

(defn init-fns []
  [#'pc.logging/init
   #'pc.nrepl/init
   #'pc.statsd/init
   #'pc.less/init
   #'pc.datomic/init
   #'pc.datomic.schema/init
   #'pc.datomic.migrations/init
   #'pc.models.chat-bot/init
   #'pc.assets/init
   #'pc.email/init
   #'pc.server/init
   #'pc.datomic.admin-db/init
   #'pc.http.admin/init])

(defn pretty-now []
  (.toLocaleString (java.util.Date.)))

(defn init []
  (doseq [f (init-fns)]
    (println (pretty-now) f)
    (f)))

(defn -main []
  (init)
  (println (pretty-now) "done"))

(defn shutdown []
  (pc.datomic/shutdown)
  (pc.server/shutdown))

(ns pc.init
  (:require pc.assets
            pc.cache
            pc.datomic
            pc.datomic.admin-db
            pc.datomic.migrations
            pc.datomic.schema
            pc.email
            pc.http.admin
            pc.less
            pc.logging
            pc.models.chat-bot
            pc.nrepl
            pc.repl
            pc.server
            pc.statsd)
  (:gen-class))

(defn init-fns []
  [#'pc.logging/init
   #'pc.nrepl/init
   #'pc.statsd/init
   #'pc.less/init
   #'pc.datomic/init
   #'pc.datomic.schema/init
   #'pc.datomic.migrations/init
   #'pc.models.chat-bot/init
   #'pc.assets/init
   #'pc.email/init
   #'pc.cache/init
   #'pc.server/init
   #'pc.datomic.admin-db/init
   #'pc.http.admin/init])

(defn pretty-now []
  (.toLocaleString (java.util.Date.)))

(defn init []
  (doseq [f (init-fns)]
    (println (pretty-now) f)
    (f)))

(defn -main []
  (init)
  (println (pretty-now) "done"))

(defn shutdown []
  (pc.datomic/shutdown)
  (pc.server/shutdown))

add cache to init

add cache to init


(ns vault.tool
  (:require (clojure
              [edn :as edn]
              [pprint :refer [pprint]])
            [vault.cli :refer [command execute]]
            (vault.store
              [file :refer [file-store]])
            (vault.tool
              [config :as config]
              [blob :as blob-tool]))
  (:gen-class :main true))

;; UTILITY ACTIONS

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

(defn- not-yet-implemented
  [opts args]
  (println "This command is not yet implemented")
  (System/exit 1))

;; COMMAND STRUCTURE

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

    ["--config" "Set path to vault configuration."
     :default config/default-path]
    ["--store" "Select blob store to use."
     :parse-fn keyword]
    ["-v" "--verbose" "Show extra debugging messages."
     :flag true :default false]
    ["-h" "--help" "Show usage information."
     :flag true :default false]

    (init config/initialize)

    (command "config <type>"
      "Show configuration information."

      (command "stores"
        "List the available blob stores."
        (action config/list-blob-stores)))

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

      (init config/setup-blob-store)

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

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

        (action blob-tool/list-blobs))

      (command "stat <blobref>"
        "Show information about a stored blob."

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

        (action blob-tool/blob-info))

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

      (command "put < blob.dat"
        "Store a blob of data read from stdin and print the resulting blobref."
        (action blob-tool/put-blob)))

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

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

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

        (action not-yet-implemented))

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

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

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

(ns vault.tool
  (:require (clojure
              [edn :as edn])
            [vault.cli :refer [command execute]]
            [vault.data.print :refer [pprint cprint]]
            (vault.tool
              [config :as config]
              [blob :as blob-tool]))
  (:gen-class :main true))

;; UTILITY ACTIONS

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

(defn- not-yet-implemented
  [opts args]
  (println "This command is not yet implemented")
  (System/exit 1))

;; COMMAND STRUCTURE

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

    ["--config" "Set path to vault configuration."
     :default config/default-path]
    ["--store" "Select blob store to use."
     :parse-fn keyword]
    ["-v" "--verbose" "Show extra debugging messages."
     :flag true :default false]
    ["-h" "--help" "Show usage information."
     :flag true :default false]

    (init config/initialize)

    (command "config <type>"
      "Show configuration information."

      (command "dump"
        "Prints out a raw version of the configuration map."

        ["--pretty" "Formats the info over multiple lines for easier viewing."
         :flag true :default false]

        (action [opts args]
          (if (:pretty opts)
            (cprint opts)
            (prn opts))))

      (command "stores"
        "List the available blob stores."
        (action config/list-blob-stores)))

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

      (init config/setup-blob-store)

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

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

        (action blob-tool/list-blobs))

      (command "stat <blobref>"
        "Show information about a stored blob."

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

        (action blob-tool/blob-info))

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

      (command "put < blob.dat"
        "Store a blob of data read from stdin and print the resulting blobref."
        (action blob-tool/put-blob)))

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

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

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

        (action not-yet-implemented))

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

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

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

Add 'config dump' command to show config map.


(ns trellis.test-sente
  (:use clojure.test)
  (:require [clojure.java.jdbc :as j])
  (:require
      [com.stuartsierra.component :as component]
      [trellis.sente :as sente]
      [trellis.webserver :as web]
      [trellis.component :refer [with-component]])
  (:use [mikera.cljutils error]))

(deftest sente-test
  (let [s (sente/sente-server)]
    (with-component [s s]
      (is (:ch-recv s)))))

(ns trellis.test-sente
  (:use clojure.test)
  (:require [clojure.java.jdbc :as j])
  (:require
      [com.stuartsierra.component :as component]
      [trellis.sente :as sente]
      [trellis.webserver :as web]
      [trellis.component :refer [with-component]])
  (:use [mikera.cljutils error]))

(deftest sente-test
  (let [s (sente/sente-server)]
    (with-component [s s]
      (is (:ch-recv s))
      ;; TODO: figure out how to test with a Clojure client
      (let []
        ))))

add testing TODO

add testing TODO


(ns example.blues
  (:use overtone.live)
  (:use [overtone.inst synth drum]))

(definst beep [note 60 vol 0.2]
  (let [freq (midicps note)
        src (sin-osc freq)
        env (env-gen (perc 0.3 2) :action FREE)]
    (* vol src env)))

(def ps (atom []))

(defn play [instr pitch-classes]
  (doseq [pitch pitch-classes]
    (swap! ps conj pitch)
    (instr pitch)))

(defn play-seq [count instr notes durs time odds]
  (when (and notes durs)
    (let [dur   (- (/ (first durs) 1.2) 10 (rand-int 20))
          pitch (first notes)
          n-time (+ time dur)]
      (at time
          (when (> (rand) (- 1 odds))
            (tom))

          (when (zero? count)
            (kick)
            (bass (midi->hz (first pitch)) (* 4 (/ dur 1000.0))))

          (when (#{1 3} count)
            (if (> (rand) (- 1 odds))
              (bass (midi->hz (first pitch)) (* 4 (/ dur 1000.0 2)) 0.1))
            (snare))

          (when (= 2 count)
            (kick))

          (play instr pitch))
      (at (+ time (* 0.5 dur))
          (c-hat 0.1))
      (apply-at n-time #'play-seq
                [(mod (inc count) 4) instr (next notes) (next durs) n-time odds]))))

; TODO: Strum the chord

(def blues-chords
  [:i  :major
   :iv :major
   :i  :major7
   :i  :7
   :iv :major
   :iv :7
   :i  :major
   :i  :major
   :v  :major
   :v  :7
   :i  :major
   :v  :7])

; Bass note on the one
(def bass-line (map first (partition 4 blues-chords)))

(defn progression [chord-seq key-note octave scale]
  (for [[roman-numeral chord-type] (partition 2 chord-seq)]
    (chord (+ (resolve-note (str (name key-note) octave))
              (degree->interval roman-numeral scale))
           chord-type)))

(defn blue-beep []
  (play-seq 0 beep
            (cycle (mapcat #(repeat 4 %) (map sort (progression blues-chords :a 3 :ionian))))
            (cycle [1200 1204 1195 1206])
            (now)
            0.2))

                                        ;(blue-beep)
(stop)

; Be sure to try moving the mouse around...
(defn blue-ks1 []
  (play-seq 0 ks1
            (cycle (map sort (progression blues-chords :a 2 :ionian)))
            (take 80 (map #(* 1.5 %) (cycle [530 524 532 528])))
            (now)
            0.5))

(defn blue-ks1-demo []
  (play-seq 0 ks1-demo
            (cycle (map sort (progression blues-chords :a 2 :ionian)))
            (take 80 (map #(* 1.5 %) (cycle [530 524 532 528])))
            (now)
            0.5))

;(blue-ks1)

(ns example.blues
  (:use overtone.live)
  (:use [overtone.inst synth drum]))

(definst beep [note 60 vol 0.2]
  (let [freq (midicps note)
        src (sin-osc freq)
        env (env-gen (perc 0.3 2) :action FREE)]
    (* vol src env)))

(def ps (atom []))

(defn play-blues [instr pitch-classes]
  (doseq [pitch pitch-classes]
    (swap! ps conj pitch)
    (instr pitch)))

(defn play-seq [count instr notes durs time odds]
  (when (and notes durs)
    (let [dur   (- (/ (first durs) 1.2) 10 (rand-int 20))
          pitch (first notes)
          n-time (+ time dur)]
      (at time
          (when (> (rand) (- 1 odds))
            (tom))

          (when (zero? count)
            (kick)
            (bass (midi->hz (first pitch)) (* 4 (/ dur 1000.0))))

          (when (#{1 3} count)
            (if (> (rand) (- 1 odds))
              (bass (midi->hz (first pitch)) (* 4 (/ dur 1000.0 2)) 0.1))
            (snare))

          (when (= 2 count)
            (kick))

          (play-blues instr pitch))
      (at (+ time (* 0.5 dur))
          (c-hat 0.1))
      (apply-at n-time #'play-seq
                [(mod (inc count) 4) instr (next notes) (next durs) n-time odds]))))

; TODO: Strum the chord

(def blues-chords
  [:i  :major
   :iv :major
   :i  :major7
   :i  :7
   :iv :major
   :iv :7
   :i  :major
   :i  :major
   :v  :major
   :v  :7
   :i  :major
   :v  :7])

; Bass note on the one
(def bass-line (map first (partition 4 blues-chords)))

(defn progression [chord-seq key-note octave scale]
  (for [[roman-numeral chord-type] (partition 2 chord-seq)]
    (chord (+ (note (str (name key-note) octave))
              (degree->interval roman-numeral scale))
           chord-type)))

(defn blue-beep []
  (play-seq 0 beep
            (cycle (mapcat #(repeat 4 %) (map sort (progression blues-chords :a 3 :ionian))))
            (cycle [1200 1204 1195 1206])
            (now)
            0.2))

                                        ;(blue-beep)
(stop)

; Be sure to try moving the mouse around...
(defn blue-ks1 []
  (play-seq 0 ks1
            (cycle (map sort (progression blues-chords :a 2 :ionian)))
            (take 80 (map #(* 1.5 %) (cycle [530 524 532 528])))
            (now)
            0.5))

(defn blue-ks1-demo []
  (play-seq 0 ks1-demo
            (cycle (map sort (progression blues-chords :a 2 :ionian)))
            (take 80 (map #(* 1.5 %) (cycle [530 524 532 528])))
            (now)
            0.5))

;;(blue-ks1)
;;(blue-ks1-demo)
;;(stop)

fix blues example

fix blues example


(ns open-company.integration.company.company-retrieval
  (:require [midje.sweet :refer :all]
            [open-company.lib.rest-api-mock :as mock]
            [open-company.lib.hateoas :as hateoas]
            [open-company.lib.resources :as r]
            [open-company.lib.db :as db]
            [open-company.db.pool :as pool]
            [open-company.lib.test-setup :as ts]
            [open-company.api.common :as common-api]
            [open-company.resources.common :as common]
            [open-company.resources.company :as company]
            [open-company.resources.section :as section]
            [open-company.representations.common :refer (GET)]
            [open-company.representations.company :as company-rep]
            [open-company.representations.section :as section-rep]))

;; ----- Test Cases -----

;; GETing a company with the REST API

;; The system should return a representation of the company and handle the following scenarios:

;; OPTIONS

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no matching company slug - 404 Not Found

;; success - matching JWToken - 204 No Content
;; success - no JWToken - 204 No Content
;; success - not matching JWToken - 204 No Content

;; GET

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no matching company slug - 404 Not Found

;; success - matching JWToken - 200 OK
;; success - no JWToken - 200 OK
;; success - not matching JWToken - 200 OK

;; TODO
;; no accept
;; no content type
;; no charset
;; wrong accept
;; wrong content type
;; wrong charset

;; ----- Tests -----

(def limited-options "OPTIONS, GET")
(def full-options "OPTIONS, GET, PATCH, DELETE")

(with-state-changes [(before :contents (ts/setup-system!))
                     (after :contents (ts/teardown-system!))
                     (before :facts (pool/with-pool [conn (-> @ts/test-system :db-pool :pool)]
                                      (company/delete-all-companies! conn)
                                      (company/create-company! conn (company/->company r/open r/coyote))
                                      (section/put-section conn r/slug :update r/text-section-1 r/coyote)
                                      (section/put-section conn r/slug :finances r/finances-section-1 r/coyote)
                                      (section/put-section conn r/slug :team r/text-section-2 r/coyote)
                                      (section/put-section conn r/slug :help r/text-section-1 r/coyote)
                                      (section/put-section conn r/slug :diversity r/text-section-2 r/coyote)
                                      (section/put-section conn r/slug :values r/text-section-1 r/coyote)))
                     (after :facts (pool/with-pool [conn (-> @ts/test-system :db-pool :pool)]
                                     (company/delete-all-companies! conn)))]

  (facts "about available options for retrieving a company"

    (fact "with a bad JWToken"
      (let [response (mock/api-request :options (company-rep/url r/open) {:auth mock/jwtoken-bad})]
        (:status response) => 401
        (:body response) => common-api/unauthorized))

    (fact "with no company matching the company slug"
      (let [response (mock/api-request :options (company-rep/url "foo"))]
        (:status response) => 404
        (:body response) => ""))

    (fact "with no JWToken"
      (let [response (mock/api-request :options (company-rep/url r/open) {:skip-auth true})]
        (:status response) => 204
        (:body response) => ""
        ((:headers response) "Allow") => limited-options))

    (fact "with an organization that doesn't match the company"
      (let [response (mock/api-request :options (company-rep/url r/open) {:auth mock/jwtoken-sartre})]
        (:status response) => 204
        (:body response) => ""
        ((:headers response) "Allow") => limited-options))

    (fact "with a user's org in a JWToken that matches the company's org"
      (let [response (mock/api-request :options (company-rep/url r/open))]
        (:status response) => 204
        (:body response) => ""
        ((:headers response) "Allow") => full-options)))

  (facts "about failing to retrieve a company"

    (fact "with an invalid JWToken"
      (let [response (mock/api-request :get (company-rep/url r/open) {:auth mock/jwtoken-bad})]
        (:status response) => 401
        (:body response) => common-api/unauthorized))

    (fact "that doesn't exist"
      (let [response (mock/api-request :get (company-rep/url "foo"))]
        (:status response) => 404
        (:body response) => "")))

  (facts "about retrieving a company"

    (fact "that does match the retrieving user's organization"
      (let [response (mock/api-request :get (company-rep/url r/open))
            body (mock/body-from-response response)]
        (:status response) => 200
        (:name body) => (:name r/open)
        (:slug body) => (:slug r/open)
        (:org-id body) => nil ; verify no org-id
        (:categories body) => (map name common/category-names)
        (:sections body) =>
          {:company ["diversity" "values"], :progress ["help" "update" "team" "finances
          "]}
        ;; verify section contents
        (:update body) => (contains r/text-section-1)
        (:finances body) => (contains r/finances-section-1)
        (:team body) => (contains r/text-section-2)
        (:help body) => (contains r/text-section-1)
        (:diversity body) => (contains r/text-section-2)
        (:values body) => (contains r/text-section-1)
         ;; verify each section has all the HATEOAS links
        (doseq [section-key (map keyword (flatten (vals (:sections body))))]
          (hateoas/verify-section-links (:slug r/open) section-key (:links (body section-key))))
        ;; verify the company has all the HATEOAS links
        (hateoas/verify-company-links (:slug r/open) (:links body))))

    (fact "anonymously with no JWToken"
      ;; retrieve with no JWToken
      (let [response (mock/api-request :get (company-rep/url r/open) {:skip-auth true})
            body (mock/body-from-response response)]
        (:status response) => 200
        (:sections body) =>
          {:company ["diversity" "values"], :progress ["help" "update" "team" "finances"]}
        ;; verify each section has only a self HATEOAS link
        (doseq [section-key (map keyword (flatten (vals (:sections body))))]
          (count (:links (body section-key))) => 1
          (hateoas/verify-link "self" GET (section-rep/url (:slug r/open) section-key)
            section-rep/media-type (:links (body section-key))))
        ;; verify the company has only a self HATEOAS link
        (count (:links body)) => 2
        (hateoas/verify-link "self" GET (company-rep/url (:slug r/open)) company-rep/media-type (:links body))))

    (fact "that doesn't match the retrieving user's organization"
      ;; retrieve with Sartre (different org)
      (let [response (mock/api-request :get (company-rep/url r/open) {:auth mock/jwtoken-sartre})
            body (mock/body-from-response response)]
        (:status response) => 200
        (:sections body) =>
          {:company ["diversity" "values"], :progress ["help" "update" "team" "finances"]}
        ;; verify each section has only a self HATEOAS link
        (doseq [section-key (map keyword (flatten (vals (:sections body))))]
          (count (:links (body section-key))) => 1
          (hateoas/verify-link "self" GET (section-rep/url (:slug r/open) section-key)
            section-rep/media-type (:links (body section-key))))
        ;; verify the company has only a self HATEOAS link
        (count (:links body)) => 2
        (hateoas/verify-link "self" GET (company-rep/url (:slug r/open)) company-rep/media-type (:links body))))))

(ns open-company.integration.company.company-retrieval
  (:require [midje.sweet :refer :all]
            [open-company.lib.rest-api-mock :as mock]
            [open-company.lib.hateoas :as hateoas]
            [open-company.lib.resources :as r]
            [open-company.lib.db :as db]
            [open-company.db.pool :as pool]
            [open-company.lib.test-setup :as ts]
            [open-company.api.common :as common-api]
            [open-company.resources.common :as common]
            [open-company.resources.company :as company]
            [open-company.resources.section :as section]
            [open-company.representations.common :refer (GET)]
            [open-company.representations.company :as company-rep]
            [open-company.representations.section :as section-rep]))

;; ----- Test Cases -----

;; GETing a company with the REST API

;; The system should return a representation of the company and handle the following scenarios:

;; OPTIONS

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no matching company slug - 404 Not Found

;; success - matching JWToken - 204 No Content
;; success - no JWToken - 204 No Content
;; success - not matching JWToken - 204 No Content

;; GET

;; fail - invalid JWToken - 401 Unauthorized
;; fail - no matching company slug - 404 Not Found

;; success - matching JWToken - 200 OK
;; success - no JWToken - 200 OK
;; success - not matching JWToken - 200 OK

;; TODO
;; no accept
;; no content type
;; no charset
;; wrong accept
;; wrong content type
;; wrong charset

;; ----- Tests -----

(def limited-options "OPTIONS, GET")
(def full-options "OPTIONS, GET, PATCH, DELETE")

(with-state-changes [(before :contents (ts/setup-system!))
                     (after :contents (ts/teardown-system!))
                     (before :facts (pool/with-pool [conn (-> @ts/test-system :db-pool :pool)]
                                      (company/delete-all-companies! conn)
                                      (company/create-company! conn (company/->company r/open r/coyote))
                                      (section/put-section conn r/slug :update r/text-section-1 r/coyote)
                                      (section/put-section conn r/slug :finances r/finances-section-1 r/coyote)
                                      (section/put-section conn r/slug :team r/text-section-2 r/coyote)
                                      (section/put-section conn r/slug :help r/text-section-1 r/coyote)
                                      (section/put-section conn r/slug :diversity r/text-section-2 r/coyote)
                                      (section/put-section conn r/slug :values r/text-section-1 r/coyote)))
                     (after :facts (pool/with-pool [conn (-> @ts/test-system :db-pool :pool)]
                                     (company/delete-all-companies! conn)))]

  (facts "about available options for retrieving a company"

    (fact "with a bad JWToken"
      (let [response (mock/api-request :options (company-rep/url r/open) {:auth mock/jwtoken-bad})]
        (:status response) => 401
        (:body response) => common-api/unauthorized))

    (fact "with no company matching the company slug"
      (let [response (mock/api-request :options (company-rep/url "foo"))]
        (:status response) => 404
        (:body response) => ""))

    (fact "with no JWToken"
      (let [response (mock/api-request :options (company-rep/url r/open) {:skip-auth true})]
        (:status response) => 204
        (:body response) => ""
        ((:headers response) "Allow") => limited-options))

    (fact "with an organization that doesn't match the company"
      (let [response (mock/api-request :options (company-rep/url r/open) {:auth mock/jwtoken-sartre})]
        (:status response) => 204
        (:body response) => ""
        ((:headers response) "Allow") => limited-options))

    (fact "with a user's org in a JWToken that matches the company's org"
      (let [response (mock/api-request :options (company-rep/url r/open))]
        (:status response) => 204
        (:body response) => ""
        ((:headers response) "Allow") => full-options)))

  (facts "about failing to retrieve a company"

    (fact "with an invalid JWToken"
      (let [response (mock/api-request :get (company-rep/url r/open) {:auth mock/jwtoken-bad})]
        (:status response) => 401
        (:body response) => common-api/unauthorized))

    (fact "that doesn't exist"
      (let [response (mock/api-request :get (company-rep/url "foo"))]
        (:status response) => 404
        (:body response) => "")))

  (facts "about retrieving a company"

    (fact "that does match the retrieving user's organization"
      (let [response (mock/api-request :get (company-rep/url r/open))
            body (mock/body-from-response response)]
        (:status response) => 200
        (:name body) => (:name r/open)
        (:slug body) => (:slug r/open)
        (:org-id body) => nil ; verify no org-id
        (:categories body) => (map name common/category-names)
        (:sections body) =>
          {:company ["diversity" "values"], :progress ["update" "finances" "team" "help"]}
        ;; verify section contents
        (:update body) => (contains r/text-section-1)
        (:finances body) => (contains r/finances-section-1)
        (:team body) => (contains r/text-section-2)
        (:help body) => (contains r/text-section-1)
        (:diversity body) => (contains r/text-section-2)
        (:values body) => (contains r/text-section-1)
         ;; verify each section has all the HATEOAS links
        (doseq [section-key (map keyword (flatten (vals (:sections body))))]
          (hateoas/verify-section-links (:slug r/open) section-key (:links (body section-key))))
        ;; verify the company has all the HATEOAS links
        (hateoas/verify-company-links (:slug r/open) (:links body))))

    (fact "anonymously with no JWToken"
      ;; retrieve with no JWToken
      (let [response (mock/api-request :get (company-rep/url r/open) {:skip-auth true})
            body (mock/body-from-response response)]
        (:status response) => 200
        (:sections body) =>
          {:company ["diversity" "values"], :progress ["update" "finances" "team" "help"]}
        ;; verify each section has only a self HATEOAS link
        (doseq [section-key (map keyword (flatten (vals (:sections body))))]
          (count (:links (body section-key))) => 1
          (hateoas/verify-link "self" GET (section-rep/url (:slug r/open) section-key)
            section-rep/media-type (:links (body section-key))))
        ;; verify the company has only a self HATEOAS link
        (count (:links body)) => 2
        (hateoas/verify-link "self" GET (company-rep/url (:slug r/open)) company-rep/media-type (:links body))))

    (fact "that doesn't match the retrieving user's organization"
      ;; retrieve with Sartre (different org)
      (let [response (mock/api-request :get (company-rep/url r/open) {:auth mock/jwtoken-sartre})
            body (mock/body-from-response response)]
        (:status response) => 200
        (:sections body) =>
          {:company ["diversity" "values"], :progress ["update" "finances" "team" "help"]}
        ;; verify each section has only a self HATEOAS link
        (doseq [section-key (map keyword (flatten (vals (:sections body))))]
          (count (:links (body section-key))) => 1
          (hateoas/verify-link "self" GET (section-rep/url (:slug r/open) section-key)
            section-rep/media-type (:links (body section-key))))
        ;; verify the company has only a self HATEOAS link
        (count (:links body)) => 2
        (hateoas/verify-link "self" GET (company-rep/url (:slug r/open)) company-rep/media-type (:links body))))))

Fix tests.

Fix tests.


(ns hundred-pushups.datetime-test
  (:require [clojure.test :refer [testing deftest is]]
            [clojure.spec :as s]
            [hundred-pushups.datetime :refer [inst ct-fmt->moment-fmt now inst->str local-date later-on-same-day?]]
            [com.gfredericks.test.chuck.clojure-test :refer [checking]]))

(deftest now-test
  (is (inst? (now))))

(deftest inst-test
  (is (inst? (inst 0)))
  (is (inst? (inst 100000000000000)))
  (is (inst? (inst "2016-01-01"))))

(deftest ct-fmt->moment-fmt-test
  (is (= "YYYY" (ct-fmt->moment-fmt "YYYY")))
  (is (= "DD" (ct-fmt->moment-fmt "dd"))))

(deftest inst->str-test
  (is (= "19700101T000000Z" (inst->str (inst 0))))
  (is (= "19700112T134640Z" (inst->str (inst 1000000000)))))

(deftest later-on-same-day?-test
  (is (= true (later-on-same-day? (inst "2016-02-01T00:00:00Z") (inst "2016-02-01T00:00:00Z"))))
  (is (= true (later-on-same-day? (inst "2016-02-01T00:00:00") (inst "2016-02-01T00:00:01"))))
  ;; TODO - fix on CLJS!!
  ;;(is (= false (later-on-same-day? (inst "2016-02-01T00:00:02") (inst "2016-02-01T00:00:01"))))
  (is (= false (later-on-same-day? (inst "2016-02-01T00:00:00") (inst "2016-02-02T00:00:00"))))
  (is (= false (later-on-same-day? (inst "2016-02-01T00:00:00") (inst "2016-01-01T00:00:00")))))

;; FIXME - you can't set time zones in CLJS
;; https://github.com/andrewmcveigh/cljs-time/issues/14
;; so I'm not sure how to test this without breaking CI
#?(:clj
   (deftest local-date-test
     (testing "returns date based on timezone"
       (is (= [2016 01 01]
              (local-date #inst "2016-01-02T01:01:01Z")))
       (is (= [2016 01 02]
              (local-date #inst "2016-01-02T12:01:01Z")))
       (is (= [1969 12 31]
              (local-date (inst 0))))
       (is (= [2015 12 31]
              (local-date (inst "2016-01-01T00:00:00Z")))))))

(ns hundred-pushups.datetime-test
  (:require [clojure.test :refer [testing deftest is]]
            [clojure.spec :as s]
            [hundred-pushups.datetime :refer [inst ct-fmt->moment-fmt now inst->str local-date later-on-same-day?]]
            [com.gfredericks.test.chuck.clojure-test :refer [checking]]))

(deftest now-test
  (is (inst? (now))))

(deftest inst-test
  (is (inst? (inst 0)))
  (is (inst? (inst 100000000000000)))
  (is (inst? (inst "2016-01-01"))))

(deftest ct-fmt->moment-fmt-test
  (is (= "YYYY" (ct-fmt->moment-fmt "YYYY")))
  (is (= "DD" (ct-fmt->moment-fmt "dd"))))

(deftest inst->str-test
  (is (= "19700101T000000Z" (inst->str (inst 0))))
  (is (= "19700112T134640Z" (inst->str (inst 1000000000)))))

(deftest later-on-same-day?-test
  (is (= true (later-on-same-day? (inst "2016-02-01T00:00:00Z") (inst "2016-02-01T00:00:00Z"))))
  (is (= true (later-on-same-day? (inst "2016-02-01T00:00:00") (inst "2016-02-01T00:00:01"))))
  ;; TODO - fix on CLJS!!
  ;;(is (= false (later-on-same-day? (inst "2016-02-01T00:00:02") (inst "2016-02-01T00:00:01"))))
  (is (= false (later-on-same-day? (inst "2016-02-01T00:00:00") (inst "2016-02-02T00:00:00"))))
  (is (= false (later-on-same-day? (inst "2016-02-01T00:00:00") (inst "2016-01-01T00:00:00")))))

;; FIXME - you can't set time zones in CLJS
;; https://github.com/andrewmcveigh/cljs-time/issues/14
;; so I'm not sure how to test this without breaking CI
#?(:clj
   (deftest local-date-test
     (testing "returns date based on timezone"
       (is (= [2016 01 01]
              (local-date #inst "2016-01-02T01:01:01Z" "America/Denver")))
       (is (= [2016 01 02]
              (local-date #inst "2016-01-02T12:01:01Z" "America/Denver")))
       (is (= [1969 12 31]
              (local-date (inst 0))))
       (is (= [2015 12 31]
              (local-date (inst "2016-01-01T00:00:00Z") "America/Denver"))))))

Fix CLJ tests

Fix CLJ tests


(ns org.akvo.flow-api.datastore.stats
  (:require [akvo.commons.gae :as gae]
            [akvo.commons.gae.query :as q]
            [cheshire.core :as json]
            [org.akvo.flow-api.anomaly :as anomaly]
            [org.akvo.flow-api.datastore :as ds]
            [kixi.stats.core :as kixi]
            [redux.core :refer [fuse]])
  (:import [com.google.appengine.api.datastore DatastoreService Entity]))

(defn get-form-instance-ids [^DatastoreService dss ^Long formId]
  (into []
        (map ds/id)
        (ds/reducible-gae-query dss
                                {:kind "SurveyInstance"
                                 :filter (q/= "surveyId" formId)
                                 :keys-only? true}
                                {})))

(defn parse-value [v]
  (try
    (json/parse-string v true)
    (catch Exception _)))

(defn validate-question
  [^Entity question form-id question-id]
  (when (nil? question)
    (anomaly/not-found "Question not found" {}))
  (when (not= (.getProperty question "surveyId") form-id)
    (anomaly/bad-request (format "Question %s does not belong to form %s" question-id form-id) {}))
  (when (nil? (#{"OPTION" "NUMBER"} (.getProperty question "type")))
    (anomaly/bad-request "Not an [Option|Number] question" {})))

(defn get-answers-by-form-instance-id [ds form-instance-id question-id]
  (flatten
   (into []
         (map #(parse-value (.getProperty ^Entity % "value")))
         (ds/reducible-gae-query ds
                                 {:kind "QuestionAnswerStore"
                                  :filter (q/and
                                           (q/= "questionID" (str question-id))
                                           (q/= "surveyInstanceId" form-instance-id))
                                  :projections {"value" String}}
                                 {}))))

(defn get-answers
  "Returns the answers (`QuestionAnswerStore`) filtered
  by available form instances (`SurveyInstance`).
  We apply the same approach of raw data report generation"
  [ds form-id question-id]
  (->> (get-form-instance-ids ds form-id)
       (reduce (fn [acc form-instance-id]
                 (into acc (get-answers-by-form-instance-id ds
                                                            form-instance-id
                                                            question-id)))
               [])))

(defn question-counts [ds {:keys [formId questionId]}]
  (let [question-id (Long/parseLong questionId)
        form-id (Long/parseLong formId)
        q (q/entity ds "Question" question-id)]
    (validate-question q form-id question-id)
    (->>
     (get-answers ds form-id question-id)
     (reduce (fn [acc {:keys [text]}]
               (if (contains? acc text)
                 (update acc text inc)
                 (assoc acc text 1)))
             {}))))

(defn number-question-stats [ds {:keys [formId questionId]}]
  (let [question-id (Long/parseLong questionId)
        form-id (Long/parseLong formId)
        q (q/entity ds "Question" question-id)]
    (validate-question q form-id question-id)
    (->> (get-answers ds form-id question-id)
         (transduce identity (fuse {:sd kixi/standard-deviation
                                    :max kixi/max
                                    :min kixi/min
                                    :mean kixi/mean
                                    :count kixi/count})))))

(comment
  (def ds-spec {:hostname "akvoflow-xx.appspot.com"
                :port 443
                :service-account-id "sa-akvoflow-xx@akvoflow-xx.iam.gserviceaccount.com"
                :private-key-file "/server-config/akvoflow-xx/akvoflow-xx.p12"})
  (gae/with-datastore [ds ds-spec]
    (doto (question-counts ds {:formId "313200912"
                               :questionId "311160912"}) prn))
  )

(ns org.akvo.flow-api.datastore.stats
  (:require [akvo.commons.gae :as gae]
            [akvo.commons.gae.query :as q]
            [cheshire.core :as json]
            [org.akvo.flow-api.anomaly :as anomaly]
            [org.akvo.flow-api.datastore :as ds]
            [kixi.stats.core :as kixi]
            [redux.core :refer [fuse]])
  (:import [com.google.appengine.api.datastore DatastoreService Entity]))

(defn get-form-instance-ids [^DatastoreService dss ^Long formId]
  (into []
        (map ds/id)
        (ds/reducible-gae-query dss
                                {:kind "SurveyInstance"
                                 :filter (q/= "surveyId" formId)
                                 :keys-only? true}
                                {})))

(defn parse-value [v]
  (try
    (json/parse-string v true)
    (catch Exception _)))

(defn validate-question
  [^Entity question form-id question-id]
  (when (nil? question)
    (anomaly/not-found "Question not found" {}))
  (when (not= (.getProperty question "surveyId") form-id)
    (anomaly/bad-request (format "Question %s does not belong to form %s" question-id form-id) {}))
  (when (nil? (#{"OPTION" "NUMBER"} (.getProperty question "type")))
    (anomaly/bad-request "Not an [Option|Number] question" {})))

(defn get-answers
  [ds form-id question-id]
  (let [form-instance-ids (set (get-form-instance-ids ds form-id))]
    (flatten
     (into []
           (comp
            (filter #(form-instance-ids (.getProperty ^Entity % "surveyInstanceId")))
            (map #(parse-value (.getProperty ^Entity % "value"))))
           (ds/reducible-gae-query ds
                                   {:kind "QuestionAnswerStore"
                                    :filter (q/= "questionID" (str question-id))
                                    :projections {"value" String
                                                  "surveyInstanceId" Long}}
                                   {})))))

(defn question-counts [ds {:keys [formId questionId]}]
  (let [question-id (Long/parseLong questionId)
        form-id (Long/parseLong formId)
        q (q/entity ds "Question" question-id)]
    (validate-question q form-id question-id)
    (->>
     (get-answers ds form-id question-id)
     (reduce (fn [acc {:keys [text]}]
               (if (contains? acc text)
                 (update acc text inc)
                 (assoc acc text 1)))
             {}))))

(defn number-question-stats [ds {:keys [formId questionId]}]
  (let [question-id (Long/parseLong questionId)
        form-id (Long/parseLong formId)
        q (q/entity ds "Question" question-id)]
    (validate-question q form-id question-id)
    (->>
     (get-answers ds form-id question-id)
     (transduce identity (fuse {:sd kixi/standard-deviation
                                :max kixi/max
                                :min kixi/min
                                :mean kixi/mean
                                :count kixi/count})))))

(comment
  (def ds-spec {:hostname "akvoflow-xx.appspot.com"
                :port 443
                :service-account-id "sa-akvoflow-xx@akvoflow-xx.iam.gserviceaccount.com"
                :private-key-file "/server-config/akvoflow-xx/akvoflow-xx.p12"})
  (gae/with-datastore [ds ds-spec]
    (doto (question-counts ds {:formId "313200912"
                               :questionId "311160912"}) prn))
  )

Optimize the way of getting answers

[#244] Optimize the way of getting answers

* The first attempt was to follow the report generation process: 1)
  get all the form instances 2) get all answers per form instance. We
  know that is inneficient if we can get `QuestionAnswerStore`
  entities in bulk.

* We still need to filter by form instance (`SurveyInstance`) because
  of "orphan data".

* This change introduce to get all the answers for a given question-id
  in bulk, and perform the filtering in the server side (not
  database).