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

(def org-prop-mapping {:name :org-name
                       :logo-url :org-logo-url
                       :logo-width :org-logo-width
                       :logo-height :org-logo-height})

(def representation-props [:uuid :title :banner-url :banner-width :banner-height :body
                           :org-name :org-logo-url :org-logo-width :org-logo-height
                           :storyboard-name :status
                           :author :created-at :updated-at])

(defun url

  ([org-slug board-slug]
  (str (board-rep/url org-slug board-slug) "/stories"))

  ([org-slug board-slug story :guard map?] (url org-slug board-slug (:uuid story)))

  ([org-slug board-slug story-uuid :guard string?] (str (url org-slug board-slug) "/" story-uuid)))

(defn- secure-url [org-slug secure-uuid] (str (org-rep/url org-slug) "/stories/" secure-uuid))

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

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

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

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

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

(defn- publish-link [org-slug board-slug story-uuid]
  (hateoas/link-map "publish" hateoas/POST (str (url org-slug board-slug story-uuid) "/publish")
    {:content-type mt/share-request-media-type
     :accept mt/story-media-type}))

(defn- share-link [org-slug board-slug story-uuid]
  (hateoas/link-map "share" hateoas/POST (str (url org-slug board-slug story-uuid) "/share")
    {:content-type mt/share-request-media-type
     :accept mt/story-media-type}))

(defn- secure-link [org-slug secure-uuid]
  (hateoas/link-map "secure" hateoas/GET (secure-url org-slug secure-uuid) {:accept mt/story-media-type}))

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

(defn include-secure-uuid
  "Include secure UUID property for authors."
  [story secure-uuid access-level]
  (if (= access-level :author)
    (assoc story :secure-uuid secure-uuid)
    story))

(defn- story-and-links
  "
  Given an story and all the metadata about it, render an access level appropriate rendition of the story
  for use in an API response.
  "
  [org board story comments reactions access-level user-id]
  (let [story-uuid (:uuid story)
        secure-uuid (:secure-uuid story)
        org-slug (:slug org)
        org-uuid (:uuid org)
        board-slug (:slug board)
        board-uuid (:uuid board)
        draft? (= :draft (keyword (:status story)))
        reaction-rep (if (or draft? (= access-level :public))
                    []
                    (content/reactions-and-links org-uuid board-uuid story-uuid reactions user-id))
        links (if (= user-id :secure)
                ;; secure UUID access
                [(secure-self-link org-slug secure-uuid)]
                ;; normal access
                [(self-link org-slug board-slug story-uuid)
                 (up-link org-slug board-slug)])
        more-links (cond
                    (or (and draft? (not= user-id :secure)) (= access-level :author))
                    (concat links [(partial-update-link org-slug board-slug story-uuid)
                                   (delete-link org-slug board-slug story-uuid)
                                   (secure-link org-slug secure-uuid)
                                   (content/comment-link org-uuid board-uuid story-uuid)
                                   (content/comments-link org-uuid board-uuid story-uuid comments)])

                    (= access-level :viewer)
                    (concat links [(content/comment-link org-uuid board-uuid story-uuid)
                                   (content/comments-link org-uuid board-uuid story-uuid comments)])

                    :else links)
        full-links (if draft?
                      (conj more-links (publish-link org-slug board-slug story-uuid))
                      (conj more-links (share-link org-slug board-slug story-uuid)))]
    (-> (merge org story)
      (clojure.set/rename-keys org-prop-mapping)
      (select-keys  representation-props)
      (include-secure-uuid (:secure-uuid story) access-level)
      (assoc :storyboard-name (:name board))
      (assoc :reactions reaction-rep)
      (assoc :links full-links))))

(defn render-story-for-collection
  "Create a map of the story for use in a collection in the API"
  [org board story comments reactions access-level user-id]
  (story-and-links org board story comments reactions access-level user-id))

(defn render-story
 "Create a JSON representation of the story for the REST API"
  ([org board story comments reactions related access-level user-id]
  (let [story-uuid (:uuid story)]
    (json/generate-string
      (assoc (render-story-for-collection org board story comments reactions access-level user-id)
        :related related)
      {:pretty config/pretty?})))

  ([org board story comments reactions access-level user-id]
  (let [story-uuid (:uuid story)]
    (json/generate-string
      (render-story-for-collection org board story comments reactions access-level user-id)
      {:pretty config/pretty?}))))

(defn render-story-list
  "
  Given an org and a board, a sequence of story maps, and access control levels,
  create a JSON representation of a list of stories for the REST API.
  "
  [org board stories access-level user-id]
  (let [org-slug (:slug org)
        board-slug (:slug board)
        collection-url (url org-slug board-slug)
        links [(hateoas/self-link collection-url {:accept mt/story-collection-media-type})
               (up-link org-slug board-slug)]
        full-links (if (= access-level :author)
                      (conj links (create-link org-slug board-slug))
                      links)]
    (json/generate-string
      {:collection {:version hateoas/json-collection-version
                    :href collection-url
                    :links full-links
                    :items (map #(story-and-links org board %
                                    (or (filter :body (:interactions %)) [])  ; comments only
                                    (or (filter :reaction (:interactions %)) []) ; reactions only
                                    access-level user-id)
                              stories)}}
      {:pretty config/pretty?})))

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

(def org-prop-mapping {:name :org-name
                       :logo-url :org-logo-url
                       :logo-width :org-logo-width
                       :logo-height :org-logo-height})

(def representation-props [:uuid :title :banner-url :banner-width :banner-height :body
                           :org-name :org-logo-url :org-logo-width :org-logo-height
                           :storyboard-name :storyboard-slug :status
                           :author :created-at :updated-at])

(defun url

  ([org-slug board-slug]
  (str (board-rep/url org-slug board-slug) "/stories"))

  ([org-slug board-slug story :guard map?] (url org-slug board-slug (:uuid story)))

  ([org-slug board-slug story-uuid :guard string?] (str (url org-slug board-slug) "/" story-uuid)))

(defn- secure-url [org-slug secure-uuid] (str (org-rep/url org-slug) "/stories/" secure-uuid))

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

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

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

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

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

(defn- publish-link [org-slug board-slug story-uuid]
  (hateoas/link-map "publish" hateoas/POST (str (url org-slug board-slug story-uuid) "/publish")
    {:content-type mt/share-request-media-type
     :accept mt/story-media-type}))

(defn- share-link [org-slug board-slug story-uuid]
  (hateoas/link-map "share" hateoas/POST (str (url org-slug board-slug story-uuid) "/share")
    {:content-type mt/share-request-media-type
     :accept mt/story-media-type}))

(defn- secure-link [org-slug secure-uuid]
  (hateoas/link-map "secure" hateoas/GET (secure-url org-slug secure-uuid) {:accept mt/story-media-type}))

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

(defn include-secure-uuid
  "Include secure UUID property for authors."
  [story secure-uuid access-level]
  (if (= access-level :author)
    (assoc story :secure-uuid secure-uuid)
    story))

(defn- story-and-links
  "
  Given an story and all the metadata about it, render an access level appropriate rendition of the story
  for use in an API response.
  "
  [org board story comments reactions access-level user-id]
  (let [story-uuid (:uuid story)
        secure-uuid (:secure-uuid story)
        org-slug (:slug org)
        org-uuid (:uuid org)
        board-slug (:slug board)
        board-uuid (:uuid board)
        draft? (= :draft (keyword (:status story)))
        reaction-rep (if (or draft? (= access-level :public))
                    []
                    (content/reactions-and-links org-uuid board-uuid story-uuid reactions user-id))
        links (if (= user-id :secure)
                ;; secure UUID access
                [(secure-self-link org-slug secure-uuid)]
                ;; normal access
                [(self-link org-slug board-slug story-uuid)
                 (up-link org-slug board-slug)])
        more-links (cond
                    (or (and draft? (not= user-id :secure)) (= access-level :author))
                    (concat links [(partial-update-link org-slug board-slug story-uuid)
                                   (delete-link org-slug board-slug story-uuid)
                                   (secure-link org-slug secure-uuid)
                                   (content/comment-link org-uuid board-uuid story-uuid)
                                   (content/comments-link org-uuid board-uuid story-uuid comments)])

                    (= access-level :viewer)
                    (concat links [(content/comment-link org-uuid board-uuid story-uuid)
                                   (content/comments-link org-uuid board-uuid story-uuid comments)])

                    :else links)
        full-links (if draft?
                      (conj more-links (publish-link org-slug board-slug story-uuid))
                      (conj more-links (share-link org-slug board-slug story-uuid)))]
    (-> (merge org story)
      (clojure.set/rename-keys org-prop-mapping)
      (select-keys  representation-props)
      (include-secure-uuid (:secure-uuid story) access-level)
      (assoc :storyboard-name (:name board))
      (assoc :storyboard-slug (:slug board))
      (assoc :reactions reaction-rep)
      (assoc :links full-links))))

(defn render-story-for-collection
  "Create a map of the story for use in a collection in the API"
  [org board story comments reactions access-level user-id]
  (story-and-links org board story comments reactions access-level user-id))

(defn render-story
 "Create a JSON representation of the story for the REST API"
  ([org board story comments reactions related access-level user-id]
  (let [story-uuid (:uuid story)]
    (json/generate-string
      (assoc (render-story-for-collection org board story comments reactions access-level user-id)
        :related related)
      {:pretty config/pretty?})))

  ([org board story comments reactions access-level user-id]
  (let [story-uuid (:uuid story)]
    (json/generate-string
      (render-story-for-collection org board story comments reactions access-level user-id)
      {:pretty config/pretty?}))))

(defn render-story-list
  "
  Given an org and a board, a sequence of story maps, and access control levels,
  create a JSON representation of a list of stories for the REST API.
  "
  [org board stories access-level user-id]
  (let [org-slug (:slug org)
        board-slug (:slug board)
        collection-url (url org-slug board-slug)
        links [(hateoas/self-link collection-url {:accept mt/story-collection-media-type})
               (up-link org-slug board-slug)]
        full-links (if (= access-level :author)
                      (conj links (create-link org-slug board-slug))
                      links)]
    (json/generate-string
      {:collection {:version hateoas/json-collection-version
                    :href collection-url
                    :links full-links
                    :items (map #(story-and-links org board %
                                    (or (filter :body (:interactions %)) [])  ; comments only
                                    (or (filter :reaction (:interactions %)) []) ; reactions only
                                    access-level user-id)
                              stories)}}
      {:pretty config/pretty?})))

Add storyboard-slug prop to story responses.


(ns clj.rb
  "Tools for interacting with JRuby from Clojure."
  (:refer-clojure :exclude [eval require])
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import [org.jruby
            RubyArray
            RubyHash
            RubyString
            RubySymbol]
           [org.jruby.embed
            LocalVariableBehavior
            ScriptingContainer]
           org.jruby.runtime.builtin.IRubyObject
           java.io.File))

(defprotocol Clj->Rb
  "A protocol for converting Clojure objects to JRuby implementation equivalents."
  (clj->rb [v rt]
    "Converts `v` to the appropriate Ruby object in runtime `rt`."))

(defprotocol Rb->Clj
  "A protocol for converting JRuby implementation objects to Clojure equivalents."
  (rb->clj [v]
    "Converts `v` to the appropriate Clojure object"))

(defn eval
  "Evaluates the `script` String in `rt`, applying `rb->clj` to the result.

  `clojure.core/format` is applied to `script` and `args`."
  [^ScriptingContainer rt script & args]
  (rb->clj
    (.runScriptlet rt (apply format script args))))

(defn eval-file
  "Evaluates `file` in `rt`, applying `rb->clj` to the result."
  [^ScriptingContainer rt ^File file]
  (rb->clj
    (.runScriptlet rt (io/reader file) (.getPath file))))

(defn call-method
  "Calls method named `method-name` on IRubyObject `obj`, "
  [^ScriptingContainer rt ^IRubyObject obj ^String method-name & args]
  (rb->clj
    (.callMethod rt obj
      method-name (object-array (map #(clj->rb % rt) args)))))

(defn- rb-helper [rt]
  (eval rt "require 'clj_rb_util';CljRbUtil"))

(defn- ruby-runtime [rt]
  (-> rt .getProvider .getRuntime))

(extend-protocol Clj->Rb
  nil
  (clj->rb [_ _]
    nil)

  Object
  (clj->rb [v _]
    v)

  clojure.lang.Keyword
  (clj->rb [v rt]
    (RubySymbol/newSymbol (ruby-runtime rt) (name v)))

  java.util.List
  (clj->rb [v rt]
    (doto (RubyArray/newEmptyArray (ruby-runtime rt))
      (.addAll (map #(clj->rb % rt) v))))

  java.util.Map
  (clj->rb [v rt]
    (reduce
      (fn [h [k v]] (doto h (.put (clj->rb k rt) (clj->rb v rt))))
      (RubyHash. (ruby-runtime rt))
      v)))

(extend-protocol Rb->Clj
  Object
  (rb->clj [v]
    v)

  nil
  (rb->clj [_]
    nil)

  RubyArray
  (rb->clj [v]
    (into [] (map rb->clj v)))

  RubyHash
  (rb->clj [v]
    (->> v
      (map (fn [[k v]] [(rb->clj k) (rb->clj v)]))
      (into {})))

  RubySymbol
  (rb->clj [v]
    (keyword (str v))))

(defn require
  "Requires each of `libs` in `rt`."
  [rt & libs]
  (last (map #(eval rt "require '%s'" %) libs)))

(defn setenv
  "Sets `value` for `key` in the `ENV` hash in `rt`.

  `key` and `value` are both converted to strings."
  [rt key value]
  (eval rt "ENV['%s']='%s'" key value))

(defn runtime
  "Creates a new JRuby runtime.

  Optionally takes a map of options [default]:

  * :preserve-locals? - any locals defined in an eval will persist, visible to future evals [false]
  * :load-paths - a sequence of paths to add to the runtime's load path [nil]
  * :env - a map of values to set in the ruby ENV [nil]
  * :gem-paths - a sequence of paths to search for gems [nil]"
  ([] (runtime nil))
  ([{:keys [preserve-locals? gem-path load-paths env]}]
     (let [rt (ScriptingContainer. (if preserve-locals?
                                     LocalVariableBehavior/PERSISTENT
                                     LocalVariableBehavior/TRANSIENT))]
       (.setLoadPaths rt (conj load-paths
                           (.toExternalForm (io/resource "clj-ruby-helpers"))))
       (when-let [paths (seq gem-paths)]
         (setenv rt "GEM_PATH" (str/join ":" (map pr-str paths))))
       (doseq [[k v] env]
         (setenv rt k v))
       (require "rubygems")
       rt)))

(defn install-gem
  "Downloads and installs the gem specificied by `name` and `version`.

  Optionally takes a map of options [default]:

  * :sources - a sequence additional gem sources to add to the default list [nil]
  * :install-dir - a path to a directory where the gem should be installed. If nil,
                   the default gem path is used. [nil]
  * :force? - install the gem, even if it is already installed [false]
  * :ignore-dependencies? - don't install the gems dependencies [false]"
  ([rt name version]
     (install-gem rt name version nil))
  ([rt name version {:keys [ignore-dependencies? force? sources install-dir]}]
     (let [helper (rb-helper rt)]
       (if (and (not force?)
             (call-method rt helper "gem_installed?" name version))
         (println (format "%s v%s already installed, skipping." name version))
         (let [curr-sources (eval rt "Gem.sources")
               installer (call-method rt helper "gem_installer"
                           (boolean ignore-dependencies?)
                           (boolean force?)
                           (if install-dir
                             install-dir
                             (call-method rt helper "first_writeable_gem_path")))]
           (try
             (when sources
               (eval rt helper "add_gem_sources" sources))
             (call-method rt installer "install" name version)
             (finally
               (call-method rt helper "add_gem_sources" curr-sources (boolean :replace)))))))))

(defn shutdown-runtime
  "Shuts down the given JRuby runtime."
  [rt]
  (.finalize rt))

(ns clj.rb
  "Tools for interacting with JRuby from Clojure."
  (:refer-clojure :exclude [eval require])
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import [org.jruby
            RubyArray
            RubyHash
            RubyString
            RubySymbol]
           [org.jruby.embed
            LocalVariableBehavior
            ScriptingContainer]
           org.jruby.runtime.builtin.IRubyObject
           java.io.File))

(defprotocol Clj->Rb
  "A protocol for converting Clojure objects to JRuby implementation equivalents."
  (clj->rb [v rt]
    "Converts `v` to the appropriate Ruby object in runtime `rt`."))

(defprotocol Rb->Clj
  "A protocol for converting JRuby implementation objects to Clojure equivalents."
  (rb->clj [v]
    "Converts `v` to the appropriate Clojure object"))

(defn eval
  "Evaluates the `script` String in `rt`, applying `rb->clj` to the result.

  `clojure.core/format` is applied to `script` and `args`."
  [^ScriptingContainer rt script & args]
  (rb->clj
    (.runScriptlet rt (apply format script args))))

(defn eval-file
  "Evaluates `file` in `rt`, applying `rb->clj` to the result."
  [^ScriptingContainer rt ^File file]
  (rb->clj
    (.runScriptlet rt (io/reader file) (.getPath file))))

(defn call-method
  "Calls method named `method-name` on IRubyObject `obj`, "
  [^ScriptingContainer rt ^IRubyObject obj ^String method-name & args]
  (rb->clj
    (.callMethod rt obj
      method-name (object-array (map #(clj->rb % rt) args)))))

(defn- rb-helper [rt]
  (eval rt "require 'clj_rb_util';CljRbUtil"))

(defn- ruby-runtime [rt]
  (-> rt .getProvider .getRuntime))

(extend-protocol Clj->Rb
  nil
  (clj->rb [_ _]
    nil)

  Object
  (clj->rb [v _]
    v)

  clojure.lang.Keyword
  (clj->rb [v rt]
    (RubySymbol/newSymbol (ruby-runtime rt) (name v)))

  java.util.List
  (clj->rb [v rt]
    (doto (RubyArray/newEmptyArray (ruby-runtime rt))
      (.addAll (map #(clj->rb % rt) v))))

  java.util.Map
  (clj->rb [v rt]
    (reduce
      (fn [h [k v]] (doto h (.put (clj->rb k rt) (clj->rb v rt))))
      (RubyHash. (ruby-runtime rt))
      v)))

(extend-protocol Rb->Clj
  Object
  (rb->clj [v]
    v)

  nil
  (rb->clj [_]
    nil)

  RubyArray
  (rb->clj [v]
    (into [] (map rb->clj v)))

  RubyHash
  (rb->clj [v]
    (->> v
      (map (fn [[k v]] [(rb->clj k) (rb->clj v)]))
      (into {})))

  RubySymbol
  (rb->clj [v]
    (keyword (str v))))

(defn require
  "Requires each of `libs` in `rt`."
  [rt & libs]
  (last (map #(eval rt "require '%s'" %) libs)))

(defn setenv
  "Sets `value` for `key` in the `ENV` hash in `rt`.

  `key` and `value` are both converted to strings."
  [rt key value]
  (eval rt "ENV['%s']='%s'" key value))

(defn runtime
  "Creates a new JRuby runtime.

  Optionally takes a map of options [default]:

  * :preserve-locals? - any locals defined in an eval will persist, visible to future evals [false]
  * :load-paths - a sequence of paths to add to the runtime's load path [nil]
  * :env - a map of values to set in the ruby ENV [nil]
  * :gem-paths - a sequence of paths to search for gems [nil]"
  ([] (runtime nil))
  ([{:keys [preserve-locals? gem-paths load-paths env]}]
     (let [rt (ScriptingContainer. (if preserve-locals?
                                     LocalVariableBehavior/PERSISTENT
                                     LocalVariableBehavior/TRANSIENT))]
       (.setLoadPaths rt (conj load-paths
                           (.toExternalForm (io/resource "clj-ruby-helpers"))))
       (when-let [paths (seq gem-paths)]
         (setenv rt "GEM_PATH" (str/join ":" (map pr-str paths))))
       (doseq [[k v] env]
         (setenv rt k v))
       (require "rubygems")
       rt)))

(defn install-gem
  "Downloads and installs the gem specificied by `name` and `version`.

  Optionally takes a map of options [default]:

  * :sources - a sequence additional gem sources to add to the default list [nil]
  * :install-dir - a path to a directory where the gem should be installed. If nil,
                   the default gem path is used. [nil]
  * :force? - install the gem, even if it is already installed [false]
  * :ignore-dependencies? - don't install the gems dependencies [false]"
  ([rt name version]
     (install-gem rt name version nil))
  ([rt name version {:keys [ignore-dependencies? force? sources install-dir]}]
     (let [helper (rb-helper rt)]
       (if (and (not force?)
             (call-method rt helper "gem_installed?" name version))
         (println (format "%s v%s already installed, skipping." name version))
         (let [curr-sources (eval rt "Gem.sources")
               installer (call-method rt helper "gem_installer"
                           (boolean ignore-dependencies?)
                           (boolean force?)
                           (if install-dir
                             install-dir
                             (call-method rt helper "first_writeable_gem_path")))]
           (try
             (when sources
               (eval rt helper "add_gem_sources" sources))
             (call-method rt installer "install" name version)
             (finally
               (call-method rt helper "add_gem_sources" curr-sources (boolean :replace)))))))))

(defn shutdown-runtime
  "Shuts down the given JRuby runtime."
  [rt]
  (.finalize rt))

Fix typo that caused runtime creation to fail.


; Copyright 2009 Howard M. Lewis Ship
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;   http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
; implied. See the License for the specific language governing permissions
; and limitations under the License.

(ns #^{:doc "Exception reporting view and pipeline"}
  cascade.exception
  (:import
  	(javax.servlet.http HttpServletRequest HttpSession)
  	(java.lang Throwable StackTraceElement))
  (:require
  	(clojure.contrib (str-utils2 :as s2)))
  (:use
  	clojure.stacktrace
  	cascade
  	(cascade.internal utils)
  	(cascade config logging pipeline renderer dispatcher utils)))

;; Identifies the properties of Throwable that are excluded from each exception-map's set of properties
(def throwable-properties (keys (bean (Throwable.))))

(defn class-name-for-element
  "Returns the CSS class name for a stack frame element, or nil.  Useful values are :c-omitted-frame
   or :c-usercode-frame."
  [#^StackTraceElement element]
  (lcond
  	:let [class-name (.getClassName element)]
  	(or
  		(.startsWith class-name "clojure.lang.")
  		(.startsWith class-name "sun.")
  		(.startsWith class-name "java.lang.reflect.")) :c-omitted-frame))

(defn convert-clojure-frame
	"Converts a stack frame into DOM nodes representing the Clojure namespace and function name(s),
	or returns nil if the stack frame is not for a Clojure call frame."
	[class-name method-name]
	(when (contains? #{"invoke" "doInvoke"} method-name)
		(let [[namespace-name & raw-function-ids] (s2/split class-name #"\$")
				  function-ids (map #(nth (first (re-seq #"(\w+)__\d+" %)) 1 nil) raw-function-ids)
				  function-names (map #(s2/replace % \_ \-) function-ids)]
		  (if-not (empty? raw-function-ids)
		  	(template
		  		namespace-name "/" (s2/join "/" function-names)
		  	  :span { :class :c-omitted } [ " " class-name "." method-name])))))

(defn transform-stack-frame
  [#^StackTraceElement element]
  {
  	:element element
  	:method-name
	  	(let [file-name (.getFileName element)
	  			  line-number (.getLineNumber element)
	  			  class-name (.getClassName element)
	  			  method-name (.getMethodName element)]
	  		(template
	  		  (or
	  		  	(convert-clojure-frame class-name method-name)
	  		  	(str class-name "." method-name))
	  		  " "
	  		  (cond
	  		    (.isNativeMethod element) (template :em [ "(Native Method)" ])
	  		    (and (not (nil? file-name)) (< 0 line-number)) (str "(" file-name ":" line-number ")")
	  		    (not (nil? file-name)) (str "(" file-name ")")
	  		    true (template :em [ "(Unknown Source)" ]))))
	  	:class-name (class-name-for-element element)
  })

(defn transform-stack-trace
  "Transforms a primitive array of StackTraceElements into individual maps;
  :method-name is a seq of DOM nodes to describe the method and location
  :element is the original StackTraceElement
  :class-name is a keyword (may be nil) used when rendering the frame as an :li element"
  [elements]
  (loop [seen-filter false
  			 queue (map transform-stack-frame (seq elements))
  			 result []]
    (let [first-frame (first queue)
    			#^StackTraceElement element (get first-frame :element)]
    		(cond
		  	  (nil? first-frame) result
		  		seen-filter (recur true (rest queue) (conj result (assoc first-frame :class-name :c-omitted-frame)))
		  		true (recur (= (.getClassName element) "cascade.filter") (rest queue) (conj result first-frame))))))

(defn expand-exception-stack
    "Expands a simple exception into a seq of exception maps, representing the stack of exceptions (the first or outer
    exceptions wrap the later, inner, deeper exceptions). Each map has keys :class-name, :message, :stack-trace and :properties.
    :class-name is the name of the exception class, :message is the message associated with the exception,
    :stack-trace is via transform-stack-trace (and will only be present in the last, or deepest, exception map),
    and :properties is a map of additional JavaBean properties of the map that should be presented to the user. The values
    of the :properties map are Java objects, not necesarilly strings, and will need further transformation to be
    presented."
    [#^Throwable thrown-exception]
    (loop [#^Throwable current thrown-exception
           stack []]
      (let [bean-properties (bean current)
            next-exception (.getCause current)
            is-deepest (nil? next-exception)
            exception-map { :class-name (.. current getClass getName)
                            :message (.getMessage current)
                            :properties (apply dissoc bean-properties throwable-properties) }]
        (if is-deepest
          (conj stack (assoc exception-map :stack-trace (transform-stack-trace (.getStackTrace current))))
          (recur next-exception (conj stack exception-map))))))

(def exception-banner "An unexpected exception has occured.")

(defn render-exception-map
  "Renders an individual exception map. "
  [{:keys [class-name message properties stack-trace]}]
  (let [deepest (not (nil? stack-trace))
        has-properties (not (empty? properties))
        render-dl (or has-properties deepest)]
	  (template
	    :span { :class :c-exception-class-name } [ class-name ]

	    (if-not (nil? message)
	      (template :div { :class :c-exception-message } [ message ]))

	    (when render-dl
	      (template
	        :dl [
	          (template-for [k (sort (keys properties))]
	            :dt [ (name k)]
	            :dd [ (str (get properties k)) ])
	          (when deepest
	            (template
	              :dt [ "Stack Trace" ]
	              :ul { :class :c-stack-trace } [
	                (template-for [frame stack-trace]
	                  :li {:class (frame :class-name) } [ (frame :method-name) ])
	              ]))
	        ])))))

(defn include-js-library
  [env path]
  (template
  	; Force open/close tags for stupid browser compatibility
  	:script { :type "text/javascript" :src (classpath-asset-path env path) } [ linebreak ]))

(defn render-system-properties
	[]
	(let [path-sep (System/getProperty "path.separator")]
		(template
			:dl [
				(template-for [name (sort (seq (.keySet (System/getProperties))))
											:let [value (System/getProperty name)]]
					:dt [ name ]
					:dd [
						(if (or (.endsWith name "path") (.endsWith name "dirs"))
							(template :ul [
								(template-for [v (.split value path-sep)]
									:li [ v ])
							])
							value)
					 ])
			])))

(defn render-environment
	[env]
	(let
		[#^HttpServletRequest request (-> env :servlet-api :request)
	   session (.getSession request false)]
		(template
			:div { :class :c-env-data } [

		  	:h2 [ "Environment" ]

		  	:dl [
		  	  :dt [ "Clojure Version" ]
		  	  :dd [ (render *clojure-version*) ]
		  	  :dt [ "Cascade Version" ]
		  	  :dd [ "TBD" ]
		  	  :dt [ "Application Version" ]
		  	  :dd [ (read-config :application-version) ]
		  	]

		  	:h2 [ "Request" ]

		  	(render request)

		  	:h2 [ "Servlet Context" ]

		  	(render (-> env :servlet-api :context))

				(if session
					(template
						:h2 [  "Session" ]

						(render session)))

				:h2 [ "System Properties" ]

				(render-system-properties)

		])))

(defn render-exception-report-detail
	[env exception]
	(template
		:p { :class :c-exception-controls } [
			:input { :type :checkbox :id :omitted-toggle }
       " "
      :label { :for :omitted-toggle } [ "Display hidden detail" ]
    ]

    :ul { :class :c-exception-report } [
      (template-for [m (expand-exception-stack exception)]
	    	; TODO: Smarter logic about which frames to be hidden
	    	; Currently, assumes only the deepest is interesting.
	    	; When we add some additonal levels of try/catch & report
	    	; it may be useful to display some of the outer exceptions as well
	      :li { :class (if (nil? (m :stack-trace)) :c-omitted) } [ (render-exception-map m) ])
	  ]

		(render-environment env)))

(defview exception-report
  "The default exception report view. The top-most thrown exception is expected in the [:cascade :exception] key of the environment.
  Formats a detailed HTML report of the exception and the overall environment."
  [env]
  (let [production-mode (read-config :production-mode)
  		  #^Throwable exception (-> env :cascade :exception)]
    (template
	    :html [
		    :head [
		      :title [ exception-banner ]
		      (include-js-library env (read-config :jquery-path))
		      (include-js-library env "cascade/exception-report.js")
		      :link { :rel "stylesheet" :type "text/css" :href (classpath-asset-path env "cascade/cascade.css") }
		     ]
		    :body [
		      :h1 {:class "c-exception-report" } [ exception-banner ]

		      (if production-mode
		      	(template :div { :class :c-exception-message } [
								(.getMessage (root-cause exception))
							])
		        (render-exception-report-detail env exception))
		    ]
	  ])))

; Copyright 2009 Howard M. Lewis Ship
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;   http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
; implied. See the License for the specific language governing permissions
; and limitations under the License.

(ns #^{:doc "Exception reporting view and pipeline"}
  cascade.exception
  (:import
  	(javax.servlet.http HttpServletRequest HttpSession)
  	(java.lang Throwable StackTraceElement))
  (:require
  	(clojure.contrib (str-utils2 :as s2)))
  (:use
  	clojure.stacktrace
  	cascade
  	(cascade.internal utils)
  	(cascade config logging pipeline renderer dispatcher utils)))

;; Identifies the properties of Throwable that are excluded from each exception-map's set of properties
(def throwable-properties (keys (bean (Throwable.))))

(defn class-name-for-element
  "Returns the CSS class name for a stack frame element, or nil.  Useful values are :c-omitted-frame
   or :c-usercode-frame."
  [#^StackTraceElement element]
  (lcond
  	:let [class-name (.getClassName element)]
  	(or
  		(.startsWith class-name "clojure.lang.")
  		(.startsWith class-name "sun.")
  		(.startsWith class-name "java.lang.reflect.")) :c-omitted-frame))

(defn convert-clojure-frame
	"Converts a stack frame into DOM nodes representing the Clojure namespace and function name(s),
	or returns nil if the stack frame is not for a Clojure call frame."
	[class-name method-name]
	(when (contains? #{"invoke" "doInvoke"} method-name)
		(let [[namespace-name & raw-function-ids] (s2/split class-name #"\$")
				  function-ids (map #(nth (first (re-seq #"(\w+)__\d+" %)) 1 nil) raw-function-ids)
				  function-names (map #(s2/replace % \_ \-) function-ids)]
		  (if-not (empty? raw-function-ids)
		  	(template
		  		namespace-name "/" (s2/join "/" function-names)
		  	  :span { :class :c-omitted } [ " " class-name "." method-name])))))

(defn transform-stack-frame
  [#^StackTraceElement element]
  {
  	:element element
  	:method-name
	  	(let [file-name (.getFileName element)
	  			  line-number (.getLineNumber element)
	  			  class-name (.getClassName element)
	  			  method-name (.getMethodName element)]
	  		(template
	  		  (or
	  		  	(convert-clojure-frame class-name method-name)
	  		  	(str class-name "." method-name))
	  		  " "
	  		  (cond
	  		    (.isNativeMethod element) (template :em [ "(Native Method)" ])
	  		    (and (not (nil? file-name)) (< 0 line-number)) (str "(" file-name ":" line-number ")")
	  		    (not (nil? file-name)) (str "(" file-name ")")
	  		    true (template :em [ "(Unknown Source)" ]))))
	  	:class-name (class-name-for-element element)
  })

(defn transform-stack-trace
  "Transforms a primitive array of StackTraceElements into individual maps;
  :method-name is a seq of DOM nodes to describe the method and location
  :element is the original StackTraceElement
  :class-name is a keyword (may be nil) used when rendering the frame as an :li element"
  [elements]
  (loop [seen-filter false
  			 queue (map transform-stack-frame (seq elements))
  			 result []]
    (let [first-frame (first queue)
    			#^StackTraceElement element (get first-frame :element)]
    		(cond
		  	  (nil? first-frame) result
		  		seen-filter (recur true (rest queue) (conj result (assoc first-frame :class-name :c-omitted-frame)))
		  		true (recur (= (.getClassName element) "cascade.filter") (rest queue) (conj result first-frame))))))

(defn expand-exception-stack
    "Expands a simple exception into a seq of exception maps, representing the stack of exceptions (the first or outer
    exceptions wrap the later, inner, deeper exceptions). Each map has keys :class-name, :message, :stack-trace and :properties.
    :class-name is the name of the exception class, :message is the message associated with the exception,
    :stack-trace is via transform-stack-trace (and will only be present in the last, or deepest, exception map),
    and :properties is a map of additional JavaBean properties of the map that should be presented to the user. The values
    of the :properties map are Java objects, not necesarilly strings, and will need further transformation to be
    presented."
    [#^Throwable thrown-exception]
    (loop [#^Throwable current thrown-exception
           stack []]
      (let [bean-properties (bean current)
            next-exception (.getCause current)
            is-deepest (nil? next-exception)
            exception-map { :class-name (.. current getClass getName)
                            :message (.getMessage current)
                            :properties (apply dissoc bean-properties throwable-properties) }]
        (if is-deepest
          (conj stack (assoc exception-map :stack-trace (transform-stack-trace (.getStackTrace current))))
          (recur next-exception (conj stack exception-map))))))

(def exception-banner "An unexpected exception has occurred.")

(defn render-exception-map
  "Renders an individual exception map. "
  [{:keys [class-name message properties stack-trace]}]
  (let [deepest (not (nil? stack-trace))
        has-properties (not (empty? properties))
        render-dl (or has-properties deepest)]
	  (template
	    :span { :class :c-exception-class-name } [ class-name ]

	    (if-not (nil? message)
	      (template :div { :class :c-exception-message } [ message ]))

	    (when render-dl
	      (template
	        :dl [
	          (template-for [k (sort (keys properties))]
	            :dt [ (name k)]
	            :dd [ (str (get properties k)) ])
	          (when deepest
	            (template
	              :dt [ "Stack Trace" ]
	              :ul { :class :c-stack-trace } [
	                (template-for [frame stack-trace]
	                  :li {:class (frame :class-name) } [ (frame :method-name) ])
	              ]))
	        ])))))

(defn include-js-library
  [env path]
  (template
  	; Force open/close tags for stupid browser compatibility
  	:script { :type "text/javascript" :src (classpath-asset-path env path) } [ linebreak ]))

(defn render-system-properties
	[]
	(let [path-sep (System/getProperty "path.separator")]
		(template
			:dl [
				(template-for [name (sort (seq (.keySet (System/getProperties))))
											:let [value (System/getProperty name)]]
					:dt [ name ]
					:dd [
						(if (or (.endsWith name "path") (.endsWith name "dirs"))
							(template :ul [
								(template-for [v (.split value path-sep)]
									:li [ v ])
							])
							value)
					 ])
			])))

(defn render-environment
	[env]
	(let
		[#^HttpServletRequest request (-> env :servlet-api :request)
	   session (.getSession request false)]
		(template
			:div { :class :c-env-data } [

		  	:h2 [ "Environment" ]

		  	:dl [
		  	  :dt [ "Clojure Version" ]
		  	  :dd [ (render *clojure-version*) ]
		  	  :dt [ "Cascade Version" ]
		  	  :dd [ "TBD" ]
		  	  :dt [ "Application Version" ]
		  	  :dd [ (read-config :application-version) ]
		  	]

		  	:h2 [ "Request" ]

		  	(render request)

		  	:h2 [ "Servlet Context" ]

		  	(render (-> env :servlet-api :context))

				(if session
					(template
						:h2 [  "Session" ]

						(render session)))

				:h2 [ "System Properties" ]

				(render-system-properties)

		])))

(defn render-exception-report-detail
	[env exception]
	(template
		:p { :class :c-exception-controls } [
			:input { :type :checkbox :id :omitted-toggle }
       " "
      :label { :for :omitted-toggle } [ "Display hidden detail" ]
    ]

    :ul { :class :c-exception-report } [
      (template-for [m (expand-exception-stack exception)]
	    	; TODO: Smarter logic about which frames to be hidden
	    	; Currently, assumes only the deepest is interesting.
	    	; When we add some additonal levels of try/catch & report
	    	; it may be useful to display some of the outer exceptions as well
	      :li { :class (if (nil? (m :stack-trace)) :c-omitted) } [ (render-exception-map m) ])
	  ]

		(render-environment env)))

(defview exception-report
  "The default exception report view. The top-most thrown exception is expected in the [:cascade :exception] key of the environment.
  Formats a detailed HTML report of the exception and the overall environment."
  [env]
  (let [production-mode (read-config :production-mode)
  		  #^Throwable exception (-> env :cascade :exception)]
    (template
	    :html [
		    :head [
		      :title [ exception-banner ]
		      (include-js-library env (read-config :jquery-path))
		      (include-js-library env "cascade/exception-report.js")
		      :link { :rel "stylesheet" :type "text/css" :href (classpath-asset-path env "cascade/cascade.css") }
		     ]
		    :body [
		      :h1 {:class "c-exception-report" } [ exception-banner ]

		      (if production-mode
		      	(template :div { :class :c-exception-message } [
								(.getMessage (root-cause exception))
							])
		        (render-exception-report-detail env exception))
		    ]
	  ])))

Fix typo in exception-report view.

Fix typo in exception-report view.

Fixes #29.


(ns spec-tools.data-spec-test
  (:require [clojure.test :refer [deftest testing is]]
            [clojure.spec.alpha :as s]
            [spec-tools.data-spec :as ds]
            [spec-tools.core :as st]
            [spec-tools.spec :as spec]))

(def ignoring-spec #(dissoc % ::s/spec))

(deftest coll-of-spec-tests
  (let [spec (s/coll-of string? :into [])
        impl (#'ds/coll-of-spec string? [])]
    (is (= (s/form spec)
           (s/form impl)))
    (is (= `(s/coll-of (st/spec string? {:type :string}) :into [])
           (s/form (#'ds/coll-of-spec spec/string? []))))
    (is (= nil
           (s/explain-data spec ["1"])
           (s/explain-data impl ["1"])))
    (comment "CLJ-CLJ-2168"
             (is (= (ignoring-spec (s/explain-data spec [1]))
                    (ignoring-spec (s/explain-data impl [1])))))
    (is (= ["1"]
           (s/conform spec ["1"])
           (s/conform impl ["1"])))))

(deftest map-of-spec-tests
  (let [spec (s/map-of string? string? :conform-keys true)
        impl (#'ds/map-of-spec string? string?)]
    (is (= (s/form spec)
           (s/form impl)))
    (is (= `(s/map-of
              (st/spec string? {:type :string})
              (st/spec string? {:type :string})
              :conform-keys true)
           (s/form (#'ds/map-of-spec spec/string? spec/string?))))
    (is (= nil
           (s/explain-data spec {"key" "value"})
           (s/explain-data impl {"key" "value"})))
    (is (= (s/explain-data spec {"key" "value"})
           (s/explain-data impl {"key" "value"})))
    (is (= {"key" "value"}
           (s/conform spec {"key" "value"})
           (s/conform impl {"key" "value"})))))

(s/def ::int int?)
(s/def ::str string?)
(s/def ::bool boolean?)

(deftest keys-spec-tests
  (let [spec (s/keys :req [::int]
                     :opt [::str]
                     :req-un [::bool]
                     :opt-un [::int])
        impl (#'ds/keys-spec {:req [::int]
                              :opt [::str]
                              :req-un [::bool]
                              :opt-un [::int]})]

    (is (= (s/form spec)
           (s/form impl)))
    (is (= nil
           (s/explain-data spec {::int 1, :bool true})
           (s/explain-data impl {::int 1, :bool true})))
    (is (= (ignoring-spec (s/explain-data spec {::int "1"}))
           (ignoring-spec (s/explain-data impl {::int "1"}))))
    (is (= {::int 1, :bool true, :kikka "kakka"}
           (s/conform spec {::int 1, :bool true, :kikka "kakka"})
           (s/conform impl {::int 1, :bool true, :kikka "kakka"})))))

(deftest nilable-spec-tst
  (let [spec (s/nilable string?)
        impl (#'ds/nilable-spec string?)]
    (is (= (s/form spec)
           (s/form impl)))
    (is (= `(s/nilable (st/spec string? {:type :string}))
           (s/form (#'ds/nilable-spec spec/string?))))
    (is (= nil
           (s/explain-data spec "1")
           (s/explain-data spec nil)
           (s/explain-data impl "1")
           (s/explain-data impl nil)))
    (is (= (ignoring-spec (s/explain-data spec [1]))
           (ignoring-spec (s/explain-data impl [1]))))
    (is (= "1"
           (s/conform spec "1")
           (s/conform impl "1")))))

(s/def ::age (s/and spec/integer? #(> % 10)))

(deftest data-spec-tests
  (testing "nested data-spec"
    (let [person {::id integer?
                  ::age ::age
                  :boss boolean?
                  (ds/req :name) string?
                  (ds/opt :description) string?
                  :languages #{keyword?}
                  :orders [{:id int?
                            :description string?}]
                  :address (ds/maybe {:street string?
                                      :zip string?})}
          person-spec (ds/spec ::person person)
          person-keys-spec (st/spec
                             (s/keys
                               :req [::id ::age]
                               :req-un [:spec-tools.data-spec-test$person/boss
                                        :spec-tools.data-spec-test$person/name
                                        :spec-tools.data-spec-test$person/languages
                                        :spec-tools.data-spec-test$person/orders
                                        :spec-tools.data-spec-test$person/address]
                               :opt-un [:spec-tools.data-spec-test$person/description]))]

      (testing "normal keys-spec-spec is generated"
        (is (= (s/form person-keys-spec)
               (s/form person-spec))))

      (testing "nested keys are in the registry"
        (let [generated-keys (->> (st/registry #"spec-tools.data-spec-test\$person.*") (map first) set)]
          (is (= #{:spec-tools.data-spec-test$person/boss
                   :spec-tools.data-spec-test$person/name
                   :spec-tools.data-spec-test$person/description
                   :spec-tools.data-spec-test$person/languages
                   :spec-tools.data-spec-test$person/orders
                   :spec-tools.data-spec-test$person$orders/id
                   :spec-tools.data-spec-test$person$orders/description
                   :spec-tools.data-spec-test$person/address
                   :spec-tools.data-spec-test$person$address/zip
                   :spec-tools.data-spec-test$person$address/street}
                 generated-keys))
          (testing "all registered specs are Specs"
            (is (true? (every? st/spec? (map st/get-spec generated-keys)))))))
      (testing "validating"
        (let [value {::id 1
                     ::age 63
                     :boss true
                     :name "Liisa"
                     :languages #{:clj :cljs}
                     :orders [{:id 1, :description "cola"}
                              {:id 2, :description "kebab"}]
                     :description "Liisa is a valid boss"
                     :address {:street "Amurinkatu 2"
                               :zip "33210"}}
              bloated (-> value
                          (assoc-in [:KIKKA] true)
                          (assoc-in [:address :KIKKA] true))]

          (testing "data can be validated"
            (is (true? (s/valid? person-spec value))))

          (testing "fails with invalid data"
            (is (false? (s/valid? person-spec (dissoc value :boss)))))

          (testing "optional keys"
            (is (true? (s/valid? person-spec (dissoc value :description)))))

          (testing "maybe values"
            (is (true? (s/valid? person-spec (assoc value :address nil)))))

          (testing "map-conforming works recursively"
            (is (= value
                   (st/conform person-spec bloated st/strip-extra-keys-conforming))))))))

  (testing "top-level vector"
    (is (true?
          (s/valid?
            (ds/spec ::vector [{:olipa {:kerran string?}}])
            [{:olipa {:kerran "avaruus"}}
             {:olipa {:kerran "elämä"}}])))
    (is (false?
          (s/valid?
            (ds/spec ::vector [{:olipa {:kerran string?}}])
            [{:olipa {:kerran :muumuu}}]))))

  (testing "top-level set"
    (is (true?
          (s/valid?
            (ds/spec ::vector #{{:olipa {:kerran string?}}})
            #{{:olipa {:kerran "avaruus"}}
              {:olipa {:kerran "elämä"}}})))
    (is (false?
          (s/valid?
            (ds/spec ::vector #{{:olipa {:kerran string?}}})
            #{{:olipa {:kerran :muumuu}}}))))

  (testing "mega-nested"
    (is (true?
          (s/valid?
            (ds/spec ::vector [[[[[[[[[[string?]]]]]]]]]])
            [[[[[[[[[["kikka" "kakka" "kukka"]]]]]]]]]])))
    (is (false?
          (s/valid?
            (ds/spec ::vector [[[[[[[[[[string?]]]]]]]]]])
            [[[[[[[[[123]]]]]]]]]))))

  (testing "predicate keys"
    (is
      (true?
        (s/valid?
          (ds/spec ::pred-keys {string? {keyword? [integer?]}})
          {"winning numbers" {:are [1 12 46 45]}
           "empty?" {:is []}})))
    (is
      (false?
        (s/valid?
          (ds/spec ::pred-keys {string? {keyword? [integer?]}})
          {"invalid spec" "is this"}))))

  (testing "set keys"
    (let [spec (ds/spec ::pred-keys {#{:one :two} string?})]
      (is
        (= true
           (s/valid? spec {:one "beer"})
           (s/valid? spec {:two "beers"})))
      (is
        (= false
           (s/valid? spec {:three "beers"})))))

  (testing "map-of key conforming"
    (is (= {:thanks :alex}
           (st/conform
             (ds/spec ::kikka {keyword? keyword?})
             {"thanks" "alex"}
             st/string-conforming)))))

(deftest pithyless-test
  (is (st/explain-data (ds/spec ::foo {:foo string?}) {:foo 42})))

Add pithyless regression test

Add pithyless regression test


(ns swarmpit.api-integration-test
  (:require [swarmpit.test :refer :all]
            [swarmpit.api :refer :all]
            [swarmpit.docker.engine.client :as client]
            [clojure.test :refer :all]
            [clojure.edn :as edn]))

(use-fixtures :once db-init-fixture dind-socket-fixture running-service-fixture)

(defn test-crud
  [crud]
  (let [{:keys [name spec create read list update delete]} crud]
    (let [id (:id (create spec))
          created (read id)]
      (is (some? id))
      (is (some? created))
      (when name
        (is (some? (read name))))
      (is (not (empty? (list))))
      (when update
        (update id created)
        (is (< (:version created) (:version (read id)))))
      (delete id)
      (is (thrown? Exception (read id))))))

(deftest ^:integration docker
  (let [service-id (-> (client/services) first :ID)]

    (testing "services"
      (is (some? (services))))

    (testing "service"
      (is (some? (service service-id)))
      (is (= service-id (:id (service service-id))))
      (is (= (-> (services) first) (service service-id)))
      (is (some? (service-networks service-id)))
      (is (some? (service-tasks service-id))))

    (testing "scale service"
      (let [id (->> (edn/read-string (slurp "test/clj/swarmpit/create-service.edn"))
                    (create-service nil)
                    :id)
            created (service id)]
        (is (= "hello-world" (-> created :repository :name)))
        (is (= 1 (-> created :replicas)))
        (update-service id (merge created {:replicas 2}))
        (is (= 2 (-> id (service) :replicas)))
        (delete-service id)))

    (testing "crud services"
      (test-crud {:name   "created"
                  :spec   (-> "test/clj/swarmpit/create-service.edn"
                              (slurp)
                              (edn/read-string))
                  :create (fn [spec] (create-service nil spec))
                  :read   service
                  :list   services
                  :update (fn [_ spec] (update-service nil spec))
                  :delete delete-service}))

    (testing "secrets"
      (is (some? (secrets))))

    (testing "crud secrets"
      (test-crud {:name   nil ; docker 1.13 doesn't support query by name
                  :spec   {:secretName "test-secret"
                           :encode     true
                           :data       "asdf"}
                  :create create-secret
                  :read   secret
                  :list   secrets
                  :update update-secret
                  :delete delete-secret}))

    (testing "networks"
      (let [networks (networks)
            some-network (-> networks first)]
        (is (some? networks))
        (is (some? (:id some-network)))
        ; TODO: following assert should be fixed, there are no reason that date in list should be different
        (is (not (= (:created some-network) (:created (network (:id some-network))))))
        (is (= "overlay" (:driver some-network)))
        (is (= "swarm" (:scope some-network)))))

    (testing "crud networks"
      (test-crud {:name   "test-net"
                  :spec   {:networkName "test-net"
                           :internal    false
                           :driver      "overlay"}
                  :create create-network
                  :read   network
                  :list   networks
                  :delete delete-network}))

    (testing "volumes"
      (is (some? (volumes))))

    (testing "crud volumes"
      (test-crud {:name   "test-volume"
                  :spec   {:volumeName "test-volume"
                           :driver     "local"}
                  :create create-volume
                  :read   volume
                  :list   volumes
                  :delete delete-volume}))

    (testing "nodes"
      (let [nodes (nodes)
            some-node (-> nodes first)]
        (is (some? nodes))
        (is (some? (:id some-node)))
        (is (= some-node (node (:id some-node))))
        (is (= "manager" (:role some-node)))
        (is (= "ready" (:state some-node)))))

    (testing "tasks"
      (let [tasks (tasks)]
        (is (some? tasks))
        (is (= (service-tasks service-id)
               (->> tasks
                    (filter #(.startsWith (:taskName %) "test")))))))

    (testing "find public repository"
      (let [results (public-repositories "nginx" 1)]
        (is (some? results))
        (is (= "nginx" (:query results)))
        (is (= "nginx" (-> results :results first :name)))))))

(ns swarmpit.api-integration-test
  (:require [swarmpit.test :refer :all]
            [swarmpit.api :refer :all]
            [swarmpit.docker.engine.client :as client]
            [clojure.test :refer :all]
            [clojure.edn :as edn]))

(use-fixtures :once db-init-fixture dind-socket-fixture running-service-fixture)

(defn test-crud
  [crud]
  (let [{:keys [name spec create read list update delete]} crud]
    (let [id (:id (create spec))
          created (read id)]
      (is (some? id))
      (is (some? created))
      (when name
        (is (some? (read name))))
      (is (not (empty? (list))))
      (when update
        (update id created)
        (is (< (:version created) (:version (read id)))))
      (delete id)
      (is (thrown? Exception (read id))))))

(deftest ^:integration docker
  (let [service-id (-> (client/services) first :ID)]

    (testing "services"
      (is (some? (services))))

    (testing "service"
      (is (some? (service service-id)))
      (is (= service-id (:id (service service-id))))
      (is (= (-> (services) first) (service service-id)))
      (is (some? (service-networks service-id)))
      (is (some? (service-tasks service-id))))

    (testing "scale service"
      (let [id (->> (edn/read-string (slurp "test/clj/swarmpit/create-service.edn"))
                    (create-service nil)
                    :id)
            created (service id)]
        (is (= "hello-world" (-> created :repository :name)))
        (is (= 1 (-> created :replicas)))
        (update-service id (merge created {:replicas 2}))
        (is (= 2 (-> id (service) :replicas)))
        (delete-service id)))

    (testing "crud services"
      (test-crud {:name   "created"
                  :spec   (-> "test/clj/swarmpit/create-service.edn"
                              (slurp)
                              (edn/read-string))
                  :create (fn [spec] (create-service nil spec))
                  :read   service
                  :list   services
                  :update (fn [_ spec] (update-service nil spec))
                  :delete delete-service}))

    (testing "secrets"
      (is (some? (secrets))))

    (testing "crud secrets"
      (test-crud {:name   nil ; docker 1.13 doesn't support query by name
                  :spec   {:secretName "test-secret"
                           :encode     true
                           :data       "asdf"}
                  :create create-secret
                  :read   secret
                  :list   secrets
                  :update update-secret
                  :delete delete-secret}))

    (testing "networks"
      (let [networks (networks)
            some-network (-> networks first)]
        (is (some? networks))
        (is (some? (:id some-network)))
        ; TODO: following assert should be fixed, there are no reason that date in list should be different
        (is (not (= (:created some-network) (:created (network (:id some-network))))))
        (is (= "overlay" (:driver some-network)))
        (is (= "swarm" (:scope some-network)))))

    (testing "crud networks"
      (test-crud {:name   "test-net"
                  :spec   {:networkName "test-net"
                           :internal    false
                           :driver      "overlay"}
                  :create create-network
                  :read   network
                  :list   networks
                  :delete delete-network}))

    (testing "volumes"
      (is (some? (volumes))))

    (testing "crud volumes"
      (test-crud {:name   "test-volume"
                  :spec   {:volumeName "test-volume"
                           :driver     "local"}
                  :create create-volume
                  :read   volume
                  :list   volumes
                  :delete delete-volume}))

    (testing "nodes"
      (let [nodes (nodes)
            some-node (-> nodes first)]
        (is (some? nodes))
        (is (some? (:id some-node)))
        (is (= some-node (node (:id some-node))))
        (is (= "manager" (:role some-node)))
        (is (= "ready" (:state some-node)))))

    (testing "tasks"
      (let [tasks (tasks)]
        (is (some? tasks))))

    (testing "find public repository"
      (let [results (public-repositories "nginx" 1)]
        (is (some? results))
        (is (= "nginx" (:query results)))
        (is (= "nginx" (-> results :results first :name)))))))

test simplified

test simplified


(ns collect-earth-online.generators.clj-point
  (:require [triangulum.type-conversion :as tc]
            [collect-earth-online.utils.project :refer [check-plot-limits check-sample-limits]]
            [collect-earth-online.utils.geom    :refer [make-wkt-point EPSG:3857->4326 EPSG:4326->3857]]))

(defn- count-gridded-points [left bottom right top spacing]
  (let [x-range (- right left)
        y-range (- top bottom)
        x-steps (+ (Math/floor (/ x-range spacing)) 1)
        y-steps (+ (Math/floor (/ y-range spacing)) 1)]
    (* x-steps y-steps)))

;; Create random and gridded points

(defn- random-with-buffer [side size buffer]
  (+ side
     (* (Math/floor (* (Math/random) size (/ buffer))) buffer)
     (/ buffer 2.0)))

(defn- distance [x1 y1 x2 y2]
  (Math/sqrt (+ (Math/pow (- x2 x1) 2.0)
                (Math/pow (- y2 y1) 2.0))))

(defn- pad-bounds [left bottom right top buffer]
  [(+ left buffer) (+ bottom buffer) (- right buffer) (- top buffer)])

;; TODO Use postGIS so arbitrary bounds can be uploaded
(defn- create-random-points-in-bounds [left bottom right top num-points]
  (let [x-range (- right left)
        y-range (- top bottom)
        buffer  (/ x-range 50.0)]
    (->> (repeatedly (fn [] [(random-with-buffer left x-range buffer) (random-with-buffer bottom y-range buffer)]))
         (take num-points)
         (map #(EPSG:3857->4326 %)))))

;; TODO Use postGIS so arbitrary bounds can be set
(defn- create-gridded-plots-in-bounds [left bottom right top spacing]
  (let [x-range   (- right left)
        y-range   (- top bottom)
        x-steps   (Math/floor (/ x-range spacing))
        y-steps   (Math/floor (/ y-range spacing))
        x-padding (/ (- x-range (* x-steps spacing)) 2.0)
        y-padding (/ (- y-range (* y-steps spacing)) 2.0)]
    (->> (for [x (range (+ 1 x-steps))
               y (range (+ 1 y-steps))]
           [(+ (* x spacing) left x-padding) (+ (* y spacing) bottom y-padding)])
         (map #(EPSG:3857->4326 %)))))

;; TODO Use postGIS so can be done with shp files
(defn- create-random-sample-set [plot-center plot-shape plot-size samples-per-plot]
  (let [[center-x center-y] (EPSG:4326->3857 plot-center)
        radius (/ plot-size 2.0)
        left   (- center-x radius)
        right  (+ center-x radius)
        top    (+ center-y radius)
        bottom (- center-y radius)
        buffer (/ radius 50.0)]
    (if (= "circle" plot-shape)
      (->> (repeatedly (fn [] [(random-with-buffer left plot-size buffer) (random-with-buffer bottom plot-size buffer)]))
           (take (* 10 samples-per-plot)) ; just as a safety net, so no thread can get stuck
           (filter (fn [[x y]]
                     (< (distance center-x center-y x y)
                        (- radius (/ buffer 2.0)))))
           (take samples-per-plot)
           (map #(EPSG:3857->4326 %)))
      (create-random-points-in-bounds left bottom right top samples-per-plot))))

(defn- create-gridded-sample-set [plot-center plot-shape plot-size sample-resolution]
  (if (>= sample-resolution plot-size)
    [plot-center]
    (let [[center-x center-y] (EPSG:4326->3857 plot-center)
          radius  (/ plot-size 2.0)
          left    (- center-x radius)
          bottom  (- center-y radius)
          steps   (Math/floor (/ plot-size sample-resolution))
          padding (/ (- plot-size (* steps sample-resolution)) 2.0)]
      (->> (for [x (range (inc steps))
                 y (range (inc steps))]
             [(+ (* x sample-resolution) left padding) (+ (* y sample-resolution) bottom padding)])
           (filter (fn [[x y]] (or (= "square" plot-shape)
                                   (< (distance center-x center-y x y) radius))))
           (map #(EPSG:3857->4326 %))))))

(defn generate-point-samples [plots
                              plot-count
                              plot-shape
                              plot-size
                              sample-distribution
                              samples-per-plot
                              sample-resolution]
  (let [samples-per-plot (case sample-distribution
                           "gridded" (count (create-gridded-sample-set [45 45] plot-shape plot-size sample-resolution))
                           "random"  samples-per-plot
                           "center"  1.0
                           "none"    1.0)]
    (check-sample-limits (* plot-count samples-per-plot)
                         50000.0
                         samples-per-plot
                         200.0)
    (mapcat (fn [{:keys [plot_id visible_id lon lat]}]
              (let [plot-center    [lon lat]
                    visible-offset (-> (dec visible_id)
                                       (* samples-per-plot)
                                       (inc))]
                (map-indexed (fn [idx [lon lat]]
                               {:plot_rid    plot_id
                                :visible_id  (+ idx visible-offset)
                                :sample_geom (tc/str->pg (make-wkt-point lon lat) "geometry")})
                             (case sample-distribution
                               "center"
                               [plot-center]

                               "random"
                               (create-random-sample-set plot-center plot-shape plot-size samples-per-plot)

                               "gridded"
                               (create-gridded-sample-set plot-center plot-shape plot-size sample-resolution)

                               []))))
            plots)))

(defn generate-point-plots [project-id
                            lon-min
                            lat-min
                            lon-max
                            lat-max
                            plot-distribution
                            num-plots
                            plot-spacing
                            plot-size]
  (let [[[left bottom] [right top]] (EPSG:4326->3857 [lon-min lat-min] [lon-max lat-max])
        [left bottom right top]     (pad-bounds left bottom right top (/ 2.0 plot-size))]
    (check-plot-limits (if (= "gridded" plot-distribution)
                         (count-gridded-points left bottom right top plot-spacing)
                         num-plots)
                       5000.0)
    (map-indexed (fn [idx [lon lat]]
                   {:project_rid project-id
                    :visible_id  (inc idx)
                    :plot_geom   (tc/str->pg (make-wkt-point lon lat) "geometry")})
                 (if (= "gridded" plot-distribution)
                   (create-gridded-plots-in-bounds left bottom right top plot-spacing)
                   (create-random-points-in-bounds left bottom right top num-plots)))))

(ns collect-earth-online.generators.clj-point
  (:require [triangulum.type-conversion :as tc]
            [collect-earth-online.utils.project :refer [check-plot-limits check-sample-limits]]
            [collect-earth-online.utils.geom    :refer [make-wkt-point EPSG:3857->4326 EPSG:4326->3857]]))

(defn- count-gridded-points [left bottom right top spacing]
  (let [x-range (- right left)
        y-range (- top bottom)
        x-steps (+ (Math/floor (/ x-range spacing)) 1)
        y-steps (+ (Math/floor (/ y-range spacing)) 1)]
    (* x-steps y-steps)))

;; Create random and gridded points

(defn- random-with-buffer [side size buffer]
  (+ side
     (* (Math/floor (* (Math/random) size (/ buffer))) buffer)
     (/ buffer 2.0)))

(defn- distance [x1 y1 x2 y2]
  (Math/sqrt (+ (Math/pow (- x2 x1) 2.0)
                (Math/pow (- y2 y1) 2.0))))

(defn- pad-bounds [left bottom right top buffer]
  [(+ left buffer) (+ bottom buffer) (- right buffer) (- top buffer)])

;; TODO Use postGIS so arbitrary bounds can be uploaded
(defn- create-random-points-in-bounds [left bottom right top num-points]
  (let [x-range (- right left)
        y-range (- top bottom)
        buffer  (/ x-range 50.0)]
    (->> (repeatedly (fn [] [(random-with-buffer left x-range buffer) (random-with-buffer bottom y-range buffer)]))
         (take num-points)
         (map #(EPSG:3857->4326 %)))))

;; TODO Use postGIS so arbitrary bounds can be set
(defn- create-gridded-plots-in-bounds [left bottom right top spacing]
  (let [x-range   (- right left)
        y-range   (- top bottom)
        x-steps   (Math/floor (/ x-range spacing))
        y-steps   (Math/floor (/ y-range spacing))
        x-padding (/ (- x-range (* x-steps spacing)) 2.0)
        y-padding (/ (- y-range (* y-steps spacing)) 2.0)]
    (->> (for [x (range (+ 1 x-steps))
               y (range (+ 1 y-steps))]
           [(+ (* x spacing) left x-padding) (+ (* y spacing) bottom y-padding)])
         (map #(EPSG:3857->4326 %)))))

;; TODO Use postGIS so can be done with shp files
(defn- create-random-sample-set [plot-center plot-shape plot-size samples-per-plot]
  (let [[center-x center-y] (EPSG:4326->3857 plot-center)
        radius (/ plot-size 2.0)
        left   (- center-x radius)
        right  (+ center-x radius)
        top    (+ center-y radius)
        bottom (- center-y radius)
        buffer (/ radius 50.0)]
    (if (= "circle" plot-shape)
      (->> (repeatedly (fn [] [(random-with-buffer left plot-size buffer) (random-with-buffer bottom plot-size buffer)]))
           (take (* 10 samples-per-plot)) ; just as a safety net, so no thread can get stuck
           (filter (fn [[x y]]
                     (< (distance center-x center-y x y)
                        (- radius (/ buffer 2.0)))))
           (take samples-per-plot)
           (map #(EPSG:3857->4326 %)))
      (create-random-points-in-bounds left bottom right top samples-per-plot))))

(defn- create-gridded-sample-set [plot-center plot-shape plot-size sample-resolution]
  (if (>= sample-resolution plot-size)
    [plot-center]
    (let [[center-x center-y] (EPSG:4326->3857 plot-center)
          radius  (/ plot-size 2.0)
          left    (- center-x radius)
          bottom  (- center-y radius)
          steps   (Math/floor (/ plot-size sample-resolution))
          padding (/ (- plot-size (* steps sample-resolution)) 2.0)]
      (->> (for [x (range (inc steps))
                 y (range (inc steps))]
             [(+ (* x sample-resolution) left padding) (+ (* y sample-resolution) bottom padding)])
           (filter (fn [[x y]] (or (= "square" plot-shape)
                                   (< (distance center-x center-y x y) radius))))
           (map #(EPSG:3857->4326 %))))))

(defn generate-point-samples [plots
                              plot-count
                              plot-shape
                              plot-size
                              sample-distribution
                              samples-per-plot
                              sample-resolution]
  (let [samples-per-plot (case sample-distribution
                           "gridded" (count (create-gridded-sample-set [45 45] plot-shape plot-size sample-resolution))
                           "random"  samples-per-plot
                           "center"  1.0
                           "none"    1.0)]
    (check-sample-limits (* plot-count samples-per-plot)
                         50000.0
                         samples-per-plot
                         200.0)
    (mapcat (fn [{:keys [plot_id visible_id lon lat]}]
              (let [plot-center    [lon lat]
                    visible-offset (-> (dec visible_id)
                                       (* samples-per-plot)
                                       (inc))]
                (map-indexed (fn [idx [lon lat]]
                               {:plot_rid    plot_id
                                :visible_id  (+ idx visible-offset)
                                :sample_geom (tc/str->pg (make-wkt-point lon lat) "geometry")})
                             (case sample-distribution
                               "center"
                               [plot-center]

                               "random"
                               (create-random-sample-set plot-center plot-shape plot-size samples-per-plot)

                               "gridded"
                               (create-gridded-sample-set plot-center plot-shape plot-size sample-resolution)

                               []))))
            plots)))

(defn generate-point-plots [project-id
                            lon-min
                            lat-min
                            lon-max
                            lat-max
                            plot-distribution
                            num-plots
                            plot-spacing
                            plot-size]
  (let [[[left bottom] [right top]] (EPSG:4326->3857 [lon-min lat-min] [lon-max lat-max])
        [left bottom right top]     (pad-bounds left bottom right top (/ plot-size 2.0))]
    (check-plot-limits (if (= "gridded" plot-distribution)
                         (count-gridded-points left bottom right top plot-spacing)
                         num-plots)
                       5000.0)
    (map-indexed (fn [idx [lon lat]]
                   {:project_rid project-id
                    :visible_id  (inc idx)
                    :plot_geom   (tc/str->pg (make-wkt-point lon lat) "geometry")})
                 (if (= "gridded" plot-distribution)
                   (create-gridded-plots-in-bounds left bottom right top plot-spacing)
                   (create-random-points-in-bounds left bottom right top num-plots)))))

Correct and match divide by 2

Correct and match divide by 2


(ns clojurewerkz.cassaforte.new-query-api
  "Functions for building dynamic CQL queries, in case you feel
   that `cql` namespace is too limiting for you."
  (:import [com.datastax.driver.core.querybuilder QueryBuilder
            Select$Selection Select Select$Where
            BindMarker
            Clause]
           [com.datastax.driver.core.querybuilder ]))

;;
;; Static QB Methods
;;

(defn ?
  ([]
     (QueryBuilder/bindMarker))
  ([name]
     (QueryBuilder/bindMarker name)))

(defn token
  [& column-names]
  (QueryBuilder/token (into-array column-names)))

(def select-command-order
  [QueryBuilder Select$Selection Select Select$Where])

(defn- ^Clause eq
  [^String column ^Object value]
  (QueryBuilder/eq column value))

(defn- ^Clause in
  [^String column values]
  (QueryBuilder/in column values))

(defn- ^Clause lt
  [^String column ^Object value]
  (QueryBuilder/lt column value))

(defn- ^Clause gt
  [^String column ^Object value]
  (QueryBuilder/gt column value))

(defn- ^Clause lte
  [^String column ^Object value]
  (QueryBuilder/lte column value))

(defn- ^Clause gte
  [^String column ^Object value]
  (QueryBuilder/gte column value))

(defn asc
  [^String column-name]
  (QueryBuilder/asc (name column-name)))

(defn desc
  [^String column-name]
  (QueryBuilder/desc (name column-name)))

(defn cname
  [^String column-name]
  (QueryBuilder/column column-name))

(defn quote*
  [s]
  (QueryBuilder/quote (name s)))

(def ^:private query-type-map
  {:in in
   :=  eq
   =   eq
   :>  gt
   >   gt
   :>= gte
   >=  gte
   :<  lt
   <   lt
   :<= lte
   <=  lte})

(defprotocol WhereBuilder
  (build-where [construct query-builder]))

(extend-protocol WhereBuilder
  clojure.lang.IPersistentVector
  (build-where [construct ^Select$Where query-builder]
    (reduce
     (fn [^Select$Where builder [query-type column value]]
       (if-let [eq-type (query-type-map query-type)]
         (.and builder ((query-type-map query-type) (name column) value))
         (throw (IllegalArgumentException. (str query-type " is not a valid Clause")))
         ))
     query-builder
     construct))
  clojure.lang.IPersistentMap
  (build-where [construct ^Select$Where query-builder]
    (reduce
     (fn [^Select$Where builder [column value]]
       (.and builder (eq (name column) value)))
     query-builder
     construct)))

(def ^:private select-order
  {:what      1
   :from      2
   :where     3
   :order     4
   :limit     4
   :filtering 5})

;;
;; Columns
;;

(defn write-time
  [column]
  (fn writetime-query [query-builder]
    (.writeTime query-builder (name column))))

(defn ttl
  [column]
  (fn ttl-query [query-builder]
    (.ttl query-builder (name column))))

(defn distinct*
  [column]
  (fn distinct-query [query-builder]
    (.distinct (.column query-builder column))))

(defn count-all
  []
  [:what (fn count-all-query [query-builder]
           (.countAll query-builder))])

(defn fcall
  [name & args]
  [:what (fn fcall-query [query-builder]
           (.fcall query-builder name (to-array args)))])

(defn all
  []
  (fn all-query [query-builder]
    (.all query-builder)))

(defn as
  [wrapper alias]
  (fn distinct-query [query-builder]
    (.as (wrapper query-builder) alias)))

(defn columns
  [& columns]
  [:what (fn [^Select$Selection query-builder]
           (reduce (fn [^Select$Selection builder column]
                     (if (string? column)
                       (.column builder column)
                       (column builder)))
                   query-builder
                   columns))])

(defn column
  [column & {:keys [as]}]
  [:what (fn column-query [^Select$Selection query-builder]
           (let [c (.column query-builder (name column))]
             (if as
               (.as c as)
               c)))])

(defn where
  [m]
  [:where
   (fn where-query [^Select query-builder]
     (build-where m (.where query-builder)))])

(defn order-by
  [& orderings]
  [:order
   (fn order-by-query [^Select$Where query-builder]
     (.orderBy query-builder (into-array orderings)))])

(defn limit
  [lim]
  [:limit
   (fn order-by-query [^Select  query-builder]
     (.limit query-builder lim))])

(defn allow-filtering
  []
  [:filtering
   (fn order-by-query [^Select  query-builder]
     (.allowFiltering query-builder))])

(defn- from
  [^String table-name]
  [:from (fn from-query [^Select$Selection query-builder]
           (.from query-builder (name table-name))
           )])

(defn- complete-select-query
  [statements]
  (let [query-map (into {} statements)]
    (if (nil? (:what query-map))
      (conj query-map
            [:what (all)])
      statements)))

(defn select
  [table-name & statements]
  (->> (conj statements (from (name table-name)))
       (complete-select-query)
       (sort-by #(get select-order (first %)))
       ;; (map println)
       (map second)
       (reduce (fn [builder statement]
                 (println builder statement)
                 (statement builder))
               (QueryBuilder/select)
               )
       (.toString)
       ))

;; Select.Builder select(String... columns)
;; Select.Selection select()
;; Insert insertInto(String table)
;; Insert insertInto(String keyspace, String table)
;; Insert insertInto(TableMetadata table)
;; Update update(String table)
;; Update update(String keyspace, String table)
;; Update update(TableMetadata table)
;; Delete.Builder delete(String... columns)
;; Delete.Selection delete()
;; Batch batch(RegularStatement... statements)
;; Batch unloggedBatch(RegularStatement... statements)
;; Truncate truncate(String table)
;; Truncate truncate(String keyspace, String table)
;; Truncate truncate(TableMetadata table)
;; String quote(String columnName)
;; Using timestamp(long timestamp)
;; Using timestamp(BindMarker marker)
;; Assignment set(String name, Object value)
;; Assignment incr(String name)
;; Assignment incr(String name, long value)
;; Assignment incr(String name, BindMarker value)
;; Assignment decr(String name)
;; Assignment decr(String name, long value)
;; Assignment decr(String name, BindMarker value)
;; Assignment prepend(String name, Object value)
;; Assignment prependAll(String name, List<?> list)
;; Assignment prependAll(String name, BindMarker list)
;; Assignment append(String name, Object value)
;; Assignment appendAll(String name, List<?> list)
;; Assignment appendAll(String name, BindMarker list)
;; Assignment discard(String name, Object value)
;; Assignment discardAll(String name, List<?> list)
;; Assignment discardAll(String name, BindMarker list)
;; Assignment setIdx(String name, int idx, Object value)
;; Assignment add(String name, Object value)
;; Assignment addAll(String name, Set<?> set)
;; Assignment addAll(String name, BindMarker set)
;; Assignment remove(String name, Object value)
;; Assignment removeAll(String name, Set<?> set)
;; Assignment removeAll(String name, BindMarker set)
;; Assignment put(String name, Object key, Object value)
;; Assignment putAll(String name, Map<?, ?> map)
;; Assignment putAll(String name, BindMarker map)
;; Object raw(String str)
;;
;;

(ns clojurewerkz.cassaforte.new-query-api
  "Functions for building dynamic CQL queries, in case you feel
   that `cql` namespace is too limiting for you."
  (:import [com.datastax.driver.core.querybuilder QueryBuilder
            Select$Selection Select Select$Where
            BindMarker
            Clause]
           [com.datastax.driver.core.querybuilder ]))

;;
;; Static QB Methods
;;

(defn ?
  ([]
     (QueryBuilder/bindMarker))
  ([name]
     (QueryBuilder/bindMarker name)))

(defn token
  [& column-names]
  (QueryBuilder/token (into-array column-names)))

(defn asc
  [^String column-name]
  (QueryBuilder/asc (name column-name)))

(defn desc
  [^String column-name]
  (QueryBuilder/desc (name column-name)))

(defn cname
  [^String column-name]
  (QueryBuilder/column column-name))

(defn quote*
  [s]
  (QueryBuilder/quote (name s)))

(let [eq  (fn [^String column ^Object value]
            (QueryBuilder/eq column value))

      in  (fn [^String column values]
            (QueryBuilder/in column values))

      lt  (fn [^String column ^Object value]
            (QueryBuilder/lt column value))

      gt  (fn [^String column ^Object value]
            (QueryBuilder/gt column value))

      lte (fn [^String column ^Object value]
            (QueryBuilder/lte column value))

      gte (fn [^String column ^Object value]
            (QueryBuilder/gte column value))]

  (def ^:private query-type-map
    {:in in
     :=  eq
     =   eq
     :>  gt
     >   gt
     :>= gte
     >=  gte
     :<  lt
     <   lt
     :<= lte
     <=  lte}))

(defprotocol WhereBuilder
  (build-where [construct query-builder]))

(extend-protocol WhereBuilder
  clojure.lang.IPersistentVector
  (build-where [construct ^Select$Where query-builder]
    (reduce
     (fn [^Select$Where builder [query-type column value]]
       (if-let [eq-type (query-type-map query-type)]
         (.and builder ((query-type-map query-type) (name column) value))
         (throw (IllegalArgumentException. (str query-type " is not a valid Clause")))
         ))
     query-builder
     construct))
  clojure.lang.IPersistentMap
  (build-where [construct ^Select$Where query-builder]
    (reduce
     (fn [^Select$Where builder [column value]]
       (.and builder (eq (name column) value)))
     query-builder
     construct)))

(def ^:private select-order
  {:what      1
   :from      2
   :where     3
   :order     4
   :limit     4
   :filtering 5})

;;
;; Columns
;;

(defn write-time
  [column]
  (fn writetime-query [query-builder]
    (.writeTime query-builder (name column))))

(defn ttl
  [column]
  (fn ttl-query [query-builder]
    (.ttl query-builder (name column))))

(defn distinct*
  [column]
  (fn distinct-query [query-builder]
    (.distinct (.column query-builder column))))

(defn count-all
  []
  [:what (fn count-all-query [query-builder]
           (.countAll query-builder))])

(defn fcall
  [name & args]
  [:what (fn fcall-query [query-builder]
           (.fcall query-builder name (to-array args)))])

(defn all
  []
  (fn all-query [query-builder]
    (.all query-builder)))

(defn as
  [wrapper alias]
  (fn distinct-query [query-builder]
    (.as (wrapper query-builder) alias)))

(defn columns
  [& columns]
  [:what (fn [^Select$Selection query-builder]
           (reduce (fn [^Select$Selection builder column]
                     (if (string? column)
                       (.column builder column)
                       (column builder)))
                   query-builder
                   columns))])

(defn column
  [column & {:keys [as]}]
  [:what (fn column-query [^Select$Selection query-builder]
           (let [c (.column query-builder (name column))]
             (if as
               (.as c as)
               c)))])

(defn where
  [m]
  [:where
   (fn where-query [^Select query-builder]
     (build-where m (.where query-builder)))])

(defn order-by
  [& orderings]
  [:order
   (fn order-by-query [^Select$Where query-builder]
     (.orderBy query-builder (into-array orderings)))])

(defn limit
  [lim]
  [:limit
   (fn order-by-query [^Select  query-builder]
     (.limit query-builder lim))])

(defn allow-filtering
  []
  [:filtering
   (fn order-by-query [^Select  query-builder]
     (.allowFiltering query-builder))])

(defn- from
  [^String table-name]
  [:from (fn from-query [^Select$Selection query-builder]
           (.from query-builder (name table-name))
           )])

(defn- complete-select-query
  [statements]
  (let [query-map (into {} statements)]
    (if (nil? (:what query-map))
      (conj query-map
            [:what (all)])
      statements)))

(defn select
  [table-name & statements]
  (->> (conj statements (from (name table-name)))
       (complete-select-query)
       (sort-by #(get select-order (first %)))
       ;; (map println)
       (map second)
       (reduce (fn [builder statement]
                 (println builder statement)
                 (statement builder))
               (QueryBuilder/select)
               )
       (.toString)
       ))

;; Select.Builder select(String... columns)
;; Select.Selection select()
;; Insert insertInto(String table)
;; Insert insertInto(String keyspace, String table)
;; Insert insertInto(TableMetadata table)
;; Update update(String table)
;; Update update(String keyspace, String table)
;; Update update(TableMetadata table)
;; Delete.Builder delete(String... columns)
;; Delete.Selection delete()
;; Batch batch(RegularStatement... statements)
;; Batch unloggedBatch(RegularStatement... statements)
;; Truncate truncate(String table)
;; Truncate truncate(String keyspace, String table)
;; Truncate truncate(TableMetadata table)
;; String quote(String columnName)
;; Using timestamp(long timestamp)
;; Using timestamp(BindMarker marker)
;; Assignment set(String name, Object value)
;; Assignment incr(String name)
;; Assignment incr(String name, long value)
;; Assignment incr(String name, BindMarker value)
;; Assignment decr(String name)
;; Assignment decr(String name, long value)
;; Assignment decr(String name, BindMarker value)
;; Assignment prepend(String name, Object value)
;; Assignment prependAll(String name, List<?> list)
;; Assignment prependAll(String name, BindMarker list)
;; Assignment append(String name, Object value)
;; Assignment appendAll(String name, List<?> list)
;; Assignment appendAll(String name, BindMarker list)
;; Assignment discard(String name, Object value)
;; Assignment discardAll(String name, List<?> list)
;; Assignment discardAll(String name, BindMarker list)
;; Assignment setIdx(String name, int idx, Object value)
;; Assignment add(String name, Object value)
;; Assignment addAll(String name, Set<?> set)
;; Assignment addAll(String name, BindMarker set)
;; Assignment remove(String name, Object value)
;; Assignment removeAll(String name, Set<?> set)
;; Assignment removeAll(String name, BindMarker set)
;; Assignment put(String name, Object key, Object value)
;; Assignment putAll(String name, Map<?, ?> map)
;; Assignment putAll(String name, BindMarker map)
;; Object raw(String str)
;;
;;

Reduce scope of some vars

Reduce scope of some vars