(ns qu.cache
  "Functions to create and manipulate a cache for storing the results
of aggregations. This cache will be used to serve up aggregations to
API users without having to go through Mongo's aggregation framework.

The cache uses `clojure.core.cache`'s `CacheProtocol` so that it has a
standard interface. Unlike the caches that come with
`clojure.core.cache`, however, our `QueryCache` is stateful, as it's
backed by MongoDB. That means two instances of the cache created with
the same backing database have access to the same data."
  (:require [clj-time.core :refer [now]]
            [clojure.core.cache :as cache]
            [clojure.edn :as edn]
            [clojure.string :as str]
            [digest :refer [md5]]
            [lonocloud.synthread :as ->]
            [monger.collection :as coll]
            [monger.conversion :as conv]
            [monger.core :as mongo :refer [get-db with-db]]
            [qu.data.aggregation :as agg]
            [qu.data.result :refer [->DataResult]]
            [qu.metrics :as metrics]
            [qu.util :refer :all]
            [taoensso.timbre :as log])
  (:import (com.mongodb MongoException$DuplicateKey)))

;; Needed to interact with joda-time and Cheshire.
(require 'monger.joda-time)
(require 'monger.json)

(def ^:dynamic *wait-time* 5000)
(def ^:dynamic *work-collection* "jobs")

(defn query-to-key
  "Converts a query to a key that can be used to look up the query
  results later. The key must begin with a letter, as it will be used
  as the name of a MongoDB collection, which have to begin with a
  letter."
  [query]
  (let [squeeze #(str/replace % " " "")
        database (:database query)
        slice (:slice query)
        select (:select query)
        group (:group query)
        where (:where query)
        sqlish (-> ["SELECT" (squeeze select) "FROM" (str database "." slice)]
                   (->/when where
                     (conj "WHERE" (str/trim where)))
                   (->/when group
                     (conj "GROUP BY" (squeeze group)))
                   (->/as sqlish
                          (do (str/join " " sqlish))))]
    (str "q" (md5 sqlish))))

(defn- extract-result
  "Turn a collection + a query into results that would come from that aggregation."
  [collection query]
  (let [limit (->int (:limit query) 0)
        offset (->int (:offset query) 0)
        sort (get-in query [:mongo :sort] {})
        integerize #(if (and (float? %) (is-int? %)) (int %) %)
        integerize-row (fn [row]
                         (into {} (map (fn [[k v]] (vector k (integerize v))) row)))]
    (with-open [cursor (doto (coll/find collection {})
                         (.limit limit)
                         (.skip offset)
                         (.sort (conv/to-db-object sort)))]
      (->DataResult
       (.count cursor)
       (.size cursor)
       (map (fn [x] (-> x
                        (conv/from-db-object true)
                        (integerize-row)
                        (dissoc :_id))) cursor)))))

(defn- get-collection
  ([database query]
     (get-collection database query nil))
  ([database query not-found]
     (with-db database
       (let [collection (query-to-key query)]
         (if (coll/exists? collection)
           (do (metrics/increment "cache.hit")
             (extract-result collection query))
           (do (metrics/increment "cache.wait")
               not-found))))))

(defn add-to-cache
  "Add the specified aggregation to the cache by running it through
  MongoDB's map-reduce."
  [cache aggmap]
  (let [dataset (:dataset aggmap)
        agg-query (agg/generate-agg-query aggmap)
        source-database (mongo/get-db (:dataset aggmap))
        to-collection (:to aggmap)]
    (log/info "Running aggregation query:" source-database agg-query)
    (with-db source-database
      (coll/aggregate (:from aggmap) agg-query))))

(defn touch-cache
  "Sets the created value for a query to now."
  [cache query]
  (let [key (query-to-key query)
        dataset (:dataset query)]
    (with-db (:database cache)
      (coll/update "metadata"
                   {:_id key}
                   {"$set" {:created (now)
                            :dataset dataset}}
                   :upsert true))))

(defn clean-cache
  "Clean out the cache according to rules defined by the clean-fn or another fun.
   Fun should take a cache and emit a seq of ids to clear."
  ([cache] (clean-cache cache (:clean-fn cache)))
  ([cache fun]
     (mongo/with-db (:database cache)
       (doseq [key (fun cache)]
         (let [metadata (coll/find-one-as-map "metadata" {:_id key})
               dataset (:dataset metadata)
               db (when dataset (mongo/get-db dataset))]
           (when db
             (coll/remove-by-id *work-collection* key)
             (coll/drop db key)
             (coll/remove-by-id "metadata" key)))))))

(defn wipe-cache
  "Wipe out the entire cache, including the list of jobs."
  [cache]
  (let [db (:database cache)
        colls (coll/find-maps db "metadata" {} ["_id" "dataset"])]
    (doseq [{db :dataset c :_id} colls]
      (coll/drop (mongo/get-db db) c))
    (coll/drop db "jobs")
    (coll/drop db "metadata")))

(defrecord QueryCache [database clean-fn]
  cache/CacheProtocol
  (lookup [cache query]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (get-collection database query)))
  (lookup [cache query not-found]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (get-collection database query not-found)))
  (has? [cache query]
    (with-db (get-db (:dataset query))
      (let [key (query-to-key query)]
        (coll/exists? key))))
  (hit [cache query]
    (let [key (query-to-key query)]
      (with-db database
        (coll/update "metadata"
                     {:_id key}
                     {"$set" {:last_viewed (now)}
                      "$inc" {:view_count 1}}
                     :upsert true)))
    cache)
  (miss [cache query result]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (with-db database
        (coll/drop key)
        (coll/insert-batch key result))))
  (evict [cache query]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (with-db database
        (coll/drop key))))
  (seed [cache queries]
    (doseq [[query result] queries]
      (let [key (query-to-key query)
            database (get-db (:dataset query))]
        (with-db database
          (coll/drop key)
          (coll/insert-batch key result))))))

(defn create-query-cache
  "Create a query cache. If you do not specify a database, the default
one of `query_cache` will be used."
  ([] (->QueryCache (get-db "query_cache") (constantly [])))
  ([database] (->QueryCache (get-db database) (constantly [])))
  ([database clean-fn] (->QueryCache (get-db database) clean-fn)))

(defrecord CacheWorker [cache ping processed kill])

(defn- find-and-claim-unprocessed
  "Find the next unprocessed map-reduce job and claim it.
   Returns job."
  []
  (coll/find-and-modify *work-collection*
                        {:status "unprocessed"}
                        {"$set" {:status "processing"
                                 :started (now)}}
                        :sort {:created 1}))

(defn- reset-job
  "Reset a job being processed back to unprocessed."
  [job-id]
  (coll/find-and-modify *work-collection*
                        {:_id job-id :status "processing"}
                        {"$set" {:status "unprocessed"
                                 :created (now)}
                         "$inc" {:reset_count 1}}))

(defn- work-job
  "Given a map-reduce job, tells Mongo to perform the job.
   Returns true on success, false on failure."
  [worker job]
  (add-to-cache (:cache worker) (edn/read-string (:aggmap job))))

(defn- update-cache
  "Update the query cache to reflect that the map-reduce job is
  complete and ready to be accessed.

  Returns updated record."
  [worker job]
  (let [cache (:cache worker)
        aggmap (edn/read-string (:aggmap job))]
    (coll/update *work-collection*
                 {:_id (:_id job)}
                 {"$set" {:status "processed"
                          :finished (now)}})
    (touch-cache cache (:query aggmap))))

(defn- process-next-job
  [worker]
  (when-not (:kill worker)
    (with-db (get-in worker [:cache :database])
      (if-let [job (find-and-claim-unprocessed)]
        (let [job-id (:_id job)]
          (log/info "Aggregation" job-id "started")
          (send *agent* #(assoc-in % [:last-job-id] job-id))
          (work-job worker job)
          (update-cache worker job)
          (send *agent* #(update-in % [:processed] inc))
          (log/info "Aggregation" job-id "processed"))
        (do
          (clean-cache (:cache worker))
          (Thread/sleep *wait-time*)))
      (send-off *agent* process-next-job)))
  (update-in worker [:ping] inc))

(defn create-worker
  "Creates a cache worker. Call `start-worker` with this worker to
  start it processing."
  [cache]
  (map->CacheWorker {:cache cache
                     :ping 0
                     :processed 0
                     :kill false}))

(defn add-to-queue
  "Add an aggregation to the queue for caching. Returns the inserted
  record. If the aggregation is already on the queue, then the record
  of the existing job is returned."
  [cache aggmap]
  (with-db (:database cache)
    (try
      (metrics/increment "cache.queue")
      (coll/insert-and-return *work-collection* {:_id (:to aggmap)
                                                 :status "unprocessed"
                                                 :created (now)
                                                 :aggmap (pr-str aggmap)})
      (catch MongoException$DuplicateKey e
        (coll/find-map-by-id *work-collection* (:to aggmap))))))

(defn start-worker
  "Start a cache worker. This will continue to process jobs until stopped.

  Returns an agent with the worker state. Call `stop-worker` on this agent to
  stop the worker."
  [worker]
  (let [worker-agent (agent worker
                            :error-mode :continue
                            :error-handler (fn [the-agent exception]
                                             (let [job-id (:last-job-id @the-agent)]
                                               (log/error "Error with cache worker" @the-agent)
                                               (log/error "Last job ID" job-id)
                                               (log/error exception)
                                               (log/error "=== END EXCEPTION ===")
                                               (reset-job job-id)
                                               (send-off the-agent process-next-job))))]
    (send worker-agent #(assoc % :kill false))
    (send-off worker-agent process-next-job)))

(defn stop-worker
  "Stop a cache worker. This function does not take a worker: it takes
  the agent returned from `start-worker`."
  [worker-agent]
  (send worker-agent #(assoc % :kill true)))

(ns qu.cache
  "Functions to create and manipulate a cache for storing the results
of aggregations. This cache will be used to serve up aggregations to
API users without having to go through Mongo's aggregation framework.

The cache uses `clojure.core.cache`'s `CacheProtocol` so that it has a
standard interface. Unlike the caches that come with
`clojure.core.cache`, however, our `QueryCache` is stateful, as it's
backed by MongoDB. That means two instances of the cache created with
the same backing database have access to the same data."
  (:require [clj-time.core :refer [now]]
            [clojure.core.cache :as cache]
            [clojure.edn :as edn]
            [clojure.string :as str]
            [digest :refer [md5]]
            [lonocloud.synthread :as ->]
            [monger.collection :as coll]
            [monger.conversion :as conv]
            [monger.core :as mongo :refer [get-db with-db]]
            [qu.data.aggregation :as agg]
            [qu.data.result :refer [->DataResult]]
            [qu.metrics :as metrics]
            [qu.util :refer :all]
            [taoensso.timbre :as log])
  (:import (com.mongodb MongoException$DuplicateKey)))

;; Needed to interact with joda-time and Cheshire.
(require 'monger.joda-time)
(require 'monger.json)

(def ^:dynamic *wait-time* 5000)
(def ^:dynamic *work-collection* "jobs")

(defn query-to-key
  "Converts a query to a key that can be used to look up the query
  results later. The key must begin with a letter, as it will be used
  as the name of a MongoDB collection, which have to begin with a
  letter."
  [query]
  (let [squeeze #(str/replace % " " "")
        database (:database query)
        slice (:slice query)
        select (:select query)
        group (:group query)
        where (:where query)
        sqlish (-> ["SELECT" (squeeze select) "FROM" (str database "." slice)]
                   (->/when where
                     (conj "WHERE" (str/trim where)))
                   (->/when group
                     (conj "GROUP BY" (squeeze group)))
                   (->/as sqlish
                          (do (str/join " " sqlish))))]
    (str "q" (md5 sqlish))))

(defn- extract-result
  "Turn a collection + a query into results that would come from that aggregation."
  [collection query]
  (let [limit (->int (:limit query) 0)
        offset (->int (:offset query) 0)
        sort (get-in query [:mongo :sort] {})
        integerize #(if (and (float? %) (is-int? %)) (int %) %)
        integerize-row (fn [row]
                         (into {} (map (fn [[k v]] (vector k (integerize v))) row)))]
    (with-open [cursor (doto (coll/find collection {})
                         (.limit limit)
                         (.skip offset)
                         (.sort (conv/to-db-object sort)))]
      (->DataResult
       (.count cursor)
       (.size cursor)
       (map (fn [x] (-> x
                        (conv/from-db-object true)
                        (integerize-row)
                        (dissoc :_id))) cursor)))))

(defn- get-collection
  ([database query]
     (get-collection database query nil))
  ([database query not-found]
     (with-db database
       (let [collection (query-to-key query)]
         (if (coll/exists? collection)
           (do (metrics/increment "cache.hit")
             (extract-result collection query))
           (do (metrics/increment "cache.wait")
               not-found))))))

(defn add-to-cache
  "Add the specified aggregation to the cache by running it through
  MongoDB's map-reduce."
  [cache aggmap]
  (let [dataset (:dataset aggmap)
        agg-query (agg/generate-agg-query aggmap)
        source-database (mongo/get-db (:dataset aggmap))
        to-collection (:to aggmap)]
    (log/info "Running aggregation query:" source-database agg-query)
    (with-db source-database
      (mongo/command (sorted-map :aggregate (:from aggmap) :pipeline agg-query :allowDiskUse true)))))

(defn touch-cache
  "Sets the created value for a query to now."
  [cache query]
  (let [key (query-to-key query)
        dataset (:dataset query)]
    (with-db (:database cache)
      (coll/update "metadata"
                   {:_id key}
                   {"$set" {:created (now)
                            :dataset dataset}}
                   :upsert true))))

(defn clean-cache
  "Clean out the cache according to rules defined by the clean-fn or another fun.
   Fun should take a cache and emit a seq of ids to clear."
  ([cache] (clean-cache cache (:clean-fn cache)))
  ([cache fun]
     (mongo/with-db (:database cache)
       (doseq [key (fun cache)]
         (let [metadata (coll/find-one-as-map "metadata" {:_id key})
               dataset (:dataset metadata)
               db (when dataset (mongo/get-db dataset))]
           (when db
             (coll/remove-by-id *work-collection* key)
             (coll/drop db key)
             (coll/remove-by-id "metadata" key)))))))

(defn wipe-cache
  "Wipe out the entire cache, including the list of jobs."
  [cache]
  (let [db (:database cache)
        colls (coll/find-maps db "metadata" {} ["_id" "dataset"])]
    (doseq [{db :dataset c :_id} colls]
      (coll/drop (mongo/get-db db) c))
    (coll/drop db "jobs")
    (coll/drop db "metadata")))

(defrecord QueryCache [database clean-fn]
  cache/CacheProtocol
  (lookup [cache query]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (get-collection database query)))
  (lookup [cache query not-found]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (get-collection database query not-found)))
  (has? [cache query]
    (with-db (get-db (:dataset query))
      (let [key (query-to-key query)]
        (coll/exists? key))))
  (hit [cache query]
    (let [key (query-to-key query)]
      (with-db database
        (coll/update "metadata"
                     {:_id key}
                     {"$set" {:last_viewed (now)}
                      "$inc" {:view_count 1}}
                     :upsert true)))
    cache)
  (miss [cache query result]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (with-db database
        (coll/drop key)
        (coll/insert-batch key result))))
  (evict [cache query]
    (let [key (query-to-key query)
          database (get-db (:dataset query))]
      (with-db database
        (coll/drop key))))
  (seed [cache queries]
    (doseq [[query result] queries]
      (let [key (query-to-key query)
            database (get-db (:dataset query))]
        (with-db database
          (coll/drop key)
          (coll/insert-batch key result))))))

(defn create-query-cache
  "Create a query cache. If you do not specify a database, the default
one of `query_cache` will be used."
  ([] (->QueryCache (get-db "query_cache") (constantly [])))
  ([database] (->QueryCache (get-db database) (constantly [])))
  ([database clean-fn] (->QueryCache (get-db database) clean-fn)))

(defrecord CacheWorker [cache ping processed kill])

(defn- find-and-claim-unprocessed
  "Find the next unprocessed map-reduce job and claim it.
   Returns job."
  []
  (coll/find-and-modify *work-collection*
                        {:status "unprocessed"}
                        {"$set" {:status "processing"
                                 :started (now)}}
                        :sort {:created 1}))

(defn- reset-job
  "Reset a job being processed back to unprocessed."
  [job-id]
  (coll/find-and-modify *work-collection*
                        {:_id job-id :status "processing"}
                        {"$set" {:status "unprocessed"
                                 :created (now)}
                         "$inc" {:reset_count 1}}))

(defn- work-job
  "Given a map-reduce job, tells Mongo to perform the job.
   Returns true on success, false on failure."
  [worker job]
  (add-to-cache (:cache worker) (edn/read-string (:aggmap job))))

(defn- update-cache
  "Update the query cache to reflect that the map-reduce job is
  complete and ready to be accessed.

  Returns updated record."
  [worker job]
  (let [cache (:cache worker)
        aggmap (edn/read-string (:aggmap job))]
    (coll/update *work-collection*
                 {:_id (:_id job)}
                 {"$set" {:status "processed"
                          :finished (now)}})
    (touch-cache cache (:query aggmap))))

(defn- process-next-job
  [worker]
  (when-not (:kill worker)
    (with-db (get-in worker [:cache :database])
      (if-let [job (find-and-claim-unprocessed)]
        (let [job-id (:_id job)]
          (log/info "Aggregation" job-id "started")
          (send *agent* #(assoc-in % [:last-job-id] job-id))
          (work-job worker job)
          (update-cache worker job)
          (send *agent* #(update-in % [:processed] inc))
          (log/info "Aggregation" job-id "processed"))
        (do
          (clean-cache (:cache worker))
          (Thread/sleep *wait-time*)))
      (send-off *agent* process-next-job)))
  (update-in worker [:ping] inc))

(defn create-worker
  "Creates a cache worker. Call `start-worker` with this worker to
  start it processing."
  [cache]
  (map->CacheWorker {:cache cache
                     :ping 0
                     :processed 0
                     :kill false}))

(defn add-to-queue
  "Add an aggregation to the queue for caching. Returns the inserted
  record. If the aggregation is already on the queue, then the record
  of the existing job is returned."
  [cache aggmap]
  (with-db (:database cache)
    (try
      (metrics/increment "cache.queue")
      (coll/insert-and-return *work-collection* {:_id (:to aggmap)
                                                 :status "unprocessed"
                                                 :created (now)
                                                 :aggmap (pr-str aggmap)})
      (catch MongoException$DuplicateKey e
        (coll/find-map-by-id *work-collection* (:to aggmap))))))

(defn start-worker
  "Start a cache worker. This will continue to process jobs until stopped.

  Returns an agent with the worker state. Call `stop-worker` on this agent to
  stop the worker."
  [worker]
  (let [worker-agent (agent worker
                            :error-mode :continue
                            :error-handler (fn [the-agent exception]
                                             (let [job-id (:last-job-id @the-agent)]
                                               (log/error "Error with cache worker" @the-agent)
                                               (log/error "Last job ID" job-id)
                                               (log/error exception)
                                               (log/error "=== END EXCEPTION ===")
                                               (reset-job job-id)
                                               (send-off the-agent process-next-job))))]
    (send worker-agent #(assoc % :kill false))
    (send-off worker-agent process-next-job)))

(defn stop-worker
  "Stop a cache worker. This function does not take a worker: it takes
  the agent returned from `start-worker`."
  [worker-agent]
  (send worker-agent #(assoc % :kill true)))

Enable 'allowDiskUse' for aggregations. Without this, errors ensue


(ns saa.core
  (:require
   [fipp.edn :refer (pprint) :rename {pprint fipp}]
   [clojure.java.io :as io]
   [clojure.tools.cli :refer [parse-opts]]
   [aero.core :refer (read-config)]
   [clj-http.client :as client])
  (:use [clojure.data.xml])
  (:gen-class))

(defn config []
  (read-config "config.edn"))

(defn apikey [conf]
  (get-in conf [:secrets :apikey]))

(def measurements #{"GeopHeight" "Temperature" "Pressure" "Humidity" "WindDirection" "WindSpeedMS" "WindUMS" "WindVMS" "MaximumWind" "WindGust" "DewPoint" "TotalCloudCover" "WeatherSymbol3" "LowCloudCover" "MediumCloudCover" "HighCloudCover" "Precipitation1h" "PrecipitationAmount" "RadiationGlobalAccumulation" "RadiationLWAccumulation" "RadiationNetSurfaceLWAccumulation" "RadiationNetSurfaceSWAccumulation" "RadiationDiffuseAccumulation"})

(def cli-options
  ;; An option with a required argument
  [["-l" "--location PLACE" "Location"
    :default (:defaultlocation (config))
;;    :parse-fn #(Integer/parseInt %)
    :validate [#(string? %) "Must be a string"]]
   ;; A non-idempotent option
   ["-m" "--measurement MEASUREMENT" "Measurement"
    :default (:defaultmeasurement (config))
    :validate [#(contains? measurements %) "Not a valid measurement"]]
   ;; A boolean option defaulting to nil
   ["-h" "--help"]])

(def children (mapcat :content))

(defn tagp [pred]
  (comp children (filter (comp pred :tag))))

(defn tag= [tag]
  (tagp (partial = tag)))

(defn attr-accessor [a]
  (comp a :attrs))

(defn attrp [a pred]
  (filter (comp pred (attr-accessor a))))

(defn attr= [a v]
  (attrp a (partial = v)))

(def text (comp (mapcat :content) (filter string?)))

(def firstcontent (comp first :content))
(def secondcontent (comp second :content))

(defn -main
  [& args]
  (let [climap (parse-opts args cli-options)
        cliopts (:options climap)
        measurement (str "mts-1-1-" (:measurement cliopts))
        filename (str "weatherdata-" (:location cliopts) ".xml")
        datauri (str "http://data.fmi.fi/fmi-apikey/"
                     (apikey (config))
                     "/wfs?request=getFeature&storedquery_id=fmi::forecast::hirlam::surface::point::timevaluepair&place="
                     (:location cliopts))
        initfile (when (or ; fetch the XML if a cached copy doesn't exist or is over 15 mins old
                        (not (.exists (io/file filename)))
                        (> (- (.getTime (java.util.Date.))
                              (.lastModified (io/file filename)))
                           900000))
                   (spit filename
                         (:body
                          (client/get datauri))))
        ennuste (->
              (slurp filename)
              parse-str)
        path
        [(tag= :member) (tag= :PointTimeSeriesObservation)
         (tag= :result) (tag= :MeasurementTimeseries)
         (attr= :gml/id measurement) (tag= :point) (tag= :MeasurementTVP)]
        points (eduction (apply comp path) [ennuste])]
    (cond
      (:help cliopts)
      (println (str "-l, --location PLACE [" (:defaultlocation (config)) "]\n-m --measurement [" (:defaultmeasurement (config)) "]\n\nPossible values for measurement are:\n" (clojure.string/join " " (sort measurements))))
      (:errors climap)
      (println (:errors climap))
      :else
      (fipp (map (juxt (comp firstcontent firstcontent)
                       (comp firstcontent secondcontent)) points)))))

(ns saa.core
  (:require
   [fipp.edn :refer (pprint) :rename {pprint fipp}]
   [clojure.java.io :as io]
   [clojure.tools.cli :refer [parse-opts]]
   [aero.core :refer (read-config)]
   [clj-http.client :as client])
  (:use [clojure.data.xml])
  (:gen-class))

(defn config []
  (read-config "config.edn"))

(defn apikey [conf]
  (get-in conf [:secrets :apikey]))

(def measurements #{"GeopHeight" "Temperature" "Pressure" "Humidity" "WindDirection" "WindSpeedMS" "WindUMS" "WindVMS" "MaximumWind" "WindGust" "DewPoint" "TotalCloudCover" "WeatherSymbol3" "LowCloudCover" "MediumCloudCover" "HighCloudCover" "Precipitation1h" "PrecipitationAmount" "RadiationGlobalAccumulation" "RadiationLWAccumulation" "RadiationNetSurfaceLWAccumulation" "RadiationNetSurfaceSWAccumulation" "RadiationDiffuseAccumulation"})

(def cli-options
  ;; An option with a required argument
  [["-l" "--location PLACE" "Location"
    :default (:defaultlocation (config))
    :validate [#(string? %) "Must be a string"]]
   ;; A non-idempotent option
   ["-m" "--measurement MEASUREMENT" "Measurement"
    :default (:defaultmeasurement (config))
    :validate [#(contains? measurements %) "Not a valid measurement"]]
   ;; A boolean option defaulting to nil
   ["-h" "--help"]])

(def children (mapcat :content))

(defn tagp [pred]
  (comp children (filter (comp pred :tag))))

(defn tag= [tag]
  (tagp (partial = tag)))

(defn attr-accessor [a]
  (comp a :attrs))

(defn attrp [a pred]
  (filter (comp pred (attr-accessor a))))

(defn attr= [a v]
  (attrp a (partial = v)))

(def text (comp (mapcat :content) (filter string?)))

(def firstcontent (comp first :content))
(def secondcontent (comp second :content))

(defn olderthan
  "Is this file older than given time?"
  [suspect age]
  (> (- (.getTime (java.util.Date.))
        (.lastModified suspect))
     age))

(defn cleanup
  "Delete datafiles older than 30 minutes"
  []
  (let [dir (io/file ".")
        files (.listFiles dir)
        datafiles (filter #(re-find #"^weatherdata-.+xml$" (.getName %)) files) ]
    (map (fn [x]
           (when
               (olderthan x 1800000)
             (.delete x)))
         datafiles)))

(defn -main
  [& args]
  (let [climap (parse-opts args cli-options)
        cliopts (:options climap)
        measurement (str "mts-1-1-" (:measurement cliopts))
        filename (str "weatherdata-" (:location cliopts) ".xml")
        datauri (str "http://data.fmi.fi/fmi-apikey/"
                     (apikey (config))
                     "/wfs?request=getFeature&storedquery_id=fmi::forecast::hirlam::surface::point::timevaluepair&place="
                     (:location cliopts))
        initfile (when (or ; fetch the XML if a cached copy doesn't exist or is over 15 mins old
                        (not (.exists (io/file filename)))
                        (olderthan (io/file filename) 900000))
                   (spit filename
                         (:body
                          (client/get datauri))))
        ennuste (->
              (slurp filename)
              parse-str)
        path
        [(tag= :member) (tag= :PointTimeSeriesObservation)
         (tag= :result) (tag= :MeasurementTimeseries)
         (attr= :gml/id measurement) (tag= :point) (tag= :MeasurementTVP)]
        points (eduction (apply comp path) [ennuste])]
    (cleanup)
    (cond
      (:help cliopts)
      (println (str "-l, --location PLACE [" (:defaultlocation (config)) "]\n-m --measurement [" (:defaultmeasurement (config)) "]\n\nPossible values for measurement are:\n" (clojure.string/join " " (sort measurements))))
      (:errors climap)
      (println (:errors climap))
      :else
      (fipp (map (juxt (comp firstcontent firstcontent)
                       (comp firstcontent secondcontent)) points)))))

Purge old data files

Purge old data files


(ns desdemona.utils
  (:require [clojure.test :refer [is]]
            [clojure.core.async :refer [chan sliding-buffer >!!]]
            [clojure.java.io :refer [resource]]
            [onyx.plugin.core-async :refer [take-segments!]]))

;;;; Test utils ;;;;

(def zk-address "127.0.0.1")

(def zk-port 2188)

(def zk-str (str zk-address ":" zk-port))

(defn only [coll]
  (assert (not (next coll)))
  (if-let [result (first coll)]
    result
    (assert false)))

(defn find-task
  "Finds the catalog entry where the :onyx/name key equals task-name"
  [catalog task-name]
  (let [matches (filter #(= task-name (:onyx/name %)) catalog)]
    (when-not (seq matches)
      (throw (ex-info (format "Couldn't find task %s in catalog" task-name)
                      {:catalog catalog :task-name task-name})))
    (first matches)))

(defn update-task
  "Finds the catalog entry with :onyx/name task-name
  and applies f to it, returning the full catalog with the
  transformed catalog entry"
  [catalog task-name f]
  (mapv (fn [entry]
          (if (= task-name (:onyx/name entry))
            (f entry)
            entry))
        catalog))

(defn add-to-job
  "Adds to the catalog and lifecycles of a job in form
  {:workflow ...
   :catalog ...
   :lifecycles ...}"
  [job {:keys [catalog lifecycles]}]
  (-> job
      (update :catalog into catalog)
      (update :lifecycles into lifecycles)))

(defn n-peers
  "Takes a workflow and catalog, returns the minimum number of peers
   needed to execute this job."
  [catalog workflow]
  (let [task-set (into #{} (apply concat workflow))]
    (reduce
     (fn [sum t]
       (+ sum (or (:onyx/min-peers (find-task catalog t)) 1)))
     0 task-set)))

(defn segments-equal?
  "Onyx is a parallel, distributed system - so ordering isn't guaranteed.
   Does an unordered comparison of segments to check for equality."
  [expected actual]
  (is (= (into #{} expected) (into #{} (remove (partial = :done) actual))))
  (is (= :done (last actual)))
  (is (= (dec (count actual)) (count expected))))

(defn load-peer-config [onyx-id]
  (assoc (-> "dev-peer-config.edn" resource slurp read-string)
         :onyx/id onyx-id
         :zookeeper/address zk-str))

(defn load-env-config [onyx-id]
  (assoc (-> "env-config.edn" resource slurp read-string)
         :onyx/id onyx-id
         :zookeeper/address zk-str
         :zookeeper.server/port zk-port))

(defn in-memory-catalog
  "Takes a catalog and a set of input/output task names,
   returning a new catalog with all I/O catalog entries
   that were specified turned into core.async plugins. The
   core.async entries preserve all non-Onyx parameters."
  [catalog tasks]
  (mapv
   (fn [entry]
     (cond (and (some #{(:onyx/name entry)} tasks) (= (:onyx/type entry) :input))
           (merge
            entry
            {:onyx/plugin :onyx.plugin.core-async/input
             :onyx/type :input
             :onyx/medium :core.async
             :onyx/max-peers 1
             :onyx/doc "Reads segments from a core.async channel"})
           (and (some #{(:onyx/name entry)} tasks) (= (:onyx/type entry) :output))
           (merge
            entry
            {:onyx/plugin :onyx.plugin.core-async/output
             :onyx/type :output
             :onyx/medium :core.async
             :onyx/max-peers 1
             :onyx/doc "Writes segments to a core.async channel"})
           :else entry))
   catalog))

;;;; Lifecycles utils ;;;;

(def input-channel-capacity 10000)

(def output-channel-capacity (inc input-channel-capacity))

(def get-input-channel
  (memoize
   (fn [id] (chan input-channel-capacity))))

(def get-output-channel
  (memoize
   (fn [id] (chan (sliding-buffer output-channel-capacity)))))

(defn channel-id-for [lifecycles task-name]
  (->> lifecycles
       (filter #(= task-name (:lifecycle/task %)))
       (map :core.async/id)
       (remove nil?)
       (first)))

(defn inject-in-ch [event lifecycle]
  {:core.async/chan (get-input-channel (:core.async/id lifecycle))})

(defn inject-out-ch [event lifecycle]
  {:core.async/chan (get-output-channel (:core.async/id lifecycle))})

(def in-calls
  {:lifecycle/before-task-start inject-in-ch})

(def out-calls
  {:lifecycle/before-task-start inject-out-ch})

;;; Stubs lifecycles to use core.async IO, instead of, say, Kafka or Datomic.
(defn in-memory-lifecycles
  [lifecycles catalog tasks]
  (vec
   (mapcat
    (fn [{:keys [lifecycle/task lifecycle/replaceable?] :as lifecycle}]
      (let [catalog-entry (find-task catalog task)]
        (cond (and (some #{task} tasks) replaceable?
                   (= (:onyx/type catalog-entry) :input))
              [{:lifecycle/task task
                :lifecycle/calls ::in-calls
                :core.async/id (java.util.UUID/randomUUID)}
               {:lifecycle/task task
                :lifecycle/calls :onyx.plugin.core-async/reader-calls}]
              (and (some #{task} tasks) replaceable?
                   (= (:onyx/type catalog-entry) :output))
              [{:lifecycle/task task
                :lifecycle/calls ::out-calls
                :core.async/id (java.util.UUID/randomUUID)}
               {:lifecycle/task task
                :lifecycle/calls :onyx.plugin.core-async/writer-calls}]
              :else [lifecycle])))
    lifecycles)))

(defn bind-inputs! [lifecycles mapping]
  (doseq [[task segments] mapping]
    (let [in-ch (get-input-channel (channel-id-for lifecycles task))
          n-segments (count segments)]
      (when (< input-channel-capacity n-segments)
        (throw (ex-info "Input channel capacity is smaller than bound inputs. Capacity can be adjusted in utils.clj"
                        {:channel-size input-channel-capacity
                         :n-segments n-segments})))
      (when-not ((set (map :lifecycle/task lifecycles)) task)
        (throw (ex-info (str "Cannot bind input for task " task " as lifecycles are missing. Check that inputs are being bound to the correct task name.")
                        {:input task
                         :lifecycles lifecycles})))
      (doseq [segment segments]
        (>!! in-ch segment))
      (>!! in-ch :done))))

(defn collect-outputs! [lifecycles output-tasks]
  (->> output-tasks
       (map #(get-output-channel (channel-id-for lifecycles %)))
       (map #(take-segments! %))))

Fix whitespace at end of line

Fix whitespace at end of line


(ns ^{:doc "Contains client-side state, validators for input fields
  and functions which react to changes made to the input fields."}
  one.sample.model
 (:require [one.dispatch              :as dispatch]
           [goog.editor.SeamlessField :as editor-div]
           [goog.editor.Field         :as editor-iframe]))
;; Note: ns aliases for goog.editor.Field and goog.editor.SeamlessField do not
;; work due to there being no goog/editor/editor.js file that provides goog.editor
;; in the Google Closure Library.

(def ^{:doc "An atom containing a map which is the application's current state."}
  state (atom {}))

(add-watch state :state-change-key
           (fn [k r o n]
             (dispatch/fire :state-change n)))

(def ^{:doc "An atom representing a collection of all open documents"}
  docs (atom {}))

(add-watch docs :documents-state-key
           (fn [k r o n]
             (dispatch/fire :documents-changed n)))

(defn uuid []
  (let [chars "0123456789abcdef"
        random #(. js/Math (floor (rand 16)))]
    (apply str (repeatedly 32 #(get chars (random))))))

(defn document-session [& {:keys [who id content]}]
  (let [state   (atom {})
        watch   (add-watch state :document-state-key
                         (fn [k r o n]
                           (swap! docs assoc (keyword (:id n)) n)))
        init    (swap! state assoc :who who :id (or id (uuid))
                       :content (or content ""))
        history (atom '())
        cursor  (atom 0)
        now     #(. (js/Date.) (getTime))]
    (fn document [command & args]
      (condp = command
        :set!          (let [[k v] args]
                         (swap! state assoc k v :ts (now)))
        :get           (let [[key] args]
                         (@state key))
        :conj-history! (let [[content] args]
                         (swap! history conj content))
        :get-history   @history
        :reset-cursor! (reset! cursor 0)
        :undo          (let [snapshot (nth @history (inc @cursor) nil)]
                         (if (nil? snapshot)
                           (reset! cursor 0)
                           (do
                             (swap! cursor inc)
                             snapshot)))
        :redo          (let [snapshot (nth @history (dec @cursor))]
                         (swap! cursor dec)
                         snapshot)))))

(ns ^{:doc "Contains client-side state, validators for input fields
  and functions which react to changes made to the input fields."}
  one.sample.model
 (:require [one.dispatch              :as dispatch]
           [goog.editor.SeamlessField :as editor-div]
           [goog.editor.Field         :as editor-iframe]))
;; Note: ns aliases for goog.editor.Field and goog.editor.SeamlessField do not
;; work due to there being no goog/editor/editor.js file that provides goog.editor
;; in the Google Closure Library.

(def ^{:doc "An atom containing a map which is the application's current state."}
  state (atom {}))

(add-watch state :state-change-key
           (fn [k r o n]
             (dispatch/fire :state-change n)))

(def ^{:doc "An atom representing a collection of all open documents"}
  docs (atom {}))

(add-watch docs :documents-state-key
           (fn [k r o n]
             (dispatch/fire :documents-changed n)))

(defn uuid []
  (let [chars "0123456789abcdef"
        random #(. js/Math (floor (rand 16)))]
    (apply str (repeatedly 32 #(get chars (random))))))

(defn document-session [& {:keys [who id content]}]
  (let [state   (atom {})
        watch   (add-watch state :document-state-key
                         (fn [k r o n]
                           (swap! docs assoc (keyword (:id n)) n)))
        now     #(. (js/Date.) (getTime))
        init    (swap! state assoc :who who :id (or id (uuid))
                       :content (or content "") :ts (now))
        history (atom '())
        cursor  (atom 0)]
    (fn document [command & args]
      (condp = command
        :set!          (let [[k v] args]
                         (swap! state assoc k v :ts (now)))
        :get           (let [[key] args]
                         (@state key))
        :conj-history! (let [[content] args]
                         (swap! history conj content))
        :get-history   @history
        :reset-cursor! (reset! cursor 0)
        :undo          (let [snapshot (nth @history (inc @cursor) nil)]
                         (if (nil? snapshot)
                           (reset! cursor 0)
                           (do
                             (swap! cursor inc)
                             snapshot)))
        :redo          (let [snapshot (nth @history (dec @cursor))]
                         (swap! cursor dec)
                         snapshot)))))

add timestamp at moment doc is created

add timestamp at moment doc is created


(ns workflo.macros.screen.bidi
  (:require [bidi.bidi :as bidi]
            [bidi.router :as br]
            [workflo.macros.screen :as scr]))

(defn route
  "Returns a bidi route for the given screen."
  [[screen-name screen]]
  (let [segments (:segments (:url screen))]
    [(-> segments
         (interleave (repeat "/"))
         (butlast)
         (vec))
     screen-name]))

(defn routes
  "Returns combined bidi routes for all registered screens."
  []
  ["/" (mapv route (scr/registered-screens))])

(defn match-location
  [location]
  {:screen (scr/resolve-screen (-> location :handler name symbol))
   :params (:route-params location)})

(defn match
  "Matches a URL against all screen routes. Returns a
   {:params <route params> :screen <screen>} map, where :screen
   holds the screen for the URL and the route params map all
   parameterizable URL segments (e.g. :user-id) to their values
   in the URL."
  [url]
  (when-let [location (bidi/match-route (routes) url)]
    (match-location location)))

(defn path
  "Returns a URL path for the given screen and the given URL
   parameters. Accepts both screen names and screens. For example,

   (path 'user :user-id 1)
   (path (workflo.macros.screen/resolve-screen 'user) :user-id 1)

   are both acceptable uses of this function."
  [screen-or-name & params]
  (let [screen-name (cond-> screen-or-name
                      (map? screen-or-name)
                      :name)]
    (apply (partial bidi/path-for (routes) screen-name)
           params)))

(defn- on-navigate
  [env location]
  (let [{:keys [screen params]} (match-location location)]
    (some-> env :mount-screen (apply [screen params]))))

(defn router
  [{:keys [default-screen
           mount-screen]
    :or   {default-screen 'home}
    :as   env}]
  (br/start-router! (routes)
                    {:on-navigate #(on-navigate env %)
                     :default-location {:handler default-screen}}))

(defn goto!
  [router screen params]
  (let [location {:handler screen :route-params params}]
    (br/set-location! router location)))

Add a goto! utility function to screen-based bidi routing support


(ns clojure.contrib.humanize-test
  (:require #?(:clj  [clojure.test :refer :all]
               :cljs [cljs.test :refer-macros [deftest testing is are]])
            [clojure.contrib.humanize :refer [intcomma ordinal intword numberword
                                              filesize truncate oxford datetime
                                              duration]
             :as h]
            [clojure.contrib.inflect :refer [pluralize-noun]]
            #?(:clj [clojure.math.numeric-tower :refer [expt]])
            #?(:clj  [clj-time.core  :refer [now from-now seconds millis minutes
                                             hours days weeks months years]]
               :cljs [cljs-time.core :refer [now from-now seconds millis minutes
                                             hours days weeks months years]])
            #?(:clj  [clj-time.local  :refer [local-now]]
               :cljs [cljs-time.local :refer [local-now]])
            #?(:clj  [clj-time.coerce  :refer [to-date-time to-string]]
               :cljs [cljs-time.coerce :refer [to-date-time to-string]])))

#?(:cljs (def ^:private expt (.-pow js/Math)))

(deftest intcomma-test
  (testing "Testing intcomma function with expected data."
    (doseq [[testnum result] [[100, "100"], [1000, "1,000"],
                              [10123, "10,123"], [10311, "10,311"],
                              [1000000, "1,000,000"], [-100, "-100"],
                              [-10123 "-10,123"], [-10311 "-10,311"],
                              [-1000000, "-1,000,000"]]]
      (is (= (intcomma testnum) result)))))

(deftest ordinal-test
  (testing "Testing ordinal function with expected data."
    (doseq [[testnum result] [[1,"1st"], [ 2,"2nd"],
                              [ 3,"3rd"], [ 4,"4th"],
                              [ 11,"11th"],[ 12,"12th"],
                              [ 13,"13th"], [ 101,"101st"],
                              [ 102,"102nd"], [ 103,"103rd"],
                              [111, "111th"]]]
      (is (= (ordinal testnum) result)))))

(deftest intword-test
  (testing "Testing intword function with expected data."
    (doseq [[testnum result format] [[100 "100.0"]
                                     [ 1000000 "1.0 million"]
                                     [ 1200000 "1.2 million"]
                                     [ 1290000 "1.3 million"]
                                     [ 1000000000 "1.0 billion"]
                                     [ 2000000000  "2.0 billion"]
                                     [ 6000000000000 "6.0 trillion"]
                                     [1300000000000000 "1.3 quadrillion"]
                                     [3500000000000000000000 "3.5 sextillion"]
                                     [8100000000000000000000000000000000 "8.1 decillion"]
                                     [1230000 "1.23 million" "%.2f"]
                                     [(expt 10 101) "10.0 googol"]
                                     ]]
      ;; default argument
      (let [format (if (nil? format) "%.1f" format)]
        (is (= (intword testnum
                        :format format
                        )
               result))))))

(deftest numberword-test
  (testing "Testing numberword function with expected data."
    (doseq [[testnum result] [[0 "zero"]
                              [7 "seven"]
                              [12 "twelve"]
                              [40 "forty"]
                              [94 "ninety-four"]
                              [51 "fifty-one"]
                              [234 "two hundred and thirty-four"]
                              [3567 "three thousand five hundred and sixty-seven"]
                              [44120 "forty-four thousand one hundred and twenty"]
                              [25223 "twenty-five thousand two hundred and twenty-three"]
                              [5223 "five thousand two hundred and twenty-three"]
                              [23237897 "twenty-three million two hundred and thirty-seven thousand eight hundred and ninety-seven"]]]
      ;; default argument
      (is (= (numberword testnum) result)))))

(deftest filesize-test
  (testing "Testing filesize function with expected data."
    (doseq [[testsize result binary format] [[0, "0"]
                                             [300, "300.0B"]
                                             [3000, "3.0KB"]
                                             [3000000, "3.0MB"]
                                             [3000000000, "3.0GB"]
                                             [3000000000000, "3.0TB"]
                                             [3000, "2.9KiB", true]
                                             [3000000, "2.9MiB", true]
                                             [(* (expt 10 26) 30), "3000.0YB"]
                                             [(* (expt 10 26) 30), "2481.5YiB", true]

                                             ]]
      ;; default argument
      (let [binary (boolean binary)
            format (if (nil? format) "%.1f" format)]
        (is (= (filesize testsize
                         :binary binary
                         :format format
                         )
               result))))))

(deftest truncate-test
  (testing "truncate should not return a string larger than give length."
    (let [string "asdfghjkl" ]
      (is (= (count (truncate string 7)) 7))
      (is (= (count (truncate string 7 "1234")) 7))
      (is (= (count (truncate string 100)) (count string)))))

  (testing "testing truncate with expected data."
    (let [string "abcdefghijklmnopqrstuvwxyz"]
      (is (= (truncate string 14) "abcdefghijk..."))
      (is (= (truncate string 14 "...kidding") "abcd...kidding")))))

(deftest oxford-test
  (let [items ["apple", "orange", "banana", "pear", "pineapple", "strawberry"]]
    (testing "should return an empty string when given an empty list."
      (is (= (oxford []) "")))

    (testing "should return a string version of a list that has only one value."
      (is (= (oxford [(items 0)]) (items 0))))

    (testing "should return items separated by `and' when given a list of values"
      (is (= (oxford (take 2 items)) (str (items 0) ", and " (items 1))))
      (is (= (oxford (take 3 items)) (str (items 0) ", "
                                          (items 1) ", and " (items 2))))
      (is (= (oxford (take 4 items)) (str (items 0) ", "
                                          (items 1) ", "
                                          (items 2) ", and " (items 3)))))

    (testing "should truncate a large list of items with proper pluralization"
      (is (= (oxford (take 5 items)) (str (items 0) ", "
                                          (items 1) ", "
                                          (items 2) ", "
                                          (items 3) ", and " 1 " other")))
      (is (= (oxford (take 5 items)
                     :maximum-display 2)
             (str (items 0) ", "
                  (items 1) ", and " 3 " others"))))

    (testing "should accept custom trucation strings"
      (let [truncate-noun "fruit"]
        (is (oxford (take 5 items)
                    :truncate-noun truncate-noun)
            (str (items 0) ", "
                 (items 1) ", "
                 (items 2) ", and " 2 " other " (pluralize-noun 2 truncate-noun)))
        (is (oxford (take 3 items)
                    :truncate-string truncate-noun)
            (str (items 0) ", "
                 (items 1) ", and " (items 2)))))))

(deftest datetime-test
  (let [past (fn [n unit] (datetime (now) :now-dt (-> n unit from-now)))
        future (fn [n unit] (datetime (+ (-> n unit from-now) 300) ; fix delayed execution by adding some millis
                                      :now-dt (now)))]
    (testing "date diff to text"
      (are [expected diff] (= expected diff)
                           "a moment ago" (datetime (now))
                           "in a moment" (datetime (-> 500 millis from-now))
                           "10 seconds ago" (past 10 seconds)
                           "in 10 seconds" (future 10 seconds)
                           "1 second ago" (past 1 seconds)
                           "in 1 second" (future 1 seconds)
                           "10 minutes ago" (past 10 minutes)
                           "in 10 minutes" (future 10 minutes)
                           "1 minute ago" (past 1 minutes)
                           "in 1 minute" (future 1 minutes)
                           "10 hours ago" (past 10 hours)
                           "in 10 hours" (future 10 hours)
                           "1 hour ago" (past 1 hours)
                           "in 1 hour" (future 1 hours)
                           "5 days ago" (past 5 days)
                           "in 5 days" (future 5 days)
                           "1 day ago" (past 1 days)
                           "in 1 day" (future 1 days)
                           "1 week ago" (past 1 weeks)
                           "in 1 week" (future 1 weeks)
                           "3 weeks ago" (past 3 weeks)
                           "in 3 weeks" (future 3 weeks)
                           "2 months ago" (past 10 weeks)
                           "in 2 months" (future 10 weeks)
                           "10 months ago" (past 10 months)
                           "in 10 months" (future 10 months)
                           "1 month ago" (past 1 months)
                           "in 1 month" (future 1 months)
                           "3 years ago" (past 3 years)
                           "in 3 years" (future 3 years)
                           "1 year ago" (past 1 years)
                           "in 1 year" (future 1 years)
                           "3 decades ago" (past 30 years)
                           "in 3 decades" (future 30 years)
                           "1 decade ago" (past 10 years)
                           "in 1 decade" (future 10 years)
                           "3 centuries ago" (past (* 3 100) years)
                           "in 3 centuries" (future (* 3 100) years)
                           "3 millennia ago" (past (* 3 1000) years)
                           "1 millenium ago" (past 1000 years)
                           "in 3 millennia" (future (* 3 1000) years)
                           "in 1 millenium" (future 1000 years)))))

(deftest durations
  (testing "duration to terms"
    (are [duration terms] (= terms (#'h/duration-terms duration))
                          ;; Less than a second is ignored
                          0 []
                          999 []
                          1000 [[1 "second"]]
                          ;; Remaining milliseconds after seconds are gnored
                          1500 [[1 "second"]]
                          ;; 0 periods are excluded
                          10805000 [[3 "hour"]
                                    [5 "second"]]))
  (testing "duration to string"
    (are [ms expected] (= expected (duration ms))
                       0 "less than a second"
                       999 "less than a second"
                       1000 "one second"
                       10805000 "three hours, five seconds")

    (are [ms options expected] (= expected (duration ms options))
                               999 {:short-text "just now"} "just now"
                               10805000 {:number-format str} "3 hours, 5 seconds"
                               510805000 {:number-format str
                                          :list-format oxford} "5 days, 21 hours, 53 minutes, and 25 seconds")))

(ns clojure.contrib.humanize-test
  (:require #?(:clj  [clojure.test :refer :all]
               :cljs [cljs.test :refer-macros [deftest testing is are]])
            [clojure.contrib.humanize :refer [intcomma ordinal intword numberword
                                              filesize truncate oxford datetime
                                              duration]
             :as h]
            [clojure.contrib.inflect :refer [pluralize-noun]]
            #?(:clj [clojure.math.numeric-tower :refer [expt]])
            #?(:clj  [clj-time.core  :refer [now from-now seconds millis minutes
                                             hours days weeks months years plus]]
               :cljs [cljs-time.core :refer [now from-now seconds millis minutes
                                             hours days weeks months years plus]])
            #?(:clj  [clj-time.local  :refer [local-now]]
               :cljs [cljs-time.local :refer [local-now]])
            #?(:clj  [clj-time.coerce  :refer [to-date-time to-string]]
               :cljs [cljs-time.coerce :refer [to-date-time to-string]])))

#?(:cljs (def ^:private expt (.-pow js/Math)))

(deftest intcomma-test
  (testing "Testing intcomma function with expected data."
    (doseq [[testnum result] [[100, "100"], [1000, "1,000"],
                              [10123, "10,123"], [10311, "10,311"],
                              [1000000, "1,000,000"], [-100, "-100"],
                              [-10123 "-10,123"], [-10311 "-10,311"],
                              [-1000000, "-1,000,000"]]]
      (is (= (intcomma testnum) result)))))

(deftest ordinal-test
  (testing "Testing ordinal function with expected data."
    (doseq [[testnum result] [[1,"1st"], [ 2,"2nd"],
                              [ 3,"3rd"], [ 4,"4th"],
                              [ 11,"11th"],[ 12,"12th"],
                              [ 13,"13th"], [ 101,"101st"],
                              [ 102,"102nd"], [ 103,"103rd"],
                              [111, "111th"]]]
      (is (= (ordinal testnum) result)))))

(deftest intword-test
  (testing "Testing intword function with expected data."
    (doseq [[testnum result format] [[100 "100.0"]
                                     [ 1000000 "1.0 million"]
                                     [ 1200000 "1.2 million"]
                                     [ 1290000 "1.3 million"]
                                     [ 1000000000 "1.0 billion"]
                                     [ 2000000000  "2.0 billion"]
                                     [ 6000000000000 "6.0 trillion"]
                                     [1300000000000000 "1.3 quadrillion"]
                                     [3500000000000000000000 "3.5 sextillion"]
                                     [8100000000000000000000000000000000 "8.1 decillion"]
                                     [1230000 "1.23 million" "%.2f"]
                                     [(expt 10 101) "10.0 googol"]
                                     ]]
      ;; default argument
      (let [format (if (nil? format) "%.1f" format)]
        (is (= (intword testnum
                        :format format
                        )
               result))))))

(deftest numberword-test
  (testing "Testing numberword function with expected data."
    (doseq [[testnum result] [[0 "zero"]
                              [7 "seven"]
                              [12 "twelve"]
                              [40 "forty"]
                              [94 "ninety-four"]
                              [51 "fifty-one"]
                              [234 "two hundred and thirty-four"]
                              [3567 "three thousand five hundred and sixty-seven"]
                              [44120 "forty-four thousand one hundred and twenty"]
                              [25223 "twenty-five thousand two hundred and twenty-three"]
                              [5223 "five thousand two hundred and twenty-three"]
                              [23237897 "twenty-three million two hundred and thirty-seven thousand eight hundred and ninety-seven"]]]
      ;; default argument
      (is (= (numberword testnum) result)))))

(deftest filesize-test
  (testing "Testing filesize function with expected data."
    (doseq [[testsize result binary format] [[0, "0"]
                                             [300, "300.0B"]
                                             [3000, "3.0KB"]
                                             [3000000, "3.0MB"]
                                             [3000000000, "3.0GB"]
                                             [3000000000000, "3.0TB"]
                                             [3000, "2.9KiB", true]
                                             [3000000, "2.9MiB", true]
                                             [(* (expt 10 26) 30), "3000.0YB"]
                                             [(* (expt 10 26) 30), "2481.5YiB", true]

                                             ]]
      ;; default argument
      (let [binary (boolean binary)
            format (if (nil? format) "%.1f" format)]
        (is (= (filesize testsize
                         :binary binary
                         :format format
                         )
               result))))))

(deftest truncate-test
  (testing "truncate should not return a string larger than give length."
    (let [string "asdfghjkl" ]
      (is (= (count (truncate string 7)) 7))
      (is (= (count (truncate string 7 "1234")) 7))
      (is (= (count (truncate string 100)) (count string)))))

  (testing "testing truncate with expected data."
    (let [string "abcdefghijklmnopqrstuvwxyz"]
      (is (= (truncate string 14) "abcdefghijk..."))
      (is (= (truncate string 14 "...kidding") "abcd...kidding")))))

(deftest oxford-test
  (let [items ["apple", "orange", "banana", "pear", "pineapple", "strawberry"]]
    (testing "should return an empty string when given an empty list."
      (is (= (oxford []) "")))

    (testing "should return a string version of a list that has only one value."
      (is (= (oxford [(items 0)]) (items 0))))

    (testing "should return items separated by `and' when given a list of values"
      (is (= (oxford (take 2 items)) (str (items 0) ", and " (items 1))))
      (is (= (oxford (take 3 items)) (str (items 0) ", "
                                          (items 1) ", and " (items 2))))
      (is (= (oxford (take 4 items)) (str (items 0) ", "
                                          (items 1) ", "
                                          (items 2) ", and " (items 3)))))

    (testing "should truncate a large list of items with proper pluralization"
      (is (= (oxford (take 5 items)) (str (items 0) ", "
                                          (items 1) ", "
                                          (items 2) ", "
                                          (items 3) ", and " 1 " other")))
      (is (= (oxford (take 5 items)
                     :maximum-display 2)
             (str (items 0) ", "
                  (items 1) ", and " 3 " others"))))

    (testing "should accept custom trucation strings"
      (let [truncate-noun "fruit"]
        (is (oxford (take 5 items)
                    :truncate-noun truncate-noun)
            (str (items 0) ", "
                 (items 1) ", "
                 (items 2) ", and " 2 " other " (pluralize-noun 2 truncate-noun)))
        (is (oxford (take 3 items)
                    :truncate-string truncate-noun)
            (str (items 0) ", "
                 (items 1) ", and " (items 2)))))))

(deftest datetime-test
  (let [past (fn [n unit] (datetime (now) :now-dt (-> n unit from-now)))
        future (fn [n unit] (datetime (plus (-> n unit from-now) (millis 300)) ; fix delayed execution by adding some millis
                                      :now-dt (now)))]
    (testing "date diff to text"
      (are [expected diff] (= expected diff)
                           "a moment ago" (datetime (now))
                           "in a moment" (datetime (-> 500 millis from-now))
                           "10 seconds ago" (past 10 seconds)
                           "in 10 seconds" (future 10 seconds)
                           "1 second ago" (past 1 seconds)
                           "in 1 second" (future 1 seconds)
                           "10 minutes ago" (past 10 minutes)
                           "in 10 minutes" (future 10 minutes)
                           "1 minute ago" (past 1 minutes)
                           "in 1 minute" (future 1 minutes)
                           "10 hours ago" (past 10 hours)
                           "in 10 hours" (future 10 hours)
                           "1 hour ago" (past 1 hours)
                           "in 1 hour" (future 1 hours)
                           "5 days ago" (past 5 days)
                           "in 5 days" (future 5 days)
                           "1 day ago" (past 1 days)
                           "in 1 day" (future 1 days)
                           "1 week ago" (past 1 weeks)
                           "in 1 week" (future 1 weeks)
                           "3 weeks ago" (past 3 weeks)
                           "in 3 weeks" (future 3 weeks)
                           "2 months ago" (past 10 weeks)
                           "in 2 months" (future 10 weeks)
                           "10 months ago" (past 10 months)
                           "in 10 months" (future 10 months)
                           "1 month ago" (past 1 months)
                           "in 1 month" (future 1 months)
                           "3 years ago" (past 3 years)
                           "in 3 years" (future 3 years)
                           "1 year ago" (past 1 years)
                           "in 1 year" (future 1 years)
                           "3 decades ago" (past 30 years)
                           "in 3 decades" (future 30 years)
                           "1 decade ago" (past 10 years)
                           "in 1 decade" (future 10 years)
                           "3 centuries ago" (past (* 3 100) years)
                           "in 3 centuries" (future (* 3 100) years)
                           "3 millennia ago" (past (* 3 1000) years)
                           "1 millenium ago" (past 1000 years)
                           "in 3 millennia" (future (* 3 1000) years)
                           "in 1 millenium" (future 1000 years)))))

(deftest durations
  (testing "duration to terms"
    (are [duration terms] (= terms (#'h/duration-terms duration))
                          ;; Less than a second is ignored
                          0 []
                          999 []
                          1000 [[1 "second"]]
                          ;; Remaining milliseconds after seconds are gnored
                          1500 [[1 "second"]]
                          ;; 0 periods are excluded
                          10805000 [[3 "hour"]
                                    [5 "second"]]))
  (testing "duration to string"
    (are [ms expected] (= expected (duration ms))
                       0 "less than a second"
                       999 "less than a second"
                       1000 "one second"
                       10805000 "three hours, five seconds")

    (are [ms options expected] (= expected (duration ms options))
                               999 {:short-text "just now"} "just now"
                               10805000 {:number-format str} "3 hours, 5 seconds"
                               510805000 {:number-format str
                                          :list-format oxford} "5 days, 21 hours, 53 minutes, and 25 seconds")))

Fix clj tests

Fix clj tests


;; Licensed to the Apache Software Foundation (ASF) under one
;; or more contributor license agreements.  See the NOTICE file
;; distributed with this work for additional information
;; regarding copyright ownership.  The ASF licenses this file
;; to you under the Apache License, Version 2.0 (the
;; "License"); you may not use this file except in compliance
;; with the License.  You may obtain a copy of the License at
;;
;;   http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing,
;; software distributed under the License is distributed on an
;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
;; KIND, either express or implied.  See the License for the
;; specific language governing permissions and limitations
;; under the License.

(ns obcc.core
  (:require [clojure.string :as string]
            [clojure.tools.cli :refer [parse-opts]]
            [obcc.subcommands.build :as buildcmd]
            [obcc.subcommands.clean :as cleancmd]
            [obcc.subcommands.lscca :as lsccacmd]
            [obcc.subcommands.package :as packagecmd]
            [obcc.subcommands.unpack :as unpackcmd]
[obcc.util :as util])
  (:gen-class))

(defn option-merge [& args] (vec (apply concat args)))

;; options common to all modes, top-level as well as subcommands
(def common-options
  [["-h" "--help"]])

(def toplevel-options
  (option-merge [["-v" "--version" "Print the version and exit"]]
                common-options))

;; these options are common to subcommands that are expected to operate on a chaincode tree
(def common-path-options
  (option-merge [["-p" "--path PATH" "path to chaincode project" :default "./"]]
                common-options))

(def subcommand-descriptors
  [{:name "build" :desc "Build the chaincode project"
    :handler  buildcmd/run
    :options (option-merge [["-o" "--output NAME" "path to the output destination"]]
                           common-path-options)}

   {:name "clean" :desc "Clean the chaincode project"
    :handler cleancmd/run
    :options common-path-options}

   {:name "package" :desc "Package the chaincode into a CCA file for deployment"
    :handler packagecmd/run
    :options (option-merge [["-o" "--output NAME" "path to the output destination"]
                            ["-c" "--compress NAME" "compression algorithm to use" :default "gzip"]]
                           common-path-options)}

   {:name "unpack" :desc "Unpackage a CCA file"
    :handler unpackcmd/run
    :arguments "path/to/file.cca"
    :validate (fn [options arguments] (= (count arguments) 1))
    :options (option-merge [["-d" "--directory NAME" "path to the output destination"]]
                           common-path-options)}

   {:name "lscca" :desc "List the contents of a CCA file"
    :handler lsccacmd/run
    :arguments "path/to/file.cca"
    :validate (fn [options arguments] (= (count arguments) 1))
    :options common-options}])

;; N.B. the resulting map values are vectors each with a single map as an element
;;
(def subcommands (group-by :name subcommand-descriptors))

(defn exit [status msg & rest]
  (do
    (apply println msg rest)
    status))

(defn version [] (str "obcc version: v" util/app-version))

(defn prep-usage [msg] (->> msg flatten (string/join \newline)))

(defn usage [options-summary]
  (prep-usage [(version)
               ""
               "Usage: obcc [general-options] action [action-options]"
               ""
               "General Options:"
               options-summary
               ""
               "Actions:"
               (map (fn[[ _ [{:keys [name desc]}] ]] (str "  " name " -> " desc)) subcommands)
               ""
               "(run \"obcc <action> -h\" for action specific help)"]))

(defn subcommand-usage [subcommand options-summary]
  (prep-usage [(version)
               ""
               (str "Description: obcc " (:name subcommand) " - " (:desc subcommand))
               ""
               (str "Usage: obcc " (:name subcommand) " [options] " (if-let [arguments (:arguments subcommand)] arguments ""))
               ""
               "Command Options:"
               options-summary
               ""]))

(defn -app [& args]
  (let [{:keys [options arguments errors summary]} (parse-opts args toplevel-options :in-order true)]
    (cond

      (:help options)
      (exit 0 (usage summary))

      (not= errors nil)
      (exit -1 "Error: " (string/join errors))

      (:version options)
      (exit 0 (version))

      (zero? (count arguments))
      (exit -1 (usage summary))

      :else
      (if-let [ [subcommand] (subcommands (first arguments))]
        (let [{:keys [options arguments errors summary]} (parse-opts (rest arguments) (:options subcommand))]
          (cond

            (:help options)
            (exit 0 (subcommand-usage subcommand summary))

            (not= errors nil)
            (exit -1 "Error: " (string/join errors))

            (and (:validate subcommand) (not ((:validate subcommand) options arguments)))
            (exit -1 (subcommand-usage subcommand summary))

            :else
            (try
              ((:handler subcommand) options arguments)
              (exit 0 "")
              (catch Exception e (exit -1 (str e))))))

        ;; unrecognized subcommand
        (exit 1 (usage summary))))))

(defn -main [& args]
  (System/exit (apply -app args)))

;; Licensed to the Apache Software Foundation (ASF) under one
;; or more contributor license agreements.  See the NOTICE file
;; distributed with this work for additional information
;; regarding copyright ownership.  The ASF licenses this file
;; to you under the Apache License, Version 2.0 (the
;; "License"); you may not use this file except in compliance
;; with the License.  You may obtain a copy of the License at
;;
;;   http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing,
;; software distributed under the License is distributed on an
;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
;; KIND, either express or implied.  See the License for the
;; specific language governing permissions and limitations
;; under the License.

(ns obcc.core
  (:require [clojure.string :as string]
            [clojure.tools.cli :refer [parse-opts]]
            [obcc.subcommands.build :as buildcmd]
            [obcc.subcommands.clean :as cleancmd]
            [obcc.subcommands.lscca :as lsccacmd]
            [obcc.subcommands.package :as packagecmd]
            [obcc.subcommands.unpack :as unpackcmd]
[obcc.util :as util])
  (:gen-class))

(defn option-merge [& args] (vec (apply concat args)))

;; options common to all modes, top-level as well as subcommands
(def common-options
  [["-h" "--help"]])

(def toplevel-options
  (option-merge [["-v" "--version" "Print the version and exit"]]
                common-options))

;; these options are common to subcommands that are expected to operate on a chaincode tree
(def common-path-options
  (option-merge [["-p" "--path PATH" "path to chaincode project" :default "./"]]
                common-options))

(def subcommand-descriptors
  [{:name "build" :desc "Build the chaincode project"
    :handler  buildcmd/run
    :options (option-merge [["-o" "--output NAME" "path to the output destination"]]
                           common-path-options)}

   {:name "clean" :desc "Clean the chaincode project"
    :handler cleancmd/run
    :options common-path-options}

   {:name "package" :desc "Package the chaincode into a CCA file for deployment"
    :handler packagecmd/run
    :options (option-merge [["-o" "--output NAME" "path to the output destination"]
                            ["-c" "--compress NAME" "compression algorithm to use" :default "gzip"]]
                           common-path-options)}

   {:name "unpack" :desc "Unpackage a CCA file"
    :handler unpackcmd/run
    :arguments "path/to/file.cca"
    :validate (fn [options arguments] (= (count arguments) 1))
    :options (option-merge [["-d" "--directory NAME" "path to the output destination"]]
                           common-path-options)}

   {:name "lscca" :desc "List the contents of a CCA file"
    :handler lsccacmd/run
    :arguments "path/to/file.cca"
    :validate (fn [options arguments] (= (count arguments) 1))
    :options common-options}])

;; N.B. the resulting map values are vectors each with a single map as an element
;;
(def subcommands (group-by :name subcommand-descriptors))

(defn exit [status msg & rest]
  (do
    (apply println msg rest)
    status))

(defn version [] (str "obcc version: v" util/app-version))

(defn prep-usage [msg] (->> msg flatten (string/join \newline)))

(defn usage [options-summary]
  (prep-usage [(version)
               ""
               "Usage: obcc [general-options] action [action-options]"
               ""
               "General Options:"
               options-summary
               ""
               "Actions:"
               (map (fn[[ _ [{:keys [name desc]}] ]] (str "  " name " -> " desc)) subcommands)
               ""
               "(run \"obcc <action> -h\" for action specific help)"]))

(defn subcommand-usage [subcommand options-summary]
  (prep-usage [(version)
               ""
               (str "Description: obcc " (:name subcommand) " - " (:desc subcommand))
               ""
               (str "Usage: obcc " (:name subcommand) " [options] " (when-let [arguments (:arguments subcommand)] arguments))
               ""
               "Command Options:"
               options-summary
               ""]))

(defn -app [& args]
  (let [{:keys [options arguments errors summary]} (parse-opts args toplevel-options :in-order true)]
    (cond

      (:help options)
      (exit 0 (usage summary))

      (not= errors nil)
      (exit -1 "Error: " (string/join errors))

      (:version options)
      (exit 0 (version))

      (zero? (count arguments))
      (exit -1 (usage summary))

      :else
      (if-let [ [subcommand] (subcommands (first arguments))]
        (let [{:keys [options arguments errors summary]} (parse-opts (rest arguments) (:options subcommand))]
          (cond

            (:help options)
            (exit 0 (subcommand-usage subcommand summary))

            (not= errors nil)
            (exit -1 "Error: " (string/join errors))

            (and (:validate subcommand) (not ((:validate subcommand) options arguments)))
            (exit -1 (subcommand-usage subcommand summary))

            :else
            (try
              ((:handler subcommand) options arguments)
              (exit 0 "")
              (catch Exception e (exit -1 (str e))))))

        ;; unrecognized subcommand
        (exit 1 (usage summary))))))

(defn -main [& args]
  (System/exit (apply -app args)))

Clean up a misappropriate if-let usage

Clean up a misappropriate if-let usage

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>


(ns oc.storage.representations.entry
  "Resource representations for OpenCompany entries."
  (:require [defun.core :refer (defun defun-)]
            [cheshire.core :as json]
            [oc.lib.hateoas :as hateoas]
            [oc.storage.config :as config]
            [oc.storage.representations.media-types :as mt]
            [oc.storage.representations.board :as board-rep]))

(def representation-props [:topic-slug :title :headline :body :body-placeholder :image-url :image-height :image-width
                           :chart-url :attachments :author :created-at :updated-at])

(defun url

  ([org-slug board-slug topic-slug :guard string?]
  (str "/orgs/" org-slug "/boards/" board-slug "/topics/" (name topic-slug)))

  ([org-slug board-slug entry :guard map?] (url org-slug board-slug (name (:topic-slug entry))))

  ([org-slug board-slug topic-slug :guard string? entry-uuid]
  (str "/orgs/" org-slug "/boards/" board-slug "/topics/" (name topic-slug) "/entry/" entry-uuid))

  ([org-slug board-slug entry :guard map? entry-uuid] (url org-slug board-slug (name (:topic-slug entry)) entry-uuid)))

(defn- self-link [org-slug board-slug entry entry-uuid]
  (hateoas/self-link (url org-slug board-slug entry entry-uuid) {:accept mt/entry-media-type}))

(defn- item-link [org-slug board-slug entry entry-uuid]
  (hateoas/item-link (url org-slug board-slug entry entry-uuid) {:accept mt/entry-media-type}))

(defn- create-link [org-slug board-slug topic-slug]
  (hateoas/create-link (str (url org-slug board-slug topic-slug) "/") {:content-type mt/entry-media-type
                                                                       :accept mt/entry-media-type}))

(defn- partial-update-link [org-slug board-slug topic-slug entry-uuid]
  (hateoas/partial-update-link (url org-slug board-slug topic-slug entry-uuid) {:content-type mt/entry-media-type
                                                                                :accept mt/entry-media-type}))

(defn- delete-link [org-slug board-slug topic-slug entry-uuid]
  (hateoas/delete-link (url org-slug board-slug topic-slug entry-uuid)))

(defn- archive-link [org-slug board-slug topic-slug]
  (hateoas/archive-link (url org-slug board-slug topic-slug)))

(defn- collection-link [org-slug board-slug topic-slug entry-count]
  (hateoas/collection-link (url org-slug board-slug topic-slug) {:accept mt/entry-collection-media-type}
                                                                {:count (or entry-count 1)}))

(defn- up-link [org-slug board-slug topic-slug] (hateoas/up-link
                                        (url org-slug board-slug topic-slug) {:accept mt/entry-collection-media-type}))

(defn- comment-link [org-uuid board-uuid topic-slug entry-uuid]
  (let [comment-url (str config/interaction-server-url (url org-uuid board-uuid topic-slug entry-uuid) "/comments/")]
    (hateoas/link-map "comment" hateoas/POST comment-url {:content-type mt/comment-media-type
                                                          :accept mt/comment-media-type})))

(defn- entry-collection-links
  [entry entry-count entry-uuid board-slug org-slug access-level]
  (let [topic-slug (name (:topic-slug entry))
        links [(collection-link org-slug board-slug entry entry-count)
               (item-link org-slug board-slug entry entry-uuid)]
        full-links (if (= access-level :author)
                      (concat links [(partial-update-link org-slug board-slug topic-slug entry-uuid)
                                     (delete-link org-slug board-slug topic-slug entry-uuid)
                                     (create-link org-slug board-slug topic-slug)
                                     (archive-link org-slug board-slug topic-slug)])
                      links)]
    (assoc entry :links full-links)))

(defn- entry-links
  [entry entry-uuid board-slug org-slug access-level]
  (let [topic-slug (name (:topic-slug entry))
        org-uuid (:org-uuid entry)
        board-uuid (:board-uuid entry)
        links [(self-link org-slug board-slug (name topic-slug) entry-uuid)
               (up-link org-slug board-slug topic-slug)]
        full-links (cond
                    (= access-level :author)
                    (concat links [(partial-update-link org-slug board-slug entry entry-uuid)
                                   (delete-link org-slug board-slug entry entry-uuid)
                                   (create-link org-slug board-slug topic-slug)
                                   (archive-link org-slug board-slug topic-slug)
                                   (comment-link org-uuid board-uuid topic-slug entry-uuid)])

                    (= access-level :viewer)
                    (conj links (comment-link org-slug board-slug topic-slug entry-uuid))

                    :else links)]
    (assoc (select-keys entry representation-props) :links full-links)))

(defn render-entry-for-collection
  "Create a map of the entry for use in a collection in the REST API"
  [org-slug board-slug entry entry-count access-level]
  (let [entry-uuid (:uuid entry)]
    (-> entry
      (select-keys representation-props)
      (entry-collection-links entry-count entry-uuid board-slug org-slug access-level))))

(defn render-entry
  "Create a JSON representation of the entry for the REST API"
  [org-slug board-slug entry access-level]
  (let [entry-uuid (:uuid entry)]
    (json/generate-string
      (entry-links entry entry-uuid board-slug org-slug access-level)
      {:pretty config/pretty?})))

(defn render-entry-list
  "
  Given a org and board slug and a sequence of entry maps, create a JSON representation of a list of
  entries for the REST API.
  "
  [org-slug board-slug topic-slug entries access-level]
  (let [collection-url (url org-slug board-slug topic-slug)
        links [(hateoas/self-link collection-url {:accept mt/entry-collection-media-type})
               (hateoas/up-link (board-rep/url org-slug board-slug) {:accept mt/board-media-type})]
        full-links (if (= access-level :author)
                      (concat links [(create-link org-slug board-slug topic-slug)
                                     (archive-link org-slug board-slug topic-slug)])
                      links)]
    (json/generate-string
      {:collection {:version hateoas/json-collection-version
                    :href collection-url
                    :links full-links
                    :items (map #(entry-links % (:uuid %) board-slug org-slug access-level) entries)}}
      {:pretty config/pretty?})))

(ns oc.storage.representations.entry
  "Resource representations for OpenCompany entries."
  (:require [defun.core :refer (defun defun-)]
            [cheshire.core :as json]
            [oc.lib.hateoas :as hateoas]
            [oc.storage.config :as config]
            [oc.storage.representations.media-types :as mt]
            [oc.storage.representations.board :as board-rep]))

(def representation-props [:topic-slug :title :headline :body :body-placeholder :image-url :image-height :image-width
                           :chart-url :attachments :author :created-at :updated-at])

(defun url

  ([org-slug board-slug topic-slug :guard string?]
  (str "/orgs/" org-slug "/boards/" board-slug "/topics/" (name topic-slug)))

  ([org-slug board-slug entry :guard map?] (url org-slug board-slug (name (:topic-slug entry))))

  ([org-slug board-slug topic-slug :guard string? entry-uuid]
  (str "/orgs/" org-slug "/boards/" board-slug "/topics/" (name topic-slug) "/entry/" entry-uuid))

  ([org-slug board-slug entry :guard map? entry-uuid] (url org-slug board-slug (name (:topic-slug entry)) entry-uuid)))

(defn- self-link [org-slug board-slug entry entry-uuid]
  (hateoas/self-link (url org-slug board-slug entry entry-uuid) {:accept mt/entry-media-type}))

(defn- item-link [org-slug board-slug entry entry-uuid]
  (hateoas/item-link (url org-slug board-slug entry entry-uuid) {:accept mt/entry-media-type}))

(defn- create-link [org-slug board-slug topic-slug]
  (hateoas/create-link (str (url org-slug board-slug topic-slug) "/") {:content-type mt/entry-media-type
                                                                       :accept mt/entry-media-type}))

(defn- partial-update-link [org-slug board-slug topic-slug entry-uuid]
  (hateoas/partial-update-link (url org-slug board-slug topic-slug entry-uuid) {:content-type mt/entry-media-type
                                                                                :accept mt/entry-media-type}))

(defn- delete-link [org-slug board-slug topic-slug entry-uuid]
  (hateoas/delete-link (url org-slug board-slug topic-slug entry-uuid)))

(defn- archive-link [org-slug board-slug topic-slug]
  (hateoas/archive-link (url org-slug board-slug topic-slug)))

(defn- collection-link [org-slug board-slug topic-slug entry-count]
  (hateoas/collection-link (url org-slug board-slug topic-slug) {:accept mt/entry-collection-media-type}
                                                                {:count (or entry-count 1)}))

(defn- up-link [org-slug board-slug topic-slug] (hateoas/up-link
                                        (url org-slug board-slug topic-slug) {:accept mt/entry-collection-media-type}))

(defn- comment-link [org-uuid board-uuid topic-slug entry-uuid]
  (let [comment-url (str config/interaction-server-url (url org-uuid board-uuid topic-slug entry-uuid) "/comments/")]
    (hateoas/link-map "comment" hateoas/POST comment-url {:content-type mt/comment-media-type
                                                          :accept mt/comment-media-type})))

(defn- comments-link [org-uuid board-uuid topic-slug entry-uuid]
  (let [comment-url (str config/interaction-server-url (url org-uuid board-uuid topic-slug entry-uuid) "/comments")]
    (hateoas/link-map "comments" hateoas/GET comment-url {:accept mt/comment-collection-media-type}
                                                          {:count 5}))) ; TODO comment count

(defn- entry-collection-links
  [entry entry-count entry-uuid board-slug org-slug access-level]
  (let [topic-slug (name (:topic-slug entry))
        links [(collection-link org-slug board-slug entry entry-count)
               (item-link org-slug board-slug entry entry-uuid)]
        full-links (if (= access-level :author)
                      (concat links [(partial-update-link org-slug board-slug topic-slug entry-uuid)
                                     (delete-link org-slug board-slug topic-slug entry-uuid)
                                     (create-link org-slug board-slug topic-slug)
                                     (archive-link org-slug board-slug topic-slug)])
                      links)]
    (assoc entry :links full-links)))

(defn- entry-links
  [entry entry-uuid board-slug org-slug access-level]
  (let [topic-slug (name (:topic-slug entry))
        org-uuid (:org-uuid entry)
        board-uuid (:board-uuid entry)
        links [(self-link org-slug board-slug (name topic-slug) entry-uuid)
               (up-link org-slug board-slug topic-slug)]
        full-links (cond
                    (= access-level :author)
                    (concat links [(partial-update-link org-slug board-slug entry entry-uuid)
                                   (delete-link org-slug board-slug entry entry-uuid)
                                   (create-link org-slug board-slug topic-slug)
                                   (archive-link org-slug board-slug topic-slug)
                                   (comment-link org-uuid board-uuid topic-slug entry-uuid)
                                   (comments-link org-uuid board-uuid topic-slug entry-uuid)])

                    (= access-level :viewer)
                    (concat links [(comment-link org-slug board-slug topic-slug entry-uuid)
                                   (comments-link org-uuid board-uuid topic-slug entry-uuid)])

                    :else links)]
    (assoc (select-keys entry representation-props) :links full-links)))

(defn render-entry-for-collection
  "Create a map of the entry for use in a collection in the REST API"
  [org-slug board-slug entry entry-count access-level]
  (let [entry-uuid (:uuid entry)]
    (-> entry
      (select-keys representation-props)
      (entry-collection-links entry-count entry-uuid board-slug org-slug access-level))))

(defn render-entry
  "Create a JSON representation of the entry for the REST API"
  [org-slug board-slug entry access-level]
  (let [entry-uuid (:uuid entry)]
    (json/generate-string
      (entry-links entry entry-uuid board-slug org-slug access-level)
      {:pretty config/pretty?})))

(defn render-entry-list
  "
  Given a org and board slug and a sequence of entry maps, create a JSON representation of a list of
  entries for the REST API.
  "
  [org-slug board-slug topic-slug entries access-level]
  (let [collection-url (url org-slug board-slug topic-slug)
        links [(hateoas/self-link collection-url {:accept mt/entry-collection-media-type})
               (hateoas/up-link (board-rep/url org-slug board-slug) {:accept mt/board-media-type})]
        full-links (if (= access-level :author)
                      (concat links [(create-link org-slug board-slug topic-slug)
                                     (archive-link org-slug board-slug topic-slug)])
                      links)]
    (json/generate-string
      {:collection {:version hateoas/json-collection-version
                    :href collection-url
                    :links full-links
                    :items (map #(entry-links % (:uuid %) board-slug org-slug access-level) entries)}}
      {:pretty config/pretty?})))

Add comments link to retrieve comments for entries (count is currently just an example).


(ns pc.replay
  (:require [datomic.api :as d]
            [pc.datomic :as pcd]
            [pc.datomic.schema :as schema]
            [pc.datomic.web-peer :as web-peer])
  (:import java.util.UUID))

(defn get-document-transactions
  "Gets the broadcasted transactions for a document"
  [db doc]
  (map #(d/entity db (first %))
       (d/q '{:find [?t]
              :in [$ ?doc-id]
              :where [[?t :transaction/document ?doc-id]]}
            db (:db/id doc))))

(defn- ->datom
  [[e a v tx added]]
  {:e e :a a :v v :tx tx :added added})

(defn tx-data [transaction]
  (->> (d/q '{:find [?e ?a ?v ?tx ?op]
              :in [?log ?txid]
              :where [[(tx-data ?log ?txid) [[?e ?a ?v ?tx ?op]]]]}
            (d/log (pcd/conn)) (:db/id transaction))
    (map ->datom)
    set))

(defn replace-frontend-ids [db doc-id txes]
  (let [a (d/entid db :frontend/id)]
    (map (fn [tx]
           (if (= (:a tx) a)
             (assoc tx
                    :v (UUID. doc-id (web-peer/client-part (:v tx)))
                    :a (d/entid (pcd/default-db) :frontend/id))
             tx))
         txes)))

(defn copy-transactions [db doc new-doc & {:keys [sleep-ms]
                                           :or {sleep-ms 1000}}]
  (let [conn (pcd/conn)
        tx-datas (->> (get-document-transactions db doc)
                   (sort-by :db/txInstant)
                   (map (fn [t]
                          (->> (tx-data t)
                            (remove #(= (:e %) (:db/id t)))
                            (map #(if (= (:v %) (:db/id doc))
                                    (assoc % :v (:db/id new-doc))
                                    %))
                            (replace-frontend-ids db (:db/id new-doc))))))
        eid-translations (-> (apply concat (map #(map :e %) tx-datas))
                           set
                           (disj (:db/id doc))
                           (zipmap (repeatedly #(d/tempid :db.part/user)))
                           (assoc (:db/id doc) (:db/id new-doc)))]
    (doseq [tx-data tx-datas]
      (def my-tx-data tx-data)
      (let [txid (d/tempid :db.part/tx)]
        @(d/transact conn (conj (map #(-> %
                                        (update-in [:e] eid-translations)
                                        pcd/datom->transaction)
                                     tx-data)
                                {:db/id txid
                                 :transaction/document (:db/id new-doc)
                                 :transaction/broadcast true}))
        (Thread/sleep sleep-ms)))))

(ns pc.replay
  (:require [datomic.api :as d]
            [pc.datomic :as pcd]
            [pc.datomic.schema :as schema]
            [pc.datomic.web-peer :as web-peer])
  (:import java.util.UUID))

(defn- ->datom
  [[e a v tx added]]
  {:e e :a a :v v :tx tx :added added})

(defn tx-data [transaction]
  (->> (d/q '{:find [?e ?a ?v ?tx ?op]
              :in [?log ?txid]
              :where [[(tx-data ?log ?txid) [[?e ?a ?v ?tx ?op]]]]}
            (d/log (pcd/conn)) (:db/id transaction))
    (map ->datom)
    set))

(defn get-document-transactions
  "Returns a lazy sequence of transactions for a document in order of db/txInstant.
   Has :tx-data and :db-after fields"
  [db doc]
  (map (fn [e]
         (let [tx (d/entity db e)]
           {:tx-data (tx-data tx)
            :db-after (d/as-of db (:db/txInstant tx))}))
       (map first
            (sort-by second
                     (d/q '{:find [?t ?tx]
                            :in [$ ?doc-id]
                            :where [[?t :transaction/document ?doc-id]
                                    [?t :db/txInstant ?tx]]}
                          db (:db/id doc))))))

(defn replace-frontend-ids [db doc-id txes]
  (let [a (d/entid db :frontend/id)]
    (map (fn [tx]
           (if (= (:a tx) a)
             (assoc tx
                    :v (UUID. doc-id (web-peer/client-part (:v tx)))
                    :a (d/entid (pcd/default-db) :frontend/id))
             tx))
         txes)))

(defn copy-transactions [db doc new-doc & {:keys [sleep-ms]
                                           :or {sleep-ms 1000}}]
  (let [conn (pcd/conn)
        tx-datas (->> (get-document-transactions db doc)
                   (map (fn [t]
                          (->> (:tx-data t)
                            (remove #(= (:e %) (:db/id t)))
                            (map #(if (= (:v %) (:db/id doc))
                                    (assoc % :v (:db/id new-doc))
                                    %))
                            (replace-frontend-ids db (:db/id new-doc))))))
        eid-translations (-> (apply concat (map #(map :e %) tx-datas))
                           set
                           (disj (:db/id doc))
                           (zipmap (repeatedly #(d/tempid :db.part/user)))
                           (assoc (:db/id doc) (:db/id new-doc)))]
    (doseq [tx-data tx-datas]
      (def my-tx-data tx-data)
      (let [txid (d/tempid :db.part/tx)]
        @(d/transact conn (conj (map #(-> %
                                        (update-in [:e] eid-translations)
                                        pcd/datom->transaction)
                                     tx-data)
                                {:db/id txid
                                 :transaction/document (:db/id new-doc)
                                 :transaction/broadcast true}))
        (Thread/sleep sleep-ms)))))

make get-document-transactions return things that look more like transactions