(ns specium.core-test
  (:require [clojure.spec.alpha :as s]
            [clojure.test :refer [deftest is are]]
            [specium.core :as specium]))

(s/def ::int integer?)
(s/def ::even even?)
(s/def ::str string?)

(defmulti m :type)

(deftest ->spec-is-inverse-of-form
  (binding [specium/*eval-fn*
            (fn [_] (assert false "eval shouldn't be called"))]
    (is (= integer? (specium/->spec (s/form (s/spec ::int)))))
    (is (= integer? (specium/->spec (s/form (s/spec integer?)))))

    (are [spec]
        ;; Perhaps there is no way but s/form to check equality
        ;; between two specs
        (= (s/form spec)
           (s/form (specium/->spec (s/form spec))))

      (s/and ::int ::even)
      (s/and integer? even?)

      (s/multi-spec m :type)

      (s/or :int ::int :str ::str)
      (s/or :int integer? :str string?)

      (s/tuple ::int ::str)
      (s/tuple integer? string?)

      (s/keys :req [::int] :req-un [::str])
      (s/keys :req [(or (and ::int ::even) ::str)])
      (s/keys :req-un [(or (and ::int ::even) ::str)])
      (s/keys :opt [::int] :opt-un [::str])

      (s/every ::int :kind vector? :count 3 :distinct true)
      (s/every integer? :into #{} :min-count 3 :max-count 5 :gen-max 3)

      (s/every-kv ::int ::str :count 3)
      (s/every-kv integer? string? :min-count 3 :max-count 5 :gen-max 3)

      (s/coll-of ::int :kind vector? :count 3 :distinct true)
      (s/coll-of integer? :into #{} :min-count 3 :max-count 5 :gen-max 3)

      (s/map-of ::int ::str :count 3 :conform-keys true)
      (s/map-of integer? string? :min-count 3 :max-count 5 :gen-max 3)

      (s/* ::int)
      (s/* integer?)

      (s/+ ::int)
      (s/+ integer?)

      (s/? ::int)
      (s/? integer?)

      (s/alt :int ::int :str ::str)
      (s/alt :int integer? :str string?)

      (s/cat :int ::int :str ::str)
      (s/cat :int integer? :str string?)

      ;; Cannot test these cases due to CLJ-2152
      #_(s/& ::int ::even)
      #_(s/& integer? even?)

      (s/fspec :args (s/cat :x ::int) :ret ::int)
      (s/fspec :args (s/cat :x integer?) :ret integer?)

      (s/conformer name)

      (s/nonconforming (s/cat :i integer? :s string?))

      )))

(ns specium.core-test
  (:require [clojure.spec.alpha :as s]
            [clojure.test :refer [deftest is are]]
            [specium.core :as specium]))

(s/def ::int integer?)
(s/def ::even even?)
(s/def ::str string?)

(defmulti m :type)

(deftest ->spec-is-inverse-of-form
  (binding [specium/*eval-fn*
            (fn [_] (assert false "eval shouldn't be called"))]
    (is (= integer? (specium/->spec (s/form (s/spec ::int)))))
    (is (= integer? (specium/->spec (s/form (s/spec integer?)))))

    (are [spec]
        ;; Perhaps there is no way but s/form to check equality
        ;; between two specs
        (= (s/form spec)
           (s/form (specium/->spec (s/form spec))))

      (s/and ::int ::even)
      (s/and integer? even?)

      (s/multi-spec m :type)

      (s/or :int ::int :str ::str)
      (s/or :int integer? :str string?)

      (s/tuple ::int ::str)
      (s/tuple integer? string?)

      (s/keys :req [::int] :req-un [::str])
      (s/keys :req [(or (and ::int ::even) ::str)])
      (s/keys :req-un [(or (and ::int ::even) ::str)])
      (s/keys :opt [::int] :opt-un [::str])

      (s/merge (s/keys :req [::int]) (s/keys :req [::str]))

      (s/every ::int :kind vector? :count 3 :distinct true)
      (s/every integer? :into #{} :min-count 3 :max-count 5 :gen-max 3)

      (s/every-kv ::int ::str :count 3)
      (s/every-kv integer? string? :min-count 3 :max-count 5 :gen-max 3)

      (s/coll-of ::int :kind vector? :count 3 :distinct true)
      (s/coll-of integer? :into #{} :min-count 3 :max-count 5 :gen-max 3)

      (s/map-of ::int ::str :count 3 :conform-keys true)
      (s/map-of integer? string? :min-count 3 :max-count 5 :gen-max 3)

      (s/* ::int)
      (s/* integer?)

      (s/+ ::int)
      (s/+ integer?)

      (s/? ::int)
      (s/? integer?)

      (s/alt :int ::int :str ::str)
      (s/alt :int integer? :str string?)

      (s/cat :int ::int :str ::str)
      (s/cat :int integer? :str string?)

      ;; Cannot test these cases due to CLJ-2152
      #_(s/& ::int ::even)
      #_(s/& integer? even?)

      (s/fspec :args (s/cat :x ::int) :ret ::int)
      (s/fspec :args (s/cat :x integer?) :ret integer?)

      (s/conformer name)

      (s/nonconforming (s/cat :i integer? :s string?))

      )))

Add missing test case

Add missing test case


(ns discuss.config
  (:require [discuss.config-helper :refer [default-slug]]))

(def project "discuss")
(goog-define version "x.y.z")
(goog-define build-commit "dev")
(goog-define experimental-features? true)

#_(goog-define remote-host "http://discuss.cn.uni-duesseldorf.de:4284/api")
(def remote-host
  (str "http://" (.. js/window -location -hostname) ":4284/api"))

;; Optional
#_(goog-define search-host "http://discuss.cn.uni-duesseldorf.de:8888")
(def search-host
  (str "http://" (.. js/window -location -hostname) ":8888"))

;; For demo session
(def demo-servers
  [{:name "muenchhausen"
    :dbas "http://muenchhausen.cn.uni-duesseldorf.de:4284/api"
    :eden "http://muenchhausen.cn.uni-duesseldorf.de:8888"}
   {:name "slurpy"
    :dbas "http://slurpy.cn.uni-duesseldorf.de:4284/api"
    :eden "http://slurpy.cn.uni-duesseldorf.de:8888"}
   {:name "discuss"
    :dbas "http://discuss.cn.uni-duesseldorf.de:4284/api"
    :eden "http://discuss.cn.uni-duesseldorf.de:8888"}
   {:name "localhost without eden"
    :dbas "http://localhost:4284/api"
    :eden nil}])

(def initial-discussions
  [{:slug "public"}])

(def log-level
  "Available log-levels: :severe :warning :info :config :fine :finer :finest."
  :fine)

(def api {:init (default-slug initial-discussions)
          :base  "/"
          :graphql "/v2/query"
          :login "/login"
          :logout "/logout"
          :add   {:add-start-statement "/add/start_statement"
                  :add-start-premise   "/add/start_premise"
                  :add-justify-premise "/add/justify_premise"}
          :get   {:references       "/references"
                  :reference-usages "/reference/usages"
                  :statements       "/statements"
                  :statement-url    "/statement/url"}
          :jump  "/:slug/jump/:argument-id"})

(def eden {:add/argument               "/argument"
           :search/arguments-by-author "/arguments/by-author"})

(ns discuss.config
  (:require [discuss.config-helper :refer [default-slug]]))

(def project "discuss")
(goog-define version "x.y.z")
(goog-define build-commit "dev")
(goog-define experimental-features? true)
(goog-define generative-tests? false)

#_(goog-define remote-host "http://discuss.cn.uni-duesseldorf.de:4284/api")
(def remote-host
  (str "http://" (.. js/window -location -hostname) ":4284/api"))

;; Optional
#_(goog-define search-host "http://discuss.cn.uni-duesseldorf.de:8888")
(def search-host
  (str "http://" (.. js/window -location -hostname) ":8888"))

;; For demo session
(def demo-servers
  [{:name "muenchhausen"
    :dbas "http://muenchhausen.cn.uni-duesseldorf.de:4284/api"
    :eden "http://muenchhausen.cn.uni-duesseldorf.de:8888"}
   {:name "slurpy"
    :dbas "http://slurpy.cn.uni-duesseldorf.de:4284/api"
    :eden "http://slurpy.cn.uni-duesseldorf.de:8888"}
   {:name "discuss"
    :dbas "http://discuss.cn.uni-duesseldorf.de:4284/api"
    :eden "http://discuss.cn.uni-duesseldorf.de:8888"}
   {:name "localhost without eden"
    :dbas "http://localhost:4284/api"
    :eden nil}])

(def initial-discussions
  [{:slug "public"}])

(def log-level
  "Available log-levels: :severe :warning :info :config :fine :finer :finest."
  :fine)

(def api {:init (default-slug initial-discussions)
          :base  "/"
          :graphql "/v2/query"
          :login "/login"
          :logout "/logout"
          :add   {:add-start-statement "/add/start_statement"
                  :add-start-premise   "/add/start_premise"
                  :add-justify-premise "/add/justify_premise"}
          :get   {:references       "/references"
                  :reference-usages "/reference/usages"
                  :statements       "/statements"
                  :statement-url    "/statement/url"}
          :jump  "/:slug/jump/:argument-id"})

(def eden {:add/argument               "/argument"
           :search/arguments-by-author "/arguments/by-author"})

Add toggle for generative tests

Add toggle for generative tests


(ns grimoire.things
  "This namespace implements a \"thing\" structure, approximating a URI, for
  uniquely naming and referencing entities in a Grimoire documentation
  store.

  Thing     ::= Sum[Group, Artifact, Version, Platform,
                    Namespace, Def, Note, Example];
  Group     ::= Record[                   Name: String];
  Artifact  ::= Record[Parent: Group,     Name: String];
  Version   ::= Record[Parent: Artifact,  Name: String];
  Platform  ::= Record[Parent: Version,   Name: String];
  Namespace ::= Record[Parent: Platform,  Name: String];
  Def       ::= Record[Parent: Namespace, Name: String];

  Note      ::= Record[Parent: Thing,     Handle: String];
  Example   ::= Record[Parent: Thing,     Handle: String];"
  (:refer-clojure :exclude [def namespace])
  (:require [clojure.string :as string]
            [grimoire.util :as u]
            [detritus.variants :as v]
            [cemerick.url :as url]))

(v/deftag group
  "Represents a Maven group."
  [name]
  {:pre [(string? name)]})

(v/deftag artifact
  "Represents a Maven artifact, rooted on a group."
  [parent, name]
  {:pre [(group? parent)
         (string? name)]})

(v/deftag version
  "Represents a Maven version, rooted on an artifact."
  [parent, name]
  {:pre [(artifact? parent)
         (string? name)]})

(v/deftag platform
  "Represents a Clojure \"platform\" rooted on a version of an
  artifact.

  Platforms are a construct and represent a versioned set of
  namespaces (and thus of defs) defining the versioned package at that
  version. The idea is that a single artifact may have \"platform\"
  code for any of Clojure, ClojureScript, ClojureCLR and soforth
  simultaneously. Selecting a platform in a tree thus selects a set of
  namespaces and defs which are particular to this platform. It also
  allows Grimoire to host what would otherwise be name-colliding
  functions which are really implicitly differentiated by platform."
  [parent, name]
  {:pre [(version? parent)
         (string? name)]})

(v/deftag namespace
  "Represents a Clojure \"namespace\" rooted on a platform in a
  version of an artifact."
  [parent, name]
  {:pre [(platform? parent)
         (string? name)]})

(v/deftag def
  "Represents a Clojure \"Def\" rooted in a namespace on a platform in
  a version of an artifact."
  [parent, name]
  {:pre [(namespace? parent)
         (string? name)]})

(declare thing?)

(v/deftag note
  "Represents a single block of notes on an arbitrary Thing as
  identified by a Handle. The Handle is intended to be some structure
  such as a file path, record ID, UUID or something else uniquely
  naming a specific note."
  [parent, handle]
  {:pre [(thing? parent)
         (string? handle)]})

(def ->Note "Alias for ->note." ->note)

(v/deftag example
  "Represents a single example on an arbitrary Thing as identified by
  a Handle. The Handle is intended to be some structure such as a file
  path, record ID, UUID or other unique identifier for that singular
  specific example."
  [parent, handle]
  {:pre [(thing? parent)
         (string? handle)]})

(def ->Example "Alias for ->example." ->example)

;; Helpers for walking thing paths

(defn leaf?
  "Predicate testing whether the input Thing is either an example or a
  note."
  [t]
  (or (note? t)
      (example? t)))

(defn namespaced?
  "Predicate testing whether the input either is a namespace or has a namespace
  as a parent."
  [t]
  (or (namespace? t)
      (def? t)
      (and (leaf? t)
           (namespaced? (:parent t)))))

(defn platformed?
  "Predicate testing whether the input either is a platform or has a platform as
  a parent."
  [t]
  (or (namespaced? t)
      (platform? t)
      (and (leaf? t)
           (platformed? (:parent t)))))

(defn versioned?
  "Predicate testing whether the input exists within the subset of the \"thing\"
  variant which can be said to be \"versioned\" in that it is rooted on a
  Version instance and thus a version instance can be reached by upwards
  traversal."
  [t]
  (or (platformed? t)
      (version? t)
      (and (leaf? t)
           (versioned? (:parent t)))))

(defn artifacted?
  "Predicate testing whether the input either is an artifact or has an artifact
  as a parent."
  [t]
  (or (versioned? t)
      (artifact? t)
      (and (leaf? t)
           (artifacted? (:parent t)))))

(defn grouped?
  "Predicate testing whether the input either is a group or has a group as a
  parent."
  [t]
  (or (artifacted? t)
      (group? t)
      (and (leaf? t)
           (grouped? (:parent t)))))

(defn thing?
  "Predicate testing whether the input exists within the \"thing\" variant of
  Σ[Group, Artifact,Version, Platform, Namespace, Def]"
  [t]
  (grouped? t))

(defn thing->parent
  "Function from any object to Maybe[Thing]. If the input is a thing, returns
  the parent (maybe nil) of that Thing. Otherwise returns nil."
  [t]
  (when (thing? t)
    (:parent t)))

(defn thing->name
  "Function from an object to Maybe[String]. If the input is a thing, returns
  the name of the Thing. Otherwise returns nil."
  [t]
  {:pre [(thing? t)
         (not (leaf? t))]}
  (:name t))

;; Helpers for stringifying and reading paths

(defn thing->path
  "Provides a mechanism for converting one of the Handle objects into a
  cannonical \"path\" which can be serialized, deserialized and walked back into
  a Handle."
  [t]
  {:pre [(thing? t)]}
  (or (::url t)
      (->> t
           (iterate thing->parent)
           (take-while identity)
           (reverse)
           (map thing->name)
           (interpose "/")
           (apply str))))

;; smarter url caching constructors

(defn ->Group
  ([groupid]
   {:pre [(string? groupid)]}
   (let [v (->group groupid)]
     (assoc v ::url (thing->path v))))

  ([_ groupid]
   (->Group groupid)))

(defn ->Artifact
  [group artifact]
  (let [v (->artifact group artifact)]
    (assoc v ::url (thing->path v))))

(defn ->Version
  [artifact version]
  (let [v (->version artifact version)]
    (assoc v ::url (thing->path v))))

(defn ->Platform
  [version platform]
  (let [v (->platform version (u/normalize-platform platform))]
    (assoc v ::url (thing->path v))))

(defn ->Ns
  [platform namespace]
  (let [v (->namespace platform namespace)]
    (assoc v ::url (thing->path v))))

(defn ->Def
  [namespace name]
  (let [v (->def namespace name)]
    (assoc v ::url (thing->path v))))

;; Manipulating things and strings

(defn path->thing
  "String to Thing transformer which builds a Thing tree by splitting on /. The
  resulting things are rooted on a Group as required by the definition of a
  Thing."
  [path]
  (->> (string/split path #"/")
       (map vector [->Group ->Artifact ->Version ->Platform ->Ns ->Def])
       (reduce (fn [acc [f v]]
                 (if v (f acc v) acc))
               nil)))

(defn thing->relative-path
  "Function from a Thing type and a Thing instance which walks the instance's
  parent tree until it reaches an instance of the given Thing type. Returns a
  string representing the relative path of the given Thing instance with respect
  to the parent Thing type."
  [t thing]
  {:pre [(thing? thing)
         (v/TagDescriptor? t)]}
  (->> thing
       (iterate thing->parent)
       (take-while identity)
       (take-while #(not= (v/tag %1) (:tag t)))
       (reverse)
       (map thing->name)
       (interpose "/")
       (apply str)))

(defn thing->root-to
  "Complement of thing->relative-path. Given a Thing instance and a Thing type,
  returns the subpath of the given Thing instance from the root (Group) to the
  given Thing type."
  [t thing]
  {:pre [(thing? thing)
         (v/TagDescriptor? t)]}
  (->> thing
       (iterate thing->parent)
       (take-while identity)
       (drop-while #(not= (v/tag %1) (:tag t)))
       (reverse)
       (map thing->name)
       (interpose "/")
       (apply str)))

(defn ensure-thing
  "Transformer which, if given a string, will construct a Thing (with a warning)
  and if given a Thing will return the Thing without modification. Intended as a
  guard for potentially mixed input situations."
  [maybe-thing]
  (cond (string? maybe-thing)
        ,,(do (.write *err* "Warning: building a thing from a string via ensure-string!\n")
              (path->thing maybe-thing))

        (thing? maybe-thing)
        ,,maybe-thing

        :else
        ,,(throw
           (Exception.
            (str "Unsupported ensure-thing value "
                 (pr-str maybe-thing))))))

;; Traversing things

(defn thing->group
  "Function from a Thing to a Group. If the Thing is rooted on a Group,
  or is a Group, traverses thing->parent until a Group is produced. Otherwise
  returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (grouped? t)
    (if-not (group? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->artifact
  "Function from a Thing to an Artifact. If the Thing is rooted on an Artifact,
  or is an Artifact, traverses thing->parent until the rooting Artifact is
  reached and then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (artifacted? t)
    (if-not (artifact? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->version
  "Function from a Thing to a Verison. If the Thing is rooted on a Version or is
  a Version, traverses thing->parent until the rooting Version is reached and
  then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (versioned? t)
    (if-not (version? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->platform
  "Function from a Thing to a Platform. If the Thing is rooted on a Platform or
  is a Platform traverses thing->parent until the rooting Platform is reached
  and then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (platformed? t)
    (if-not (platform? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->namespace
  "Function from a Thing to a Namespace. If the Thing is rooted on a Platform or
  is a Platform traverses thing->parent until the rooting Platform is reached
  and then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (namespaced? t)
    (if-not (namespace? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->def
  "Function from a Thing to a Def. If the Thing either is a Def or is rooted on
  a Def, traverses thing->parent until the rooting Def is reached and then
  returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (def? t) t))

;; Bits and bats

(defn thing->url
  "Function from a Thing to a munged and URL safe Thing path"
  [t]
  {:pre [(thing? t)
         (not (leaf? t))]}
  (if (def? t)
    (str (thing->path (thing->parent t))
         "/" (u/munge (thing->name t)))
    (thing->path t)))

;; FIXME: this function could probably be a little more principled,
;; but so be it.
(defn url->thing
  "Function from a URL to a Thing. Complement of thing->url."
  [url]
  (let [path-elems (string/split url #"/")
        path-elems (if (<= 6 (count path-elems))
                     (concat
                      (take 5 path-elems)
                      [(url/url-decode (nth path-elems 5))]
                      (drop 6 path-elems))
                     path-elems)]
    (println path-elems)
    (path->thing (string/join "/" path-elems))))

(ns grimoire.things
  "This namespace implements a \"thing\" structure, approximating a URI, for
  uniquely naming and referencing entities in a Grimoire documentation
  store.

  Thing     ::= Sum[Group, Artifact, Version, Platform,
                    Namespace, Def, Note, Example];
  Group     ::= Record[                   Name: String];
  Artifact  ::= Record[Parent: Group,     Name: String];
  Version   ::= Record[Parent: Artifact,  Name: String];
  Platform  ::= Record[Parent: Version,   Name: String];
  Namespace ::= Record[Parent: Platform,  Name: String];
  Def       ::= Record[Parent: Namespace, Name: String];

  Note      ::= Record[Parent: Thing,     Handle: String];
  Example   ::= Record[Parent: Thing,     Handle: String];"
  (:refer-clojure :exclude [def namespace])
  (:require [clojure.string :as string]
            [grimoire.util :as u]
            [detritus.variants :as v]
            [cemerick.url :as url]))

(v/deftag group
  "Represents a Maven group."
  [name]
  {:pre [(string? name)]})

(v/deftag artifact
  "Represents a Maven artifact, rooted on a group."
  [parent, name]
  {:pre [(group? parent)
         (string? name)]})

(v/deftag version
  "Represents a Maven version, rooted on an artifact."
  [parent, name]
  {:pre [(artifact? parent)
         (string? name)]})

(v/deftag platform
  "Represents a Clojure \"platform\" rooted on a version of an
  artifact.

  Platforms are a construct and represent a versioned set of
  namespaces (and thus of defs) defining the versioned package at that
  version. The idea is that a single artifact may have \"platform\"
  code for any of Clojure, ClojureScript, ClojureCLR and soforth
  simultaneously. Selecting a platform in a tree thus selects a set of
  namespaces and defs which are particular to this platform. It also
  allows Grimoire to host what would otherwise be name-colliding
  functions which are really implicitly differentiated by platform."
  [parent, name]
  {:pre [(version? parent)
         (string? name)]})

(v/deftag namespace
  "Represents a Clojure \"namespace\" rooted on a platform in a
  version of an artifact."
  [parent, name]
  {:pre [(platform? parent)
         (string? name)]})

(v/deftag def
  "Represents a Clojure \"Def\" rooted in a namespace on a platform in
  a version of an artifact."
  [parent, name]
  {:pre [(namespace? parent)
         (string? name)]})

(declare thing?)

(v/deftag note
  "Represents a single block of notes on an arbitrary Thing as
  identified by a Handle. The Handle is intended to be some structure
  such as a file path, record ID, UUID or something else uniquely
  naming a specific note."
  [parent, handle]
  {:pre [(thing? parent)
         (string? handle)]})

(def ->Note "Alias for ->note." ->note)

(v/deftag example
  "Represents a single example on an arbitrary Thing as identified by
  a Handle. The Handle is intended to be some structure such as a file
  path, record ID, UUID or other unique identifier for that singular
  specific example."
  [parent, handle]
  {:pre [(thing? parent)
         (string? handle)]})

(def ->Example "Alias for ->example." ->example)

;; Helpers for walking thing paths

(defn leaf?
  "Predicate testing whether the input Thing is either an example or a
  note."
  [t]
  (or (note? t)
      (example? t)))

(defn namespaced?
  "Predicate testing whether the input either is a namespace or has a namespace
  as a parent."
  [t]
  (or (namespace? t)
      (def? t)
      (and (leaf? t)
           (namespaced? (:parent t)))))

(defn platformed?
  "Predicate testing whether the input either is a platform or has a platform as
  a parent."
  [t]
  (or (namespaced? t)
      (platform? t)
      (and (leaf? t)
           (platformed? (:parent t)))))

(defn versioned?
  "Predicate testing whether the input exists within the subset of the \"thing\"
  variant which can be said to be \"versioned\" in that it is rooted on a
  Version instance and thus a version instance can be reached by upwards
  traversal."
  [t]
  (or (platformed? t)
      (version? t)
      (and (leaf? t)
           (versioned? (:parent t)))))

(defn artifacted?
  "Predicate testing whether the input either is an artifact or has an artifact
  as a parent."
  [t]
  (or (versioned? t)
      (artifact? t)
      (and (leaf? t)
           (artifacted? (:parent t)))))

(defn grouped?
  "Predicate testing whether the input either is a group or has a group as a
  parent."
  [t]
  (or (artifacted? t)
      (group? t)
      (and (leaf? t)
           (grouped? (:parent t)))))

(defn thing?
  "Predicate testing whether the input exists within the \"thing\" variant of
  Σ[Group, Artifact,Version, Platform, Namespace, Def]"
  [t]
  (grouped? t))

(defn thing->parent
  "Function from any object to Maybe[Thing]. If the input is a thing, returns
  the parent (maybe nil) of that Thing. Otherwise returns nil."
  [t]
  (when (thing? t)
    (:parent t)))

(defn thing->name
  "Function from an object to Maybe[String]. If the input is a thing, returns
  the name of the Thing. Otherwise returns nil."
  [t]
  {:pre [(thing? t)
         (not (leaf? t))]}
  (:name t))

;; Helpers for stringifying and reading paths

(defn thing->path
  "Provides a mechanism for converting one of the Handle objects into a
  cannonical \"path\" which can be serialized, deserialized and walked back into
  a Handle."
  [t]
  {:pre [(thing? t)]}
  (or (::url t)
      (->> t
           (iterate thing->parent)
           (take-while identity)
           (reverse)
           (map thing->name)
           (interpose "/")
           (apply str))))

;; smarter url caching constructors

(defn ->Group
  ([groupid]
   {:pre [(string? groupid)]}
   (let [v (->group groupid)]
     (assoc v ::url (thing->path v))))

  ([_ groupid]
   (->Group groupid)))

(defn ->Artifact
  [group artifact]
  (let [v (->artifact group artifact)]
    (assoc v ::url (thing->path v))))

(defn ->Version
  [artifact version]
  (let [v (->version artifact version)]
    (assoc v ::url (thing->path v))))

(defn ->Platform
  [version platform]
  (let [v (->platform version (u/normalize-platform platform))]
    (assoc v ::url (thing->path v))))

(defn ->Ns
  [platform namespace]
  (let [v (->namespace platform namespace)]
    (assoc v ::url (thing->path v))))

(defn ->Def
  [namespace name]
  (let [v (->def namespace name)]
    (assoc v ::url (thing->path v))))

(defn ->Example
  [thing name handle]
  (let [v (->example thing name handle)]
    (assoc v ::url handle)))

(defn ->Note
  [thing name handle]
  (let [v (->note thing name handle)]
    (assoc v ::url handle)))

;; Manipulating things and strings

(defn path->thing
  "String to Thing transformer which builds a Thing tree by splitting on /. The
  resulting things are rooted on a Group as required by the definition of a
  Thing."
  [path]
  (->> (string/split path #"/")
       (map vector [->Group ->Artifact ->Version ->Platform ->Ns ->Def])
       (reduce (fn [acc [f v]]
                 (if v (f acc v) acc))
               nil)))

(defn thing->relative-path
  "Function from a Thing type and a Thing instance which walks the instance's
  parent tree until it reaches an instance of the given Thing type. Returns a
  string representing the relative path of the given Thing instance with respect
  to the parent Thing type."
  [t thing]
  {:pre [(thing? thing)
         (v/TagDescriptor? t)]}
  (->> thing
       (iterate thing->parent)
       (take-while identity)
       (take-while #(not= (v/tag %1) (:tag t)))
       (reverse)
       (map thing->name)
       (interpose "/")
       (apply str)))

(defn thing->root-to
  "Complement of thing->relative-path. Given a Thing instance and a Thing type,
  returns the subpath of the given Thing instance from the root (Group) to the
  given Thing type."
  [t thing]
  {:pre [(thing? thing)
         (v/TagDescriptor? t)]}
  (->> thing
       (iterate thing->parent)
       (take-while identity)
       (drop-while #(not= (v/tag %1) (:tag t)))
       (reverse)
       (map thing->name)
       (interpose "/")
       (apply str)))

(defn ensure-thing
  "Transformer which, if given a string, will construct a Thing (with a warning)
  and if given a Thing will return the Thing without modification. Intended as a
  guard for potentially mixed input situations."
  [maybe-thing]
  (cond (string? maybe-thing)
        ,,(do (.write *err* "Warning: building a thing from a string via ensure-string!\n")
              (path->thing maybe-thing))

        (thing? maybe-thing)
        ,,maybe-thing

        :else
        ,,(throw
           (Exception.
            (str "Unsupported ensure-thing value "
                 (pr-str maybe-thing))))))

;; Traversing things

(defn thing->group
  "Function from a Thing to a Group. If the Thing is rooted on a Group,
  or is a Group, traverses thing->parent until a Group is produced. Otherwise
  returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (grouped? t)
    (if-not (group? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->artifact
  "Function from a Thing to an Artifact. If the Thing is rooted on an Artifact,
  or is an Artifact, traverses thing->parent until the rooting Artifact is
  reached and then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (artifacted? t)
    (if-not (artifact? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->version
  "Function from a Thing to a Verison. If the Thing is rooted on a Version or is
  a Version, traverses thing->parent until the rooting Version is reached and
  then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (versioned? t)
    (if-not (version? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->platform
  "Function from a Thing to a Platform. If the Thing is rooted on a Platform or
  is a Platform traverses thing->parent until the rooting Platform is reached
  and then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (platformed? t)
    (if-not (platform? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->namespace
  "Function from a Thing to a Namespace. If the Thing is rooted on a Platform or
  is a Platform traverses thing->parent until the rooting Platform is reached
  and then returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (namespaced? t)
    (if-not (namespace? t)
      (when t
        (recur (thing->parent t)))
      t)))

(defn thing->def
  "Function from a Thing to a Def. If the Thing either is a Def or is rooted on
  a Def, traverses thing->parent until the rooting Def is reached and then
  returns that value. Otherwise returns nil."
  [t]
  {:pre [(thing? t)]}
  (when (def? t) t))

;; Bits and bats

(defn thing->url
  "Function from a Thing to a munged and URL safe Thing path"
  [t]
  {:pre [(thing? t)
         (not (leaf? t))]}
  (if (def? t)
    (str (thing->path (thing->parent t))
         "/" (u/munge (thing->name t)))
    (thing->path t)))

;; FIXME: this function could probably be a little more principled,
;; but so be it.
(defn url->thing
  "Function from a URL to a Thing. Complement of thing->url."
  [url]
  (let [path-elems (string/split url #"/")
        path-elems (if (<= 6 (count path-elems))
                     (concat
                      (take 5 path-elems)
                      [(url/url-decode (nth path-elems 5))]
                      (drop 6 path-elems))
                     path-elems)]
    (println path-elems)
    (path->thing (string/join "/" path-elems))))

Add real ->Example and ->Note impls

Add real ->Example and ->Note impls


(ns hatti.charting
  (:require [c2.layout.histogram :refer [histogram]]
            [c2.scale :as scale]
            [c2.svg :as svg]
            [#?(:clj  clj-time.format
                :cljs cljs-time.format) :as tf]
            [#?(:clj  clj-time.coerce
                :cljs cljs-time.coerce) :as tc]
            [#? (:clj clojure.math.numeric-tower
                :cljs hatti.maths) :refer [gcd lcm floor ceil abs]]
            #?(:cljs [hatti.utils :refer [format]])
            [hatti.ona.forms :as f]
            [clojure.string :refer [join blank?]]))

(def millis-in-day 86400000)

(defn- safe-floor
  "Like floor but returns nil if passed nil."
  [n]
  #?(:clj (try
             (floor n)
             (catch IllegalArgumentException e nil))
     :cljs (floor n)))

(defn- style
  "Helper function to create the style argument in hiccup vectors.
  (style :width '200px' :height '100px') => {:style 'width:200px;height:100px'}"
  [style-map]
  {:style #?(:cljs style-map
             :clj  (->> (for [[k v] style-map]
                          (str (name k) ": " v))
                     (join ";" )))})

(defn parse-int
  "Parse an integer from a string."
  [st]
  #?(:clj (when st (if (instance? String st)
                       (when-not (blank? st) (read-string st))
                       st))
     :cljs (let [ans (js/parseInt st)] (if (js/isNaN ans) nil ans))))

(defn str->int [typ]
  "Converts string to integer, for typ (int|date)."
  (case typ
    "int" parse-int
    "date" #(let [l (tc/to-long (new js/Date %))]
              (when l (safe-floor (/ l millis-in-day))))))

(defn int->str [typ &{:keys [digits]
                      :or   {digits 1}}]
  "Converts integers to strings, for type (int|date).
   Optional digits parameter = number of digits after decimal, default is 1."
  (let [int-fmt-s (str "%." digits "f")
        d->millis #(* millis-in-day %)
        date->str #? (:clj  #(tf/unparse (tf/formatters :year-month-day)
                                         (tc/from-long  %))
                      :cljs #(.format (js/moment %) "ll"))]
    (case typ
      "int"  #(format int-fmt-s (float %))
      "date" #(date->str (d->millis %)))))

(defn range->str [[mn mx] typ]
  "Converts a range of typ (int|date) to a string."
  (let [[mn mx] [(ceil mn) (safe-floor mx)]
        fmt (int->str typ :digits 0)]
    (if (<= mx mn) (fmt mn)
      (join " to " [(fmt mn) (fmt mx)]))))

#?(:cljs
   (defn evenly-spaced-bins
     "Given a list of answers, returns each one as a bin, in string form.
   nil is mapped to nil. The bins, in order, are returned as metadata.
   eg. (evenly-spaced-bins [1 2 10] 5 'int') => ['1 to 2' '1 to 2' '9 to 10']
   metadata of this above value would be:
   {:bins ['1 to 2', '3 to 4', '5 to 6', '7 to 8', '9 to 10']}"
     [answers bins typ]
     (let [numbers (map (str->int typ) answers)
           mx (reduce max (remove nil? numbers))
           mn (reduce min (remove nil? numbers))
           s (scale/linear :domain [mn mx] :range [0 (- bins (/ 1 10000))])
           is (map safe-floor (map #(when % (s %)) numbers))
           t (scale/linear :domain [0 bins] :range [mn mx])
           lbounds (->> (range bins) (map t) (map float) distinct)
           ubounds (conj (mapv #(if (= % (safe-floor %))
                                  (dec %) %) (drop 1 lbounds)) mx)
           fmt (int->str typ :digits 0)
           strings (mapv #(range->str [%1 %2] typ) lbounds ubounds)
           results (map (fn [i] (when i (get strings (int i)))) is)
           strings (-> strings distinct vec)] ; remove repeats before output
       (with-meta results
         {:bins (if (contains? (set answers) nil)
                  (conj strings nil) strings)}))))

(defn label-count-pairs
  "Take chart-data from the ona API, returns label->count map.
   eg. Input: {:field_xpath 'D' :data [{:count 2 :D ['Option_1']}]}
   Output: {:Option_1 2}
   eg. Input: {:field_xpath 'D' :data [{:count 1 :D ['O1' 'O_2']
   :count 2 :D ['O1']}]}
   Output: {:Option_1 3 :O_2 1}"
  ([chart-data] (label-count-pairs chart-data nil))
  ([chart-data language]
   (let [{:keys [data field_xpath]} chart-data
         unboxed (for [data-item data]
                   (let [labels ((keyword field_xpath) data-item)
                         count (:count data-item)
                         ;; labelify / get-labels deals with multiple languages
                         labelify #(f/get-label {:label %} language)]
                     (map #(hash-map (labelify %) count) labels)))]
     (->> unboxed
          flatten
          (apply merge-with +)
          (sort-by last >)))))

(defn- num-bins
  "Determine number of bins if there are n possible of values of data.
  Custom algorithm, based on a pleasant range of bins being between
  roughly 7 and 15 (though customizable). Idea is that we try to divide
  n into a number between "
  [n &{:keys [data-type]
       :or   {data-type "int"}}]
  (let [rough-min 7 rough-max 15 real-max 24
        full-range (range rough-min rough-max)
        best-guess (apply max (map (partial gcd n) full-range))]
    (if (< best-guess rough-min)
      (apply (partial min real-max n) (map (partial lcm n) full-range))
      best-guess)))

(defn- extract-data-for-histogram
  "Turn numerical / date chart-data from ona API histogram-friendly.
  Return data looks like [(x dx y)] with-meta {:bins num-bins}."
  [chart-data &{:keys [data-type]
                :or   {data-type "int"}}]
  (let [{:keys [data field_xpath]} chart-data
        retype-fn (str->int data-type)
        qn-key (keyword field_xpath)
        retyped-data (map (fn [el]
                            (update-in el [qn-key] retype-fn))
                          data)
        data-range (- (apply max (map qn-key retyped-data))
                      (apply min (map qn-key retyped-data)))
        bins (if (zero? data-range) 1
               (num-bins data-range :data-type data-type))
        binned-data (histogram retyped-data :value qn-key :bins bins)]
    (with-meta
      (for [data-item binned-data]
        [(:x (meta data-item))
         (:dx (meta data-item))
         (apply + (map :count data-item))])
      {:bins bins})))

(defn counts->lengths
  "Produces a linear mapping [0,max-count] -> [0, max-length], for data which
   is a vector, each element a map with key :count. If total-asmax?, then
   linear map is [0,total-count] -> [0, max-length]."
  [data max-length &{:keys [total-as-max? datamin-as-min?]
                     :or [total-as-max? false datamin-as-min? false]}]
   (let [counts (map :count data)
         xmax (if total-as-max? (reduce + 0 counts) (reduce max 0 counts))
         xmin (if datamin-as-min? (reduce min 0 counts) 0)
         scale (scale/linear :domain [xmin xmax]
                             :range [0 max-length])]
     (map scale counts)))

(defn- response-count-message
  [response-count]
  [:div.t-right.t-grey (str "Based on " response-count " responses.")])

(defn numeric-chart
  "Create numeric (or date) chart out of some chart-data from ona API."
  [chart-data &{:keys [data-type]
                :or   {data-type "int"}}]
  (let [chart-width 700.0 chart-height 300.0
        margin 33.0 small-margin 2.0 y-lim 8.0 neg-margin -15
        extracted-data (extract-data-for-histogram chart-data :data-type data-type)
        {:keys [nil-count non-nil-count]} (meta chart-data)
        bins (:bins (meta extracted-data))
        x-series (map first extracted-data)
        dx-series (map second extracted-data)
        y-series (map last extracted-data)
        xmin (apply min x-series)
        xmax (+ (apply max x-series) (last dx-series))
        x-scale (scale/linear :domain [xmin xmax]
                              :range [0 chart-width])
        y-scale (scale/linear :domain [0 (apply max y-series)]
                              :range [0 chart-height])
        bin-width (safe-floor (- (/ chart-width bins) small-margin))
        x-ticks (take-nth 2 (rest x-series))
        fmt (int->str data-type)]
    (if (= 1 (count extracted-data))
      (let [[value _ total] (first extracted-data)]
        [:div [:p total " records have identical value: " (fmt value)]])
      [:div
       [:svg {:width (+ margin chart-width) :height (+ margin chart-height)}
        [:g.chart {:transform (svg/translate [margin 0])}
         [:g
          (for [[x dx y] extracted-data]
            (let [x-scaled (float (x-scale x))
                  y-scaled (float (y-scale y))
                  [y-scaled txt-ht txt-cls]
                  (if (< 0 y-scaled y-lim) ; y is tiny but positive
                    [small-margin neg-margin "out-of-bar"]
                    [y-scaled small-margin "in-bar"])]
              [:g.bars {:transform
                        (svg/translate
                         [x-scaled (- chart-height y-scaled)])}
               [:g [:rect {:x 1 :height y-scaled :width bin-width}]]
               (when (pos? y-scaled)
                 [:text {:y txt-ht :x (/ bin-width 2.0) :dy "1em"
                         :text-anchor "middle" :class txt-cls} y])]))]
         [:g.axis {:transform (svg/translate [0 chart-height])}
          [:line {:x1 0 :x2 chart-width}]
          [:g (for [x x-ticks]
                [:g.tick {:transform
                          (svg/translate [(float (x-scale x)) 0])}
                 [:text {:y 25 :text-anchor "middle" :class data-type}
                  (fmt x)]
                 [:line {:class "tick" :y2 10 :x2 0}]])]]]]
       (response-count-message non-nil-count)])))

(defn table-chart-h
  [data nil-count non-nil-count field_type]
  "Create category bar chart out of some data + count data. Data of form:
  {'Label1' 1 'Label2' 2}, etc. where the numbers are counts."
  (let [max-count (apply max (vals data))
        percent-s (fn [n total]
                    (let [s (scale/linear :domain [0 total] :range [0 100])]
                      (str (format "%.1f" (float (s n))) "%")))
        select-mult? (= field_type "select all that apply")
        bar-div (if select-mult? :div.bars.select-mult :div.bars.select-one)
        ;; sablono/react.js use col-span
        colspan #? (:clj :colspan :cljs :col-span)
        tdr :td.t-right]
    [:table#bar-chart.table
     [:thead
      [:tr [:th] [:th] [:th.t-right "Count"] [:th.t-right "Percent"]]]
     [:tfoot
           (if select-mult?
         [:tr.t-grey [tdr {colspan 4} (response-count-message non-nil-count)]]
         [:tr.t-grey [tdr] [tdr "Total"] [tdr non-nil-count] [tdr "100%"]])
      (when (and (not select-mult?) (pos? nil-count))
        [:tr.t-grey
         [:td] [:td.t-right "No response"] [:td.t-right nil-count] [:td]])]
     [:tbody
      (for [[label val] data]
        [:tr
         [:td {:title label} label]
         [:td [bar-div (style {:width (percent-s val max-count)})]]
         [:td.t-right val]
         [:td.t-right (percent-s val non-nil-count)]])]]))

(defn extract-nil
  "Removes nil from Ona API chart data; adds nil- and non-nil-count metadata.
   ex. Input:  {:field_xpath 'D' :data [{:D nil :count 5} {:D 1 :count 10}]}
       Output: {:field_xpath 'D' :data [{:D 1 :count 10}]}
               w/ metadata: {:nil-count 5 :non-nil-count 10}"
  [chart-data]
  (let [{:keys [field_xpath data]} chart-data
        na? #(or (nil? %) (= [] %))
        nil-data (first (filter #(na? ((keyword field_xpath) %)) data))
        non-nil-data (remove #(na? ((keyword field_xpath) %)) data)
        nil-count (if-let [n (:count nil-data)] n 0)
        non-nil-count (apply + (map :count non-nil-data))]
    (with-meta (assoc chart-data :data non-nil-data)
      {:nil-count nil-count :non-nil-count non-nil-count})))

(defn make-chart
  "Make chart depending on datatype."
  ([chart-data] (make-chart chart-data nil))
  ([chart-data language]
   (let [{:keys [field_label data_type field_xpath field_type]} chart-data
         chart-data (extract-nil chart-data)
         {:keys [nil-count non-nil-count]} (meta chart-data)
         not-supported #(vector :div.t-red
                                (str "Aplogies. At the moment, making a chart of
                                     this data type (" % ") is not supported."))
         chart (if (zero? non-nil-count)
                 [:p "No data"]
                 (case data_type
                   "categorized" (table-chart-h (label-count-pairs chart-data language)
                                                nil-count
                                                non-nil-count
                                                field_type)
                   "time_based"  (numeric-chart chart-data
                                                :data-type "date")
                   "numeric"     (numeric-chart chart-data)
                   (not-supported data_type)))]
     {:label field_label :name field_xpath
      :chart [:div chart ]})))

(ns hatti.charting
  (:require [c2.layout.histogram :refer [histogram]]
            [c2.scale :as scale]
            [c2.svg :as svg]
            [#?(:clj  clj-time.format
                :cljs cljs-time.format) :as tf]
            [#?(:clj  clj-time.coerce
                :cljs cljs-time.coerce) :as tc]
            [#? (:clj clojure.math.numeric-tower
                :cljs hatti.maths) :refer [gcd lcm floor ceil abs]]
            #?(:cljs [hatti.utils :refer [format]])
            [hatti.ona.forms :as f]
            [clojure.string :refer [join blank?]]))

(def millis-in-day 86400000)

(defn- safe-floor
  "Like floor but returns nil if passed nil."
  [n]
  #?(:clj (try
             (floor n)
             (catch IllegalArgumentException e nil))
     :cljs (floor n)))

(defn- style
  "Helper function to create the style argument in hiccup vectors.
  (style :width '200px' :height '100px') => {:style 'width:200px;height:100px'}"
  [style-map]
  {:style #?(:cljs style-map
             :clj  (->> (for [[k v] style-map]
                          (str (name k) ": " v))
                     (join ";" )))})

(defn parse-int
  "Parse an integer from a string."
  [st]
  #?(:clj (when st (if (instance? String st)
                       (when-not (blank? st) (read-string st))
                       st))
     :cljs (let [ans (js/parseInt st)] (if (js/isNaN ans) nil ans))))

(defn str->int [typ]
  "Converts string to integer, for typ (int|date)."
  (case typ
    "int" parse-int
    "date" (fn [date-string]
             (when date-string
               (-> (new js/Date date-string)
                   tc/to-long
                   (/ millis-in-day)
                   safe-floor)))))

(defn int->str [typ &{:keys [digits]
                      :or   {digits 1}}]
  "Converts integers to strings, for type (int|date).
   Optional digits parameter = number of digits after decimal, default is 1."
  (let [int-fmt-s (str "%." digits "f")
        d->millis #(* millis-in-day %)
        date->str #? (:clj  #(tf/unparse (tf/formatters :year-month-day)
                                         (tc/from-long  %))
                      :cljs (fn [date]
                              (when date
                                (.format (js/moment date) "ll"))))]
    (case typ
      "int"  #(format int-fmt-s (float %))
      "date" #(date->str (d->millis %)))))

(defn range->str [[mn mx] typ]
  "Converts a range of typ (int|date) to a string."
  (let [[mn mx] [(ceil mn) (safe-floor mx)]
        fmt (int->str typ :digits 0)]
    (if (<= mx mn) (fmt mn)
      (join " to " [(fmt mn) (fmt mx)]))))

#?(:cljs
   (defn evenly-spaced-bins
     "Given a list of answers, returns each one as a bin, in string form.
   nil is mapped to nil. The bins, in order, are returned as metadata.
   eg. (evenly-spaced-bins [1 2 10] 5 'int') => ['1 to 2' '1 to 2' '9 to 10']
   metadata of this above value would be:
   {:bins ['1 to 2', '3 to 4', '5 to 6', '7 to 8', '9 to 10']}"
     [answers bins typ]
     (let [numbers (->> answers
                        (map (str->int typ)))
           mx (reduce max (remove nil? numbers))
           mn (reduce min (remove nil? numbers))
           s (scale/linear :domain [mn mx] :range [0 (- bins (/ 1 10000))])
           is (map safe-floor (map #(when % (s %)) numbers))
           t (scale/linear :domain [0 bins] :range [mn mx])
           lbounds (->> (range bins) (map t) (map float) distinct)
           ubounds (conj (mapv #(if (= % (safe-floor %))
                                  (dec %) %) (drop 1 lbounds)) mx)
           fmt (int->str typ :digits 0)
           strings (mapv #(range->str [%1 %2] typ) lbounds ubounds)
           results (map (fn [i] (when i (get strings (int i)))) is)
           strings (-> strings distinct vec)] ; remove repeats before output
       (with-meta results
         {:bins (if (contains? (set answers) nil)
                  (conj strings nil)
                  strings)}))))

(defn label-count-pairs
  "Take chart-data from the ona API, returns label->count map.
   eg. Input: {:field_xpath 'D' :data [{:count 2 :D ['Option_1']}]}
   Output: {:Option_1 2}
   eg. Input: {:field_xpath 'D' :data [{:count 1 :D ['O1' 'O_2']
   :count 2 :D ['O1']}]}
   Output: {:Option_1 3 :O_2 1}"
  ([chart-data] (label-count-pairs chart-data nil))
  ([chart-data language]
   (let [{:keys [data field_xpath]} chart-data
         unboxed (for [data-item data]
                   (let [labels ((keyword field_xpath) data-item)
                         count (:count data-item)
                         ;; labelify / get-labels deals with multiple languages
                         labelify #(f/get-label {:label %} language)]
                     (map #(hash-map (labelify %) count) labels)))]
     (->> unboxed
          flatten
          (apply merge-with +)
          (sort-by last >)))))

(defn- num-bins
  "Determine number of bins if there are n possible of values of data.
  Custom algorithm, based on a pleasant range of bins being between
  roughly 7 and 15 (though customizable). Idea is that we try to divide
  n into a number between "
  [n &{:keys [data-type]
       :or   {data-type "int"}}]
  (let [rough-min 7 rough-max 15 real-max 24
        full-range (range rough-min rough-max)
        best-guess (apply max (map (partial gcd n) full-range))]
    (if (< best-guess rough-min)
      (apply (partial min real-max n) (map (partial lcm n) full-range))
      best-guess)))

(defn- extract-data-for-histogram
  "Turn numerical / date chart-data from ona API histogram-friendly.
  Return data looks like [(x dx y)] with-meta {:bins num-bins}."
  [chart-data &{:keys [data-type]
                :or   {data-type "int"}}]
  (let [{:keys [data field_xpath]} chart-data
        retype-fn (str->int data-type)
        qn-key (keyword field_xpath)
        retyped-data (map (fn [el]
                            (update-in el [qn-key] retype-fn))
                          data)
        data-range (- (apply max (map qn-key retyped-data))
                      (apply min (map qn-key retyped-data)))
        bins (if (zero? data-range) 1
               (num-bins data-range :data-type data-type))
        binned-data (histogram retyped-data :value qn-key :bins bins)]
    (with-meta
      (for [data-item binned-data]
        [(:x (meta data-item))
         (:dx (meta data-item))
         (apply + (map :count data-item))])
      {:bins bins})))

(defn counts->lengths
  "Produces a linear mapping [0,max-count] -> [0, max-length], for data which
   is a vector, each element a map with key :count. If total-asmax?, then
   linear map is [0,total-count] -> [0, max-length]."
  [data max-length &{:keys [total-as-max? datamin-as-min?]
                     :or [total-as-max? false datamin-as-min? false]}]
   (let [counts (map :count data)
         xmax (if total-as-max? (reduce + 0 counts) (reduce max 0 counts))
         xmin (if datamin-as-min? (reduce min 0 counts) 0)
         scale (scale/linear :domain [xmin xmax]
                             :range [0 max-length])]
     (map scale counts)))

(defn- response-count-message
  [response-count]
  [:div.t-right.t-grey (str "Based on " response-count " responses.")])

(defn numeric-chart
  "Create numeric (or date) chart out of some chart-data from ona API."
  [chart-data &{:keys [data-type]
                :or   {data-type "int"}}]
  (let [chart-width 700.0 chart-height 300.0
        margin 33.0 small-margin 2.0 y-lim 8.0 neg-margin -15
        extracted-data (extract-data-for-histogram chart-data :data-type data-type)
        {:keys [nil-count non-nil-count]} (meta chart-data)
        bins (:bins (meta extracted-data))
        x-series (map first extracted-data)
        dx-series (map second extracted-data)
        y-series (map last extracted-data)
        xmin (apply min x-series)
        xmax (+ (apply max x-series) (last dx-series))
        x-scale (scale/linear :domain [xmin xmax]
                              :range [0 chart-width])
        y-scale (scale/linear :domain [0 (apply max y-series)]
                              :range [0 chart-height])
        bin-width (safe-floor (- (/ chart-width bins) small-margin))
        x-ticks (take-nth 2 (rest x-series))
        fmt (int->str data-type)]
    (if (= 1 (count extracted-data))
      (let [[value _ total] (first extracted-data)]
        [:div [:p total " records have identical value: " (fmt value)]])
      [:div
       [:svg {:width (+ margin chart-width) :height (+ margin chart-height)}
        [:g.chart {:transform (svg/translate [margin 0])}
         [:g
          (for [[x dx y] extracted-data]
            (let [x-scaled (float (x-scale x))
                  y-scaled (float (y-scale y))
                  [y-scaled txt-ht txt-cls]
                  (if (< 0 y-scaled y-lim) ; y is tiny but positive
                    [small-margin neg-margin "out-of-bar"]
                    [y-scaled small-margin "in-bar"])]
              [:g.bars {:transform
                        (svg/translate
                         [x-scaled (- chart-height y-scaled)])}
               [:g [:rect {:x 1 :height y-scaled :width bin-width}]]
               (when (pos? y-scaled)
                 [:text {:y txt-ht :x (/ bin-width 2.0) :dy "1em"
                         :text-anchor "middle" :class txt-cls} y])]))]
         [:g.axis {:transform (svg/translate [0 chart-height])}
          [:line {:x1 0 :x2 chart-width}]
          [:g (for [x x-ticks]
                [:g.tick {:transform
                          (svg/translate [(float (x-scale x)) 0])}
                 [:text {:y 25 :text-anchor "middle" :class data-type}
                  (fmt x)]
                 [:line {:class "tick" :y2 10 :x2 0}]])]]]]
       (response-count-message non-nil-count)])))

(defn table-chart-h
  [data nil-count non-nil-count field_type]
  "Create category bar chart out of some data + count data. Data of form:
  {'Label1' 1 'Label2' 2}, etc. where the numbers are counts."
  (let [max-count (apply max (vals data))
        percent-s (fn [n total]
                    (let [s (scale/linear :domain [0 total] :range [0 100])]
                      (str (format "%.1f" (float (s n))) "%")))
        select-mult? (= field_type "select all that apply")
        bar-div (if select-mult? :div.bars.select-mult :div.bars.select-one)
        ;; sablono/react.js use col-span
        colspan #? (:clj :colspan :cljs :col-span)
        tdr :td.t-right]
    [:table#bar-chart.table
     [:thead
      [:tr [:th] [:th] [:th.t-right "Count"] [:th.t-right "Percent"]]]
     [:tfoot
           (if select-mult?
         [:tr.t-grey [tdr {colspan 4} (response-count-message non-nil-count)]]
         [:tr.t-grey [tdr] [tdr "Total"] [tdr non-nil-count] [tdr "100%"]])
      (when (and (not select-mult?) (pos? nil-count))
        [:tr.t-grey
         [:td] [:td.t-right "No response"] [:td.t-right nil-count] [:td]])]
     [:tbody
      (for [[label val] data]
        [:tr
         [:td {:title label} label]
         [:td [bar-div (style {:width (percent-s val max-count)})]]
         [:td.t-right val]
         [:td.t-right (percent-s val non-nil-count)]])]]))

(defn extract-nil
  "Removes nil from Ona API chart data; adds nil- and non-nil-count metadata.
   ex. Input:  {:field_xpath 'D' :data [{:D nil :count 5} {:D 1 :count 10}]}
       Output: {:field_xpath 'D' :data [{:D 1 :count 10}]}
               w/ metadata: {:nil-count 5 :non-nil-count 10}"
  [chart-data]
  (let [{:keys [field_xpath data]} chart-data
        na? #(or (nil? %) (= [] %))
        nil-data (first (filter #(na? ((keyword field_xpath) %)) data))
        non-nil-data (remove #(na? ((keyword field_xpath) %)) data)
        nil-count (if-let [n (:count nil-data)] n 0)
        non-nil-count (apply + (map :count non-nil-data))]
    (with-meta (assoc chart-data :data non-nil-data)
      {:nil-count nil-count :non-nil-count non-nil-count})))

(defn make-chart
  "Make chart depending on datatype."
  ([chart-data] (make-chart chart-data nil))
  ([chart-data language]
   (let [{:keys [field_label data_type field_xpath field_type]} chart-data
         chart-data (extract-nil chart-data)
         {:keys [nil-count non-nil-count]} (meta chart-data)
         not-supported #(vector :div.t-red
                                (str "Aplogies. At the moment, making a chart of
                                     this data type (" % ") is not supported."))
         chart (if (zero? non-nil-count)
                 [:p "No data"]
                 (case data_type
                   "categorized" (table-chart-h (label-count-pairs chart-data language)
                                                nil-count
                                                non-nil-count
                                                field_type)
                   "time_based"  (numeric-chart chart-data
                                                :data-type "date")
                   "numeric"     (numeric-chart chart-data)
                   (not-supported data_type)))]
     {:label field_label :name field_xpath
      :chart [:div chart ]})))

Return nil instead of invalid dates

OO: Return nil instead of invalid dates


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

(ns immutant.web
  "Associate one or more Ring handlers with your application, mounted
   at unique context paths"
  (:require [ring.util.codec        :as codec]
            [ring.util.response     :as response]
            [immutant.logging       :as log]
            [immutant.web.servlet   :as servlet]
            [immutant.util          :as util])
  (:use [immutant.web.internal :only [start* stop*]]
        [immutant.web.middleware :only [add-middleware]])
  (:import javax.servlet.http.HttpServletRequest))

(defn start-servlet
  "Can be used to mount a servlet in lieu of a typical Ring handler"
  [sub-context-path servlet]
  (log/info (str "Starting servlet at URL: " (util/app-uri) sub-context-path))
  (start* sub-context-path
          (servlet/proxy-servlet servlet)
          {}))

(defn start-handler
  "Typically not called directly; use start instead"
  [sub-context-path handler & {:keys [init destroy] :as opts}]
  (log/info (str "Starting handler at URL: " (util/app-uri) sub-context-path))
  (start* sub-context-path
          (servlet/create-servlet (add-middleware handler opts))
          opts))

(defmacro start
  "Starts a Ring handler that will be called when requests
   are received on the given sub-context-path. If no sub-context-path
   is given, \"/\" is assumed.

   The options are a subset of those for ring-server [default]:
     :init          function called after handler is initialized [nil]
     :destroy       function called after handler is stopped [nil]
     :stacktraces?  display stacktraces when exception is thrown [true in :dev]
     :auto-reload?  automatically reload source files [true in :dev]
     :reload-paths  seq of src-paths to reload on change [dirs on classpath]"
  {:arglists '([handler] [handler options] [path handler options])}
  [& args]
  (let [[path args] (if (even? (count args))
                      [(first args) (next args)]
                      ["/" args])
        [handler & opts] args]
    (if (symbol? handler)
      `(start-handler ~path (var ~handler) ~@opts)
      `(start-handler ~path ~handler ~@opts))))

(defn stop
  "Stops the Ring handler or servlet mounted at the given sub-context-path.
   If no sub-context-path is given, \"/\" is assumed."
  ([]
     (stop "/"))
  ([sub-context-path]
     (log/info (str "Stopping handler at URL: " (util/app-uri) sub-context-path))
     (stop* sub-context-path)))

(defn ^HttpServletRequest current-servlet-request
  "Returns the currently active HttpServletRequest. This will only
  return a value within an active ring handler. Standard ring handlers
  should never need to access this value."
  []
  immutant.web.internal/current-servlet-request)

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

(ns immutant.web
  "Associate one or more Ring handlers with your application, mounted
   at unique context paths"
  (:require [ring.util.codec        :as codec]
            [ring.util.response     :as response]
            [immutant.logging       :as log]
            [immutant.web.servlet   :as servlet]
            [immutant.util          :as util])
  (:use [immutant.web.internal :only [start* stop*]]
        [immutant.web.middleware :only [add-middleware]])
  (:import javax.servlet.http.HttpServletRequest))

(defn start-servlet
  "Can be used to mount a servlet in lieu of a typical Ring handler"
  [sub-context-path servlet]
  (log/info (format "Starting servlet for %s at: %s%s" (util/app-name)
              (util/app-uri) sub-context-path))
  (start* sub-context-path
          (servlet/proxy-servlet servlet)
          {}))

(defn start-handler
  "Typically not called directly; use start instead"
  [sub-context-path handler & {:keys [init destroy] :as opts}]
  (log/info (format "Starting handler for %s at: %s%s" (util/app-name)
              (util/app-uri) sub-context-path))
  (start* sub-context-path
          (servlet/create-servlet (add-middleware handler opts))
          opts))

(defmacro start
  "Starts a Ring handler that will be called when requests
   are received on the given sub-context-path. If no sub-context-path
   is given, \"/\" is assumed.

   The options are a subset of those for ring-server [default]:
     :init          function called after handler is initialized [nil]
     :destroy       function called after handler is stopped [nil]
     :stacktraces?  display stacktraces when exception is thrown [true in :dev]
     :auto-reload?  automatically reload source files [true in :dev]
     :reload-paths  seq of src-paths to reload on change [dirs on classpath]"
  {:arglists '([handler] [handler options] [path handler options])}
  [& args]
  (let [[path args] (if (even? (count args))
                      [(first args) (next args)]
                      ["/" args])
        [handler & opts] args]
    (if (symbol? handler)
      `(start-handler ~path (var ~handler) ~@opts)
      `(start-handler ~path ~handler ~@opts))))

(defn stop
  "Stops the Ring handler or servlet mounted at the given sub-context-path.
   If no sub-context-path is given, \"/\" is assumed."
  ([]
     (stop "/"))
  ([sub-context-path]
     (log/info (str "Stopping handler at URL: " (util/app-uri) sub-context-path))
     (stop* sub-context-path)))

(defn ^HttpServletRequest current-servlet-request
  "Returns the currently active HttpServletRequest. This will only
  return a value within an active ring handler. Standard ring handlers
  should never need to access this value."
  []
  immutant.web.internal/current-servlet-request)

Make web logging messages more useful.

Make web logging messages more useful.


(ns oc.email.mailer
  (:require [clojure.string :as s]
            [clojure.java.shell :as shell]
            [clojure.java.io :as io]
            [clojure.walk :refer (keywordize-keys)]
            [oc.email.config :as c]
            [taoensso.timbre :as timbre]
            [amazonica.aws.simpleemail :as ses]
            [oc.email.content :as content]
            [oc.email.invite :as invite]))

(def creds
  {:access-key c/aws-access-key-id
   :secret-key c/aws-secret-access-key
   :endpoint   c/aws-endpoint})

(def default-reply-to (str "hello@" c/email-from-domain))
(def default-inviter "OpenCompany")

(defn- email-snapshot
  "Send emails to all to recipients in parallel."
  [{to :to reply-to :reply-to subject :subject snap :snapshot} body]
  (let [snapshot (keywordize-keys snap)
        company-slug (:company-slug snapshot)
        company-name (:name snapshot)]
    (doall (pmap
      #(do
        (timbre/info "Sending email: " %)
        (ses/send-email creds
          :destination {:to-addresses [%]}
          :source (str company-name "<" company-slug "@" c/email-from-domain ">")
          :reply-to-addresses [(if (s/blank? reply-to) default-reply-to reply-to)]
          :message {:subject subject
                    :body {:html body}}))
        to))))

(defn send-snapshot [{note :note snapshot :snapshot :as msg}]
  (let [uuid-fragment (subs (str (java.util.UUID/randomUUID)) 0 4)
        html-file (str uuid-fragment ".html")
        inline-file (str uuid-fragment ".inline.html")]
    (try
      (spit html-file (content/html (assoc snapshot :note note))) ; create the email in a tmp file
      (shell/sh "juice" html-file inline-file) ; inline the CSS
      (email-snapshot msg (slurp inline-file)) ; email it to the recipients
      (finally
        ; remove the tmp files
        (io/delete-file html-file true)
        (io/delete-file inline-file true)))))

(defn- email-invite
  [{:keys [to reply-to subject company-name]} body]
  (timbre/info "Sending email: " to)
  (ses/send-email creds
    :destination {:to-addresses [to]}
    :source (str default-inviter " <" default-reply-to ">")
    :reply-to-addresses [(if (s/blank? reply-to) default-reply-to reply-to)]
    :message {:subject subject
              :body {:text (:text body)}}))

(defn send-invite [message]
  (let [uuid-fragment (subs (str (java.util.UUID/randomUUID)) 0 4)
        html-file (str uuid-fragment ".html")
        inline-file (str uuid-fragment ".inline.html")
        msg (keywordize-keys message)
        company-name (:company-name msg)
        from (:from msg)
        prefix (if (s/blank? from) ("You've been invited") (str from " invites you"))
        company (if (s/blank? company-name) "" (str company-name " on "))
        subject (str prefix " to join " company "OpenCompany")
        invitation (assoc msg :subject subject)]
    (try
      (spit html-file (invite/html invitation)) ; create the email in a tmp file
      (shell/sh "juice" html-file inline-file) ; inline the CSS
      (email-invite invitation {:text (invite/text invitation)
                                :html (slurp inline-file)}) ; email it to the recipients
      (finally
        ; remove the tmp files
        (io/delete-file html-file true)
        (io/delete-file inline-file true)))))

(comment

  ;; For REPL testing

  (require '[oc.email.mailer :as mailer] :reload)

  (def snapshot (json/decode (slurp "./opt/samples/updates/green-labs.json")))
  (mailer/send-snapshot {:to ["change@me.com"]
                         :reply-to "change@me.com"
                         :subject "Latest GreenLabs Update"
                         :note "Enjoy this groovy update!"
                         :snapshot (assoc snapshot :company-slug "green-labs")})

  (def invite (json/decode (slurp "./opt/samples/invites/apple.json")))
  (mailer/send-invite (assoc invite :to "change@me.com"))

)

(ns oc.email.mailer
  (:require [clojure.string :as s]
            [clojure.java.shell :as shell]
            [clojure.java.io :as io]
            [clojure.walk :refer (keywordize-keys)]
            [oc.email.config :as c]
            [taoensso.timbre :as timbre]
            [amazonica.aws.simpleemail :as ses]
            [oc.email.content :as content]
            [oc.email.invite :as invite]))

(def creds
  {:access-key c/aws-access-key-id
   :secret-key c/aws-secret-access-key
   :endpoint   c/aws-endpoint})

(def default-reply-to (str "hello@" c/email-from-domain))
(def default-inviter "OpenCompany")

(defn- email-snapshot
  "Send emails to all to recipients in parallel."
  [{to :to reply-to :reply-to subject :subject snap :snapshot} body]
  (let [snapshot (keywordize-keys snap)
        company-slug (:company-slug snapshot)
        company-name (:name snapshot)]
    (doall (pmap
      #(do
        (timbre/info "Sending email: " %)
        (ses/send-email creds
          :destination {:to-addresses [%]}
          :source (str company-name "<" company-slug "@" c/email-from-domain ">")
          :reply-to-addresses [(if (s/blank? reply-to) default-reply-to reply-to)]
          :message {:subject subject
                    :body {:html body}}))
        to))))

(defn send-snapshot [{note :note snapshot :snapshot :as msg}]
  (let [uuid-fragment (subs (str (java.util.UUID/randomUUID)) 0 4)
        html-file (str uuid-fragment ".html")
        inline-file (str uuid-fragment ".inline.html")]
    (try
      (spit html-file (content/html (assoc snapshot :note note))) ; create the email in a tmp file
      (shell/sh "juice" html-file inline-file) ; inline the CSS
      (email-snapshot msg (slurp inline-file)) ; email it to the recipients
      (finally
        ; remove the tmp files
        (io/delete-file html-file true)
        (io/delete-file inline-file true)))))

(defn- email-invite
  [{:keys [to reply-to subject company-name]} body]
  (timbre/info "Sending email: " to)
  (ses/send-email creds
    :destination {:to-addresses [to]}
    :source (str default-inviter " <" default-reply-to ">")
    :reply-to-addresses [(if (s/blank? reply-to) default-reply-to reply-to)]
    :message {:subject subject
              :body {:text (:text body)}}))

(defn send-invite [message]
  (let [uuid-fragment (subs (str (java.util.UUID/randomUUID)) 0 4)
        html-file (str uuid-fragment ".html")
        inline-file (str uuid-fragment ".inline.html")
        msg (keywordize-keys message)
        company-name (:company-name msg)
        from (:from msg)
        prefix (if (s/blank? from) "You've been invited" (str from " invites you"))
        company (if (s/blank? company-name) "" (str company-name " on "))
        subject (str prefix " to join " company "OpenCompany")
        invitation (assoc msg :subject subject)]
    (try
      (spit html-file (invite/html invitation)) ; create the email in a tmp file
      (shell/sh "juice" html-file inline-file) ; inline the CSS
      (email-invite invitation {:text (invite/text invitation)
                                :html (slurp inline-file)}) ; email it to the recipients
      (finally
        ; remove the tmp files
        (io/delete-file html-file true)
        (io/delete-file inline-file true)))))

(comment

  ;; For REPL testing

  (require '[oc.email.mailer :as mailer] :reload)

  (def snapshot (json/decode (slurp "./opt/samples/updates/green-labs.json")))
  (mailer/send-snapshot {:to ["change@me.com"]
                         :reply-to "change@me.com"
                         :subject "Latest GreenLabs Update"
                         :note "Enjoy this groovy update!"
                         :snapshot (assoc snapshot :company-slug "green-labs")})

  (def invite (json/decode (slurp "./opt/samples/invites/apple.json")))
  (mailer/send-invite (assoc invite :to "change@me.com"))

)

Fix typo.

Fix typo.


(ns set-solver.util
  (:require [com.evocomputing.colors :as colors]
            [clojure.math.combinatorics :as combo]
            [set-solver.reusable-buffer :refer [reusable]])
  (:import [org.opencv.core CvType Point MatOfDouble MatOfPoint2f]
           [org.opencv.imgproc Imgproc] ) )

(defn constrain
  "Force number into range"
  [n min-n max-n]
  (max (min n max-n) min-n))

(defn transpose
  "Tranpose a matrix. Ex: [ [A B] [C D] ] to [ [A C] [B D] ] "
  [matrix]
  (apply mapv vector matrix))

(defn sgn [n]
  "1 if n is positive, -1 is n is negative, 0 is n is zero"
  (cond (pos? n) 1
        (neg? n) -1
        :else 0))

(defn close-enough?
  "Return true if the difference between n1 and n2 is less than max-diff."
  [n1 n2 max-diff]
  (< (Math/abs (- n1 n2)) max-diff))

(defn line-len
  "Calculate length of line given two Points or 4 coordinates"
  ([p1 p2] (line-len (.x p1) (.y p1) (.x p2) (.y p2)))
  ([p1x p1y p2x p2y]
   (Math/sqrt
    (+ (Math/pow (- p1x p2x) 2)
       (Math/pow (- p1y p2y) 2)))))

(defn center-point
  "Return the center Point of a collection of points."
  [pts]
  (let [xs (map #(.x %) pts)
        ys (map #(.y %) pts)
        [min-x max-x] (apply (juxt min max) xs)
        [min-y max-y] (apply (juxt min max) ys)]
    (Point. (+ min-x (/ (- max-x min-x) 2))
            (+ min-y (/ (- max-y min-y) 2)))))

(defn rect-ratio
  "The ratio of a rectangle's smaller larger side."
  ([size] (rect-ratio (.width size) (.height size)))
  ([w h] (/ (max w h) (min w h))))

(defn rect-contains?
  "True if r1 contains r2. Note rects do not 'contain' their own bottom right, so (rect-contains? r r) is false."
  [r1 r2]
  (and (.contains r1 (.tl r2))
       (.contains r1 (.br r2))))

(defn rect-close-enough?
  "True if the top-left and bottom-right points of r1 and r2 differ by less than max-diff (default 10% of cross length)"
  ([r1 r2] (rect-close-enough? r1 r2 (* 0.10 (line-len (.tl r1) (.br r1)))))
  ([r1 r2 max-diff]
   (and (close-enough? (-> r1 .tl .x) (-> r2 .tl .x) max-diff)
        (close-enough? (-> r1 .tl .y) (-> r2 .tl .y) max-diff)
        (close-enough? (-> r1 .br .x) (-> r2 .br .x) max-diff)
        (close-enough? (-> r1 .br .y) (-> r2 .br .y) max-diff))))

(defn scalar-to-hsl
  "Convert a scalar RGB color to HSL"
  [color]
  (apply colors/rgb-to-hsl (take 3 (.val color))))

(defn hu-invariants
  "Calculate Hu invariants from moments"
  [moments]
  (let [result (reusable (MatOfDouble.))]
    (Imgproc/HuMoments moments result)
    (.toList result)))

(defn contour-hu-invariants
  "Calculate Hu invariants from contour"
  [contour]
  (hu-invariants (Imgproc/moments contour)))

(defn intersect-lines
  "Return the point where two lines intersect, or null if they are parallel/coincident"
  [line1 line2]
  (let [[x1 y1 x2 y2] (map double line1)
        [x3 y3 x4 y4] (map double line2)
        d (- (* (- x1 x2) (- y3 y4))
             (* (- y1 y2) (- x3 x4)))]
    (when-not (zero? d)
      [(/ (- (* (- (* x1 y2) (* y1 x2))
                (- x3 x4))
             (* (- x1 x2)
                (- (* x3 y4) (* y3 x4))))
          d)
       (/ (- (* (- (* x1 y2) (* y1 x2))
                (- y3 y4))
             (* (- y1 y2)
                (- (* x3 y4) (* y3 x4))))
          d)])))

(defn find-corners
  "Find all points where given set of lines would intersect."
  [lines]
  (keep (partial apply intersect-lines)
        (combo/combinations lines 2)))

(defn point-add
  "Add p1 to p2"
  [p1 p2]
  (Point. (+ (.x p1) (.x p2))
          (+ (.y p1) (.y p2))))

(defn point-sub
  "Subtract p2 from p1"
  [p1 p2]
  (Point. (- (.x p1) (.x p2))
          (- (.y p1) (.y p2))))

(defn quadrilateral?
  "True if contour can be approximated by a polygon with 4 points."
  [contour]
  (let [c2f (MatOfPoint2f.)
        approx2f (MatOfPoint2f.)]
    (.convertTo contour c2f CvType/CV_32FC2)
    (Imgproc/approxPolyDP c2f approx2f
                          (* 0.02 (Imgproc/arcLength c2f true))
                          true)
    (= 4 (.rows approx2f))))

(defn rectangle?
  "True if contour can be approximated by a polygon with 4 points that meet at more-or-less right angles."
  [contour]
  (let [c2f (reusable (MatOfPoint2f.))
        approx2f (reusable (MatOfPoint2f.))]
    (.convertTo contour c2f CvType/CV_32FC2)
    (Imgproc/approxPolyDP c2f approx2f
                          (* 0.02 (Imgproc/arcLength c2f true))
                          true)
    (when (= 4 (.rows approx2f))
      (let [[[p2x p2y] [p1x p1y] [p3x p3y]] (map #(vector (.x %) (.y %)) (.toList approx2f))
            p12 (line-len p1x p1y p2x p2y)
            p13 (line-len p1x p1y p3x p3y)
            p23 (line-len p2x p2y p3x p3y)
            angle (Math/acos
                   (/ (- (+ (* p12 p12) (* p13 p13))
                         (* p23 p23))
                      (* 2 p12 p13)))]
        (< 1.3 angle 1.7)))))

(ns set-solver.util
  (:require [com.evocomputing.colors :as colors]
            [clojure.math.combinatorics :as combo]
            [set-solver.reusable-buffer :refer [reusable]])
  (:import [org.opencv.core CvType Point MatOfDouble MatOfPoint2f]
           [org.opencv.imgproc Imgproc] ) )

(defn constrain
  "Force number into range"
  [n min-n max-n]
  (max (min n max-n) min-n))

(defn transpose
  "Tranpose a matrix. Ex: [ [A B] [C D] ] to [ [A C] [B D] ] "
  [matrix]
  (apply mapv vector matrix))

(defn sgn [n]
  "1 if n is positive, -1 is n is negative, 0 is n is zero"
  (cond (pos? n) 1
        (neg? n) -1
        :else 0))

(defn close-enough?
  "Return true if the difference between n1 and n2 is less than max-diff."
  [n1 n2 max-diff]
  (< (Math/abs (- n1 n2)) max-diff))

(defn line-len
  "Calculate length of line given two Points or 4 coordinates"
  ([p1 p2] (line-len (.x p1) (.y p1) (.x p2) (.y p2)))
  ([p1x p1y p2x p2y]
   (Math/sqrt
    (+ (Math/pow (- p1x p2x) 2)
       (Math/pow (- p1y p2y) 2)))))

(defn center-point
  "Return the center Point of a collection of points."
  [pts]
  (let [xs (map #(.x %) pts)
        ys (map #(.y %) pts)
        [min-x max-x] (apply (juxt min max) xs)
        [min-y max-y] (apply (juxt min max) ys)]
    (Point. (+ min-x (/ (- max-x min-x) 2))
            (+ min-y (/ (- max-y min-y) 2)))))

(defn rect-ratio
  "The ratio of a rectangle's smaller larger side."
  ([size] (rect-ratio (.width size) (.height size)))
  ([w h] (/ (max w h) (min w h))))

(defn rect-contains?
  "True if r1 contains r2. Note rects do not 'contain' their own bottom right, so (rect-contains? r r) is false."
  [r1 r2]
  (and (.contains r1 (.tl r2))
       (.contains r1 (.br r2))))

(defn rect-close-enough?
  "True if the top-left and bottom-right points of r1 and r2 differ by less than max-diff (default 10% of cross length)"
  ([r1 r2] (rect-close-enough? r1 r2 (* 0.10 (line-len (.tl r1) (.br r1)))))
  ([r1 r2 max-diff]
   (and (close-enough? (-> r1 .tl .x) (-> r2 .tl .x) max-diff)
        (close-enough? (-> r1 .tl .y) (-> r2 .tl .y) max-diff)
        (close-enough? (-> r1 .br .x) (-> r2 .br .x) max-diff)
        (close-enough? (-> r1 .br .y) (-> r2 .br .y) max-diff))))

(defn scalar-to-hsl
  "Convert a scalar RGB color to HSL"
  [color]
  (apply colors/rgb-to-hsl (reverse (take 3 (.val color)))))

(defn hu-invariants
  "Calculate Hu invariants from moments"
  [moments]
  (let [result (reusable (MatOfDouble.))]
    (Imgproc/HuMoments moments result)
    (.toList result)))

(defn contour-hu-invariants
  "Calculate Hu invariants from contour"
  [contour]
  (hu-invariants (Imgproc/moments contour)))

(defn intersect-lines
  "Return the point where two lines intersect, or null if they are parallel/coincident"
  [line1 line2]
  (let [[x1 y1 x2 y2] (map double line1)
        [x3 y3 x4 y4] (map double line2)
        d (- (* (- x1 x2) (- y3 y4))
             (* (- y1 y2) (- x3 x4)))]
    (when-not (zero? d)
      [(/ (- (* (- (* x1 y2) (* y1 x2))
                (- x3 x4))
             (* (- x1 x2)
                (- (* x3 y4) (* y3 x4))))
          d)
       (/ (- (* (- (* x1 y2) (* y1 x2))
                (- y3 y4))
             (* (- y1 y2)
                (- (* x3 y4) (* y3 x4))))
          d)])))

(defn find-corners
  "Find all points where given set of lines would intersect."
  [lines]
  (keep (partial apply intersect-lines)
        (combo/combinations lines 2)))

(defn point-add
  "Add p1 to p2"
  [p1 p2]
  (Point. (+ (.x p1) (.x p2))
          (+ (.y p1) (.y p2))))

(defn point-sub
  "Subtract p2 from p1"
  [p1 p2]
  (Point. (- (.x p1) (.x p2))
          (- (.y p1) (.y p2))))

(defn quadrilateral?
  "True if contour can be approximated by a polygon with 4 points."
  [contour]
  (let [c2f (MatOfPoint2f.)
        approx2f (MatOfPoint2f.)]
    (.convertTo contour c2f CvType/CV_32FC2)
    (Imgproc/approxPolyDP c2f approx2f
                          (* 0.02 (Imgproc/arcLength c2f true))
                          true)
    (= 4 (.rows approx2f))))

(defn rectangle?
  "True if contour can be approximated by a polygon with 4 points that meet at more-or-less right angles."
  [contour]
  (let [c2f (reusable (MatOfPoint2f.))
        approx2f (reusable (MatOfPoint2f.))]
    (.convertTo contour c2f CvType/CV_32FC2)
    (Imgproc/approxPolyDP c2f approx2f
                          (* 0.02 (Imgproc/arcLength c2f true))
                          true)
    (when (= 4 (.rows approx2f))
      (let [[[p2x p2y] [p1x p1y] [p3x p3y]] (map #(vector (.x %) (.y %)) (.toList approx2f))
            p12 (line-len p1x p1y p2x p2y)
            p13 (line-len p1x p1y p3x p3y)
            p23 (line-len p2x p2y p3x p3y)
            angle (Math/acos
                   (/ (- (+ (* p12 p12) (* p13 p13))
                         (* p23 p23))
                      (* 2 p12 p13)))]
        (< 1.3 angle 1.7)))))

fix color order

fix color order


(ns frontend.core
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
            ;; XXX remove browser repl in prod
            [clojure.browser.repl :as repl]
            [clojure.string :as string]
            [dommy.core :as dommy]
            [goog.dom.DomHelper]
            [frontend.components.app :as app]
            [frontend.controllers.controls :as controls-con]
            [frontend.controllers.navigation :as nav-con]
            [frontend.controllers.post-controls :as controls-pcon]
            [frontend.controllers.post-navigation :as nav-pcon]
            [frontend.routes :as routes]
            [frontend.controllers.api :as api-con]
            [frontend.controllers.post-api :as api-pcon]
            [frontend.controllers.ws :as ws-con]
            [frontend.controllers.post-ws :as ws-pcon]
            [frontend.env :as env]
            [frontend.state :as state]
            [goog.events]
            [om.core :as om :include-macros true]
            [frontend.pusher :as pusher]
            [frontend.history :as history]
            [frontend.utils :as utils :refer [mlog merror third]]
            [secretary.core :as sec])
  (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                   [frontend.utils :refer [inspect timing swallow-errors]])
  (:use-macros [dommy.macros :only [node sel sel1]]))

(enable-console-print!)

;; Overcome some of the browser limitations around DnD
(def mouse-move-ch
  (chan (sliding-buffer 1)))

(def mouse-down-ch
  (chan (sliding-buffer 1)))

(def mouse-up-ch
  (chan (sliding-buffer 1)))

(js/window.addEventListener "mousedown" #(put! mouse-down-ch %))
(js/window.addEventListener "mouseup"   #(put! mouse-up-ch   %))
(js/window.addEventListener "mousemove" #(put! mouse-move-ch %))

(def controls-ch
  (chan))

(def api-ch
  (chan))

(def error-ch
  (chan))

(def navigation-ch
  (chan))

(def ^{:doc "websocket channel"}
  ws-ch
  (chan))

(defn app-state []
  (atom (assoc (state/initial-state)
          :current-user (-> js/window
                            (aget "renderContext")
                            (aget "current_user")
                            (js->clj :keywordize-keys true))
          :render-context (-> js/window
                              (aget "renderContext")
                              (js->clj :keywordize-keys true))
          :comms {:controls  controls-ch
                  :api       api-ch
                  :errors    error-ch
                  :nav       navigation-ch
                  :ws        ws-ch
                  :mouse-move {:ch mouse-move-ch
                               :mult (async/mult mouse-move-ch)}
                  :mouse-down {:ch mouse-down-ch
                               :mult (async/mult mouse-down-ch)}
                  :mouse-up {:ch mouse-up-ch
                             :mult (async/mult mouse-up-ch)}})))

(defn controls-handler
  [value state container]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "Controls Verbose: " value))
  (swallow-errors
   (let [previous-state @state]
     (swap! state (partial controls-con/control-event container (first value) (second value)))
     (controls-pcon/post-control-event! container (first value) (second value) previous-state @state))))

(defn nav-handler
  [value state history]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "Navigation Verbose: " value))
  (swallow-errors
   (let [previous-state @state]
     (swap! state (partial nav-con/navigated-to history (first value) (second value)))
     (nav-pcon/post-navigated-to! history (first value) (second value) previous-state @state))))

(defn api-handler
  [value state container]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "API Verbose: " (first value) (second value) (utils/third value)))
  (swallow-errors
    (let [previous-state @state]
      (swap! state (partial api-con/api-event container (first value) (second value) (utils/third value)))
      (api-pcon/post-api-event! container (first value) (second value) (utils/third value) previous-state @state))))

(defn ws-handler
  [value state pusher]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "websocket Verbose: " (pr-str (first value)) (second value) (utils/third value)))
  (swallow-errors
    (let [previous-state @state]
      ;; XXX: should these take the container like the rest of the controllers?
      (swap! state (partial ws-con/ws-event pusher (first value) (second value)))
      (ws-pcon/post-ws-event! pusher (first value) (second value) previous-state @state))))

(defn main [state top-level-node]
  (let [comms       (:comms @state)
        target-name "app"
        container   (sel1 top-level-node (str "#" target-name))
        uri-path    (.getPath utils/parsed-uri)
        history-path "/"
        history-imp (history/new-history-imp top-level-node)
        pusher-imp (pusher/new-pusher-instance)]
    (routes/define-routes! state)
    (om/root
     app/app
     state
     {:target container
      :opts {:comms comms}})
    (go (while true
          (alt!
           (:controls comms) ([v] (controls-handler v state container))
           (:nav comms) ([v] (nav-handler v state history-imp))
           (:api comms) ([v] (api-handler v state container))
           (:ws comms) ([v] (ws-handler v state pusher-imp))
           ;; Capture the current history for playback in the absence
           ;; of a server to store it
           (async/timeout 10000) (do (print "TODO: print out history: ")))))))

(defn subscribe-to-user-channel [user ws-ch]
  (put! ws-ch [:subscribe {:channel-name (pusher/user-channel user)
                           :messages [:refresh]}]))

(defn setup-browser-repl []
  (when-let [repl-url (aget js/window "browser_connected_repl_url")]
    (try
      (repl/connect repl-url)
      ;; the repl tries to take over *out*, workaround for
      ;; https://github.com/cemerick/austin/issues/49
      (js/setInterval #(enable-console-print!) 1000)
      (catch js/Error e
        (merror e)))))

(defn dispatch-to-current-location! []
  (let [uri (goog.Uri. js/document.location.href)]
    (sec/dispatch! (str (.getPath uri) (when-not (string/blank? (.getFragment uri))
                                         (str "#" (.getFragment uri)))))))

(defn handle-browser-resize
  "Handles scrolling the container on the build page to the correct position when
  the size of the browser window chagnes. Has to add an event listener at the top level."
  [app-state]
  (goog.events/listen
   js/window "resize"
   #(when (= :build (:navigation-point @app-state))
      (put! controls-ch [:container-selected (get-in @app-state [:current-build :current-container-id] 0)]))))

(defn ^:export setup! []
  (let [state (app-state)]
    (main state (sel1 :body))
    (dispatch-to-current-location!)
    (handle-browser-resize state)
    (when-let [user (:current-user @state)]
      (subscribe-to-user-channel user (get-in @state [:comms :ws])))
    (when (env/development?)
      (setup-browser-repl))))

(ns frontend.core
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
            ;; XXX remove browser repl in prod
            [clojure.browser.repl :as repl]
            [clojure.string :as string]
            [dommy.core :as dommy]
            [goog.dom.DomHelper]
            [frontend.components.app :as app]
            [frontend.controllers.controls :as controls-con]
            [frontend.controllers.navigation :as nav-con]
            [frontend.controllers.post-controls :as controls-pcon]
            [frontend.controllers.post-navigation :as nav-pcon]
            [frontend.routes :as routes]
            [frontend.controllers.api :as api-con]
            [frontend.controllers.post-api :as api-pcon]
            [frontend.controllers.ws :as ws-con]
            [frontend.controllers.post-ws :as ws-pcon]
            [frontend.env :as env]
            [frontend.state :as state]
            [goog.events]
            [om.core :as om :include-macros true]
            [frontend.pusher :as pusher]
            [frontend.history :as history]
            [frontend.utils :as utils :refer [mlog merror third]]
            [secretary.core :as sec])
  (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                   [frontend.utils :refer [inspect timing swallow-errors]])
  (:use-macros [dommy.macros :only [node sel sel1]]))

(enable-console-print!)

;; Overcome some of the browser limitations around DnD
(def mouse-move-ch
  (chan (sliding-buffer 1)))

(def mouse-down-ch
  (chan (sliding-buffer 1)))

(def mouse-up-ch
  (chan (sliding-buffer 1)))

(js/window.addEventListener "mousedown" #(put! mouse-down-ch %))
(js/window.addEventListener "mouseup"   #(put! mouse-up-ch   %))
(js/window.addEventListener "mousemove" #(put! mouse-move-ch %))

(def controls-ch
  (chan))

(def api-ch
  (chan))

(def error-ch
  (chan))

(def navigation-ch
  (chan))

(def ^{:doc "websocket channel"}
  ws-ch
  (chan))

(defn app-state []
  (atom (assoc (state/initial-state)
          :current-user (-> js/window
                            (aget "renderContext")
                            (aget "current_user")
                            (js->clj :keywordize-keys true))
          :render-context (-> js/window
                              (aget "renderContext")
                              (js->clj :keywordize-keys true))
          :comms {:controls  controls-ch
                  :api       api-ch
                  :errors    error-ch
                  :nav       navigation-ch
                  :ws        ws-ch
                  :mouse-move {:ch mouse-move-ch
                               :mult (async/mult mouse-move-ch)}
                  :mouse-down {:ch mouse-down-ch
                               :mult (async/mult mouse-down-ch)}
                  :mouse-up {:ch mouse-up-ch
                             :mult (async/mult mouse-up-ch)}})))

(defn controls-handler
  [value state container]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "Controls Verbose: " value))
  (swallow-errors
   (let [previous-state @state]
     (swap! state (partial controls-con/control-event container (first value) (second value)))
     (controls-pcon/post-control-event! container (first value) (second value) previous-state @state))))

(defn nav-handler
  [value state history]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "Navigation Verbose: " value))
  (swallow-errors
   (let [previous-state @state]
     (swap! state (partial nav-con/navigated-to history (first value) (second value)))
     (nav-pcon/post-navigated-to! history (first value) (second value) previous-state @state))))

(defn api-handler
  [value state container]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "API Verbose: " (first value) (second value) (utils/third value)))
  (swallow-errors
    (let [previous-state @state]
      (swap! state (partial api-con/api-event container (first value) (second value) (utils/third value)))
      (api-pcon/post-api-event! container (first value) (second value) (utils/third value) previous-state @state))))

(defn ws-handler
  [value state pusher]
  (when true (:log-channels? utils/initial-query-map)
        (mlog "websocket Verbose: " (pr-str (first value)) (second value) (utils/third value)))
  (swallow-errors
    (let [previous-state @state]
      ;; XXX: should these take the container like the rest of the controllers?
      (swap! state (partial ws-con/ws-event pusher (first value) (second value)))
      (ws-pcon/post-ws-event! pusher (first value) (second value) previous-state @state))))

(defn main [state top-level-node]
  (let [comms       (:comms @state)
        target-name "app"
        container   (sel1 top-level-node (str "#" target-name))
        uri-path    (.getPath utils/parsed-uri)
        history-path "/"
        history-imp (history/new-history-imp top-level-node)
        pusher-imp (pusher/new-pusher-instance)]
    (routes/define-routes! state)
    (om/root
     app/app
     state
     {:target container
      :opts {:comms comms}})
    (go (while true
          (alt!
           (:controls comms) ([v] (controls-handler v state container))
           (:nav comms) ([v] (nav-handler v state history-imp))
           (:api comms) ([v] (api-handler v state container))
           (:ws comms) ([v] (ws-handler v state pusher-imp))
           ;; Capture the current history for playback in the absence
           ;; of a server to store it
           (async/timeout 10000) (do (print "TODO: print out history: ")))))))

(defn subscribe-to-user-channel [user ws-ch]
  (put! ws-ch [:subscribe {:channel-name (pusher/user-channel user)
                           :messages [:refresh]}]))

(defn setup-browser-repl [repl-url]
  (repl/connect repl-url)
  ;; the repl tries to take over *out*, workaround for
  ;; https://github.com/cemerick/austin/issues/49
  (js/setInterval #(enable-console-print!) 1000))

(defn dispatch-to-current-location! []
  (let [uri (goog.Uri. js/document.location.href)]
    (sec/dispatch! (str (.getPath uri) (when-not (string/blank? (.getFragment uri))
                                         (str "#" (.getFragment uri)))))))

(defn handle-browser-resize
  "Handles scrolling the container on the build page to the correct position when
  the size of the browser window chagnes. Has to add an event listener at the top level."
  [app-state]
  (goog.events/listen
   js/window "resize"
   #(when (= :build (:navigation-point @app-state))
      (put! controls-ch [:container-selected (get-in @app-state [:current-build :current-container-id] 0)]))))

(defn ^:export setup! []
  (let [state (app-state)]
    (main state (sel1 :body))
    (dispatch-to-current-location!)
    (handle-browser-resize state)
    (when-let [user (:current-user @state)]
      (subscribe-to-user-channel user (get-in @state [:comms :ws])))
    (when (env/development?)
      (when-let [repl-url (get-in @state [:render-context :browser_connected_repl_url])]
        (try
          (setup-browser-repl repl-url)
          (catch js/error e
            (merror e)))))))

move browser_connected_repl_url to renderContext