(ns braid.client.ui.styles.mixins
  (:require
    [garden.arithmetic :as m]
    [garden.units :refer [px em]]
    [braid.client.ui.styles.vars :as vars]))

(def flex
  {:display #{:flex :-webkit-flex}})

(defn mini-text []
  {:font-size (em 0.75)
   :text-transform "uppercase"
    :letter-spacing (em 0.1)})

(def pill-box
  [:&
   {:display "inline-block"
    :padding [[0 (em 0.5)]]
    :border-radius (em 0.5)
    :background-color "#222"
    :border [[(px 1) "solid" "#222"]]
    :height (em 1.75)
    :line-height (em 1.75)
    :max-width (em 10)
    :white-space "nowrap"
    :overflow "hidden"
    :color "white"
    :vertical-align "middle"
    :cursor "pointer"
    :text-decoration "none"
    :text-align "center"
    :outline "none"}
   (mini-text)
  [:&.on
   {:color [["white" "!important"]]}]
  [:&.off
   {:background-color [["white" "!important"]]}]])

(def pill-button
  [:&
   pill-box
   [:&
    {:color "#888"
     :border [[(px 1) "solid" "#BBB"]]
     :background "none"}]

   [:&:hover
    {:color "#EEE"
     :background "#888"
     :border-color "#888"
     :cursor "pointer"}]

   [:&:active
    {:color "#EEE"
     :background "#666"
     :border-color "#666"
     :cursor "pointer"}]])

(defn outline-button [{:keys [text-color border-color
                              hover-text-color hover-border-color]}]
  [:&
   {:display "inline-block"
    :background "none"
    :border-radius "0.25em"
    :border [["1px" "solid" border-color]]
    :text-decoration "none"
    :color text-color
    :padding [[0 (em 0.25)]]
    :line-height "1.5em"
    :height "1.5em"
    :white-space "nowrap"
    :cursor "pointer"
    :text-align "center"}
   [:&:hover
    {:color hover-text-color
     :border-color hover-border-color}]])

(defn fontawesome [unicode]
  {:font-family "fontawesome"
   :content (str "\"" unicode "\"")})

(def spin
  {:animation [["anim-spin" "1s" "infinite" "steps(8)"]]
   :display "block"})

(defn box-shadow []
  {:box-shadow [[0 (px 1) (px 2) 0 "#ccc"]]})

(defn context-menu []
  [:&
   {:background "white"
    :border-radius vars/border-radius}
   (box-shadow)

   [:.content
    {:overflow-x "scroll"
     :height "100%"
     :box-sizing "border-box"
     :padding [[(m/* vars/pad 0.75)]]}]

   ; triangle
   [:&:before
    (fontawesome \uf0d8)
    {:position "absolute"
     :top "-0.65em"
     :right (m/* vars/pad 0.70)
     :color "white"
     :font-size "1.5em"}]])

(ns braid.client.ui.styles.mixins
  (:require
    [garden.arithmetic :as m]
    [garden.units :refer [px em]]
    [braid.client.ui.styles.vars :as vars]))

(def flex
  {:display #{:flex :-webkit-flex}})

(defn mini-text []
  {:font-size (em 0.75)
   :text-transform "uppercase"
    :letter-spacing (em 0.1)})

(def pill-box
  [:&
   {:display "inline-block"
    :padding [[0 (em 0.5)]]
    :border-radius (em 0.5)
    :background-color "#222"
    :border [[(px 1) "solid" "#222"]]
    :height (em 1.75)
    :line-height (em 1.75)
    :max-width (em 10)
    :white-space "nowrap"
    :overflow "hidden"
    :color "white"
    :vertical-align "middle"
    :cursor "pointer"
    :text-decoration "none"
    :text-align "center"
    :outline "none"}
   (mini-text)

  [:&.on
   {:color [["white" "!important"]]}]

  [:&.off
   {:background-color [["white" "!important"]]}]])

(def pill-button
  [:&
   pill-box

   [:&
    {:color "#888"
     :border [[(px 1) "solid" "#BBB"]]
     :background "none"}]

   [:&:hover
    {:color "#EEE"
     :background "#888"
     :border-color "#888"
     :cursor "pointer"}]

   [:&:active
    {:color "#EEE"
     :background "#666"
     :border-color "#666"
     :cursor "pointer"}]])

(defn outline-button [{:keys [text-color border-color
                              hover-text-color hover-border-color]}]
  [:&
   {:display "inline-block"
    :background "none"
    :border-radius "0.25em"
    :border [["1px" "solid" border-color]]
    :text-decoration "none"
    :color text-color
    :padding [[0 (em 0.25)]]
    :line-height "1.5em"
    :height "1.5em"
    :white-space "nowrap"
    :cursor "pointer"
    :text-align "center"}

   [:&:hover
    {:color hover-text-color
     :border-color hover-border-color}]])

(defn fontawesome [unicode]
  {:font-family "fontawesome"
   :content (str "\"" unicode "\"")})

(def spin
  {:animation [["anim-spin" "1s" "infinite" "steps(8)"]]
   :display "block"})

(defn box-shadow []
  {:box-shadow [[0 (px 1) (px 2) 0 "#ccc"]]})

(defn context-menu []
  [:&
   {:background "white"
    :border-radius vars/border-radius}
   (box-shadow)

   [:.content
    {:overflow-x "scroll"
     :height "100%"
     :box-sizing "border-box"
     :padding [[(m/* vars/pad 0.75)]]}]

   ; triangle
   [:&::before
    (fontawesome \uf0d8)
    {:position "absolute"
     :top "-0.65em"
     :right (m/* vars/pad 0.70)
     :color "white"
     :font-size "1.5em"}]])

Fix formatting

Fix formatting


(ns chat.client.views.new-message
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om]
            [om.dom :as dom]
            [cljs.core.async :as async :refer [<! put! chan alts!]]
            [clojure.string :as string]
            [chat.client.dispatcher :refer [dispatch!]]
            [chat.client.store :as store]
            [chat.client.emoji :as emoji]
            [chat.client.views.helpers :refer [id->color debounce]])
  (:import [goog.events KeyCodes]))

(defn tee [x]
  (println x) x)

(defn fuzzy-matches?
  [s m]
  ; TODO: make this fuzzier? something like interleave with .* & re-match?
  (letfn [(normalize [s]
            (-> (.toLowerCase s) (string/replace #"\s" "")))]
    (not= -1 (.indexOf (normalize s) (normalize m)))))

(defn simple-matches?
  [m s]
  (not= -1 (.indexOf m s)))

; fn that returns results that will be shown if pattern matches
;    inputs:
;       text - current text of user's message
;       thread-id - id of the thread
;    output:
;       if no pattern matched, return nil
;       if a trigger pattern was matched, an array of maps, each containing:
;         :html - fn that returns html to be displayed for the result
;             inputs:
;                 none
;             output:
;                 html (as returned by (dom/*) functions)
;         :action - fn to be triggered when result picked
;             inputs:
;                 thread-id
;             output:
;                 none expected
;         :message-transform - fn to apply to text of message
;             inputs:
;                text
;             output:
;                text to replace message with

(defn emoji-view [emoji owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className "emoji-match"}
        (emoji/shortcode->html emoji)
        (dom/div #js {:className "name"}
          emoji)
        (dom/div #js {:className "extra"}
          "...")))))

(def engines
  [
   ; ... :emoji  -> autocomplete emoji
   (fn [text thread-id]
     (let [pattern #"\B:(\S{2,})$"]
       (when-let [query (second (re-find pattern text))]
         (->> emoji/unicode
              (filter (fn [[k v]]
                        (simple-matches? k query)))
              (map (fn [[k v]]
                     {:action
                      (fn [thread-id])
                      :message-transform
                      (fn [text]
                        (string/replace text pattern (str k " ")))
                      :html
                      (fn []
                        (om/build emoji-view k {:react-key k}))}))))))

   ; ... @<user>  -> autocompletes user name
   (fn [text thread-id]
     (let [pattern #"\B@(\S{0,})$"]
       (when-let [query (second (re-find pattern text))]
         (->> (store/users-in-open-group)
              (filter (fn [u]
                        (fuzzy-matches? (u :nickname) query)))
              (map (fn [user]
                     {:action
                      (fn [thread-id])
                      :message-transform
                      (fn [text]
                        (string/replace text pattern (str "@" (user :nickname) " ")))
                      :html
                      (fn []
                        (dom/div #js {:className "user-match"}
                          (dom/img #js {:className "avatar"
                                        :src (user :avatar)})
                          (dom/div #js {:className "name"}
                            (user :nickname))
                          (dom/div #js {:className "extra"}
                            "...")))}))))))

   ; ... #<tag>   -> autocompletes tag
   (fn [text thread-id]
     (let [pattern #"\B#(\S{0,})$"]
       (when-let [query (second (re-find pattern text))]
         (->> (store/tags-in-open-group)
              (filter (fn [t]
                        (fuzzy-matches? (t :name) query)))
              (map (fn [tag]
                     {:action
                      (fn [thread-id])
                      :message-transform
                      (fn [text]
                        (string/replace text pattern (str "#" (tag :name) " ")))
                      :html
                      (fn []
                        (dom/div #js {:className "tag-match"}
                          (dom/div #js {:className "color-block"
                                        :style #js {:backgroundColor (id->color (tag :id))}})
                          (dom/div #js {:className "name"}
                            (tag :name))
                          (dom/div #js {:className "extra"}
                            (:name (store/id->group (tag :group-id))))))}))))))
   ])

(defn- auto-resize [el]
  (set! (.. el -style -height) "auto")
  (set! (.. el -style -height)
        (str (min 300 (.-scrollHeight el)) "px")))

(defn new-message-view [config owner]
  (reify
    om/IInitState
    (init-state [_]
      {:text ""
       :force-close? false
       :highlighted-result-index -1
       :results nil
       :kill-chan (chan)
       :autocomplete-chan (chan)
       })

    om/IWillMount
    (will-mount [_]
      (let [autocomplete (debounce (om/get-state owner :autocomplete-chan) 200)
            kill-chan (om/get-state owner :kill-chan)]
        (go (loop []
              (let [[v ch] (alts! [autocomplete kill-chan])]
                (when (= ch autocomplete)
                  (om/set-state! owner :results
                                 (seq (mapcat (fn [e] (e v (config :thread-id))) engines)))
                  (recur)))))))

    om/IDidMount
    (did-mount [_]
      (when (= (config :thread-id) (store/get-new-thread))
        (store/clear-new-thread!)
        (.focus (om/get-node owner "message-text")))
      (let [textarea (om/get-node owner "message-text")]
        (auto-resize textarea)
        (.. js/window (addEventListener "resize" (fn [_] (auto-resize textarea))))))

    om/IWillUnmount
    (will-unmount [_]
      (put! (om/get-state owner :kill-chan) (js/Date.)))

    om/IWillUpdate
    (will-update [_ next-props next-state]
      (let [next-text (next-state :text)
              prev-text (om/get-render-state owner :text)]
          (when (not= next-text prev-text)
            (put! (next-state :autocomplete-chan) next-text))))

    om/IDidUpdate
    (did-update [_ _ _]
      (auto-resize (om/get-node owner "message-text")))

    om/IRenderState
    (render-state [_ {:keys [results text force-close? highlighted-result-index] :as state}]
      (let [constrain (fn [x a z] (Math/min z (Math/max a x)))
            highlight-next!
            (fn []
              (om/update-state! owner :highlighted-result-index
                                #(constrain (inc %) 0 (dec (count results)))))
            highlight-prev!
            (fn []
              (om/update-state! owner :highlighted-result-index
                                #(constrain (dec %) 0 (dec (count results)))))
            highlight-clear!
            (fn []
              (om/set-state! owner :highlighted-result-index -1))
            close-autocomplete!
            (fn []
              (highlight-clear!))
            reset-state!
            (fn []
              (om/update-state! owner
                             (fn [s]
                               (merge s
                                      {:text ""
                                       :force-close? false
                                       :highlighted-result-index -1}))))
            send-message!
            (fn []
              (store/set-new-thread! (config :thread-id))
              (dispatch! :new-message {:thread-id (config :thread-id)
                                       :content text
                                       :mentioned-user-ids (config :mentioned-user-ids)
                                       :mentioned-tag-ids (config :mentioned-tag-ids)})
              (reset-state!))
            choose-result!
            (fn [result]
              ((result :action) (config :thread-id))
              (om/set-state! owner :text ((result :message-transform) text))
              (close-autocomplete!))
            autocomplete-open? (and (not force-close?) (not (nil? results)))]
          (dom/div #js {:className "message new"}
            (dom/textarea #js {:placeholder (config :placeholder)
                               :ref "message-text"
                               :value (state :text)
                               :onChange (fn [e]
                                           (let [text (.slice (.. e -target -value) 0 5000)]
                                             (om/update-state! owner
                                                               (fn [s]
                                                                 (assoc s
                                                                   :text text
                                                                   :force-close? false))))
                                           (auto-resize (.. e -target)))
                               :onKeyDown
                               (fn [e]
                                 (condp = e.keyCode
                                   KeyCodes.ENTER
                                   (cond
                                     ; ENTER when autocomplete -> trigger chosen result's action (or exit autocomplete if no result chosen)
                                     autocomplete-open?
                                     (do
                                       (.preventDefault e)
                                       (if-let [result (nth results highlighted-result-index nil)]
                                         (choose-result! result)
                                         (do
                                           (close-autocomplete!)
                                           (om/set-state! owner :force-close? true))))
                                     ; ENTER otherwise -> send message
                                     (not e.shiftKey)
                                     (do
                                       (.preventDefault e)
                                       (send-message!)))

                                   KeyCodes.ESC (do
                                                  (om/set-state! owner :force-close? true)
                                                  (close-autocomplete!))

                                   KeyCodes.UP (when autocomplete-open?
                                                 (.preventDefault e)
                                                 (highlight-prev!))

                                   KeyCodes.DOWN (when autocomplete-open?
                                                   (.preventDefault e)
                                                   (highlight-next!))
                                   (when (KeyCodes.isTextModifyingKeyEvent e)
                                     ; don't clear if a modifier key alone was pressed
                                     (highlight-clear!))))})

            (when autocomplete-open?
              (dom/div #js {:className "autocomplete"}
                (if (seq results)
                  (apply dom/div nil
                    (map-indexed
                      (fn [i result]
                        (dom/div #js {:className (str "result" " "
                                                      (when (= i highlighted-result-index) "highlight"))
                                      :style #js {:cursor "pointer"}
                                      :onClick (fn []
                                                 (choose-result! result)
                                                 (.focus (om/get-node owner "message-text")))}
                          ((result :html))))
                      results))
                  (dom/div #js {:className "result"}
                    "No Results")))))))))

(ns chat.client.views.new-message
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om]
            [om.dom :as dom]
            [cljs.core.async :as async :refer [<! put! chan alts!]]
            [clojure.string :as string]
            [chat.client.dispatcher :refer [dispatch!]]
            [chat.client.store :as store]
            [chat.client.emoji :as emoji]
            [chat.client.views.helpers :refer [id->color debounce]])
  (:import [goog.events KeyCodes]))

(defn tee [x]
  (println x) x)

(defn fuzzy-matches?
  [s m]
  ; TODO: make this fuzzier? something like interleave with .* & re-match?
  (letfn [(normalize [s]
            (-> (.toLowerCase s) (string/replace #"\s" "")))]
    (not= -1 (.indexOf (normalize s) (normalize m)))))

(defn simple-matches?
  [m s]
  (not= -1 (.indexOf m s)))

; fn that returns results that will be shown if pattern matches
;    inputs:
;       text - current text of user's message
;       thread-id - id of the thread
;    output:
;       if no pattern matched, return nil
;       if a trigger pattern was matched, an array of maps, each containing:
;         :html - fn that returns html to be displayed for the result
;             inputs:
;                 none
;             output:
;                 html (as returned by (dom/*) functions)
;         :action - fn to be triggered when result picked
;             inputs:
;                 thread-id
;             output:
;                 none expected
;         :message-transform - fn to apply to text of message
;             inputs:
;                text
;             output:
;                text to replace message with

(defn emoji-view [emoji owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className "emoji-match"}
        (emoji/shortcode->html emoji)
        (dom/div #js {:className "name"}
          emoji)
        (dom/div #js {:className "extra"}
          "...")))))

(def engines
  [
   ; ... :emoji  -> autocomplete emoji
   (fn [text thread-id]
     (let [pattern #"\B:(\S{2,})$"]
       (when-let [query (second (re-find pattern text))]
         (->> emoji/unicode
              (filter (fn [[k v]]
                        (simple-matches? k query)))
              (map (fn [[k v]]
                     {:action
                      (fn [thread-id])
                      :message-transform
                      (fn [text]
                        (string/replace text pattern (str k " ")))
                      :html
                      (fn []
                        (om/build emoji-view k {:react-key k}))}))))))

   ; ... @<user>  -> autocompletes user name
   (fn [text thread-id]
     (let [pattern #"\B@(\S{0,})$"]
       (when-let [query (second (re-find pattern text))]
         (->> (store/users-in-open-group)
              (filter (fn [u]
                        (fuzzy-matches? (u :nickname) query)))
              (map (fn [user]
                     {:action
                      (fn [thread-id])
                      :message-transform
                      (fn [text]
                        (string/replace text pattern (str "@" (user :nickname) " ")))
                      :html
                      (fn []
                        (dom/div #js {:className "user-match"}
                          (dom/img #js {:className "avatar"
                                        :src (user :avatar)})
                          (dom/div #js {:className "name"}
                            (user :nickname))
                          (dom/div #js {:className "extra"}
                            "...")))}))))))

   ; ... #<tag>   -> autocompletes tag
   (fn [text thread-id]
     (let [pattern #"\B#(\S{0,})$"]
       (when-let [query (second (re-find pattern text))]
         (->> (store/tags-in-open-group)
              (filter (fn [t]
                        (fuzzy-matches? (t :name) query)))
              (map (fn [tag]
                     {:action
                      (fn [thread-id])
                      :message-transform
                      (fn [text]
                        (string/replace text pattern (str "#" (tag :name) " ")))
                      :html
                      (fn []
                        (dom/div #js {:className "tag-match"}
                          (dom/div #js {:className "color-block"
                                        :style #js {:backgroundColor (id->color (tag :id))}})
                          (dom/div #js {:className "name"}
                            (tag :name))
                          (dom/div #js {:className "extra"}
                            (:name (store/id->group (tag :group-id))))))}))))))
   ])

(defn- auto-resize [el]
  (set! (.. el -style -height) "auto")
  (set! (.. el -style -height)
        (str (min 300 (.-scrollHeight el)) "px")))

(defn new-message-view [config owner]
  (reify
    om/IInitState
    (init-state [_]
      {:text ""
       :force-close? false
       :highlighted-result-index -1
       :results nil
       :kill-chan (chan)
       :autocomplete-chan (chan)
       })

    om/IWillMount
    (will-mount [_]
      (let [autocomplete (debounce (om/get-state owner :autocomplete-chan) 200)
            kill-chan (om/get-state owner :kill-chan)]
        (go (loop []
              (let [[v ch] (alts! [autocomplete kill-chan])]
                (when (= ch autocomplete)
                  (om/set-state! owner :results
                                 (seq (mapcat (fn [e] (e v (config :thread-id))) engines)))
                  (recur)))))))

    om/IDidMount
    (did-mount [_]
      (when (= (config :thread-id) (store/get-new-thread))
        (store/clear-new-thread!)
        (.focus (om/get-node owner "message-text")))
      (let [textarea (om/get-node owner "message-text")]
        (auto-resize textarea)
        (.. js/window (addEventListener "resize" (fn [_] (auto-resize textarea))))))

    om/IWillUnmount
    (will-unmount [_]
      (put! (om/get-state owner :kill-chan) (js/Date.)))

    om/IWillUpdate
    (will-update [_ next-props next-state]
      (let [next-text (next-state :text)
              prev-text (om/get-render-state owner :text)]
          (when (not= next-text prev-text)
            (put! (next-state :autocomplete-chan) next-text))))

    om/IDidUpdate
    (did-update [_ _ _]
      (auto-resize (om/get-node owner "message-text")))

    om/IRenderState
    (render-state [_ {:keys [results text force-close? highlighted-result-index] :as state}]
      (let [highlight-next!
            (fn []
              (om/update-state! owner :highlighted-result-index
                                #(mod (inc %) (count results))))
            highlight-prev!
            (fn []
              (om/update-state! owner :highlighted-result-index
                                #(mod (dec %) (count results))))
            highlight-clear!
            (fn []
              (om/set-state! owner :highlighted-result-index -1))
            close-autocomplete!
            (fn []
              (highlight-clear!))
            reset-state!
            (fn []
              (om/update-state! owner
                             (fn [s]
                               (merge s
                                      {:text ""
                                       :force-close? false
                                       :highlighted-result-index -1}))))
            send-message!
            (fn []
              (store/set-new-thread! (config :thread-id))
              (dispatch! :new-message {:thread-id (config :thread-id)
                                       :content text
                                       :mentioned-user-ids (config :mentioned-user-ids)
                                       :mentioned-tag-ids (config :mentioned-tag-ids)})
              (reset-state!))
            choose-result!
            (fn [result]
              ((result :action) (config :thread-id))
              (om/set-state! owner :text ((result :message-transform) text))
              (close-autocomplete!))
            autocomplete-open? (and (not force-close?) (not (nil? results)))]
          (dom/div #js {:className "message new"}
            (dom/textarea #js {:placeholder (config :placeholder)
                               :ref "message-text"
                               :value (state :text)
                               :onChange (fn [e]
                                           (let [text (.slice (.. e -target -value) 0 5000)]
                                             (om/update-state! owner
                                                               (fn [s]
                                                                 (assoc s
                                                                   :text text
                                                                   :force-close? false))))
                                           (auto-resize (.. e -target)))
                               :onKeyDown
                               (fn [e]
                                 (condp = e.keyCode
                                   KeyCodes.ENTER
                                   (cond
                                     ; ENTER when autocomplete -> trigger chosen result's action (or exit autocomplete if no result chosen)
                                     autocomplete-open?
                                     (do
                                       (.preventDefault e)
                                       (if-let [result (nth results highlighted-result-index nil)]
                                         (choose-result! result)
                                         (do
                                           (close-autocomplete!)
                                           (om/set-state! owner :force-close? true))))
                                     ; ENTER otherwise -> send message
                                     (not e.shiftKey)
                                     (do
                                       (.preventDefault e)
                                       (send-message!)))

                                   KeyCodes.ESC (do
                                                  (om/set-state! owner :force-close? true)
                                                  (close-autocomplete!))

                                   KeyCodes.UP (when autocomplete-open?
                                                 (.preventDefault e)
                                                 (highlight-prev!))

                                   KeyCodes.DOWN (when autocomplete-open?
                                                   (.preventDefault e)
                                                   (highlight-next!))
                                   (when (KeyCodes.isTextModifyingKeyEvent e)
                                     ; don't clear if a modifier key alone was pressed
                                     (highlight-clear!))))})

            (when autocomplete-open?
              (dom/div #js {:className "autocomplete"}
                (if (seq results)
                  (apply dom/div nil
                    (map-indexed
                      (fn [i result]
                        (dom/div #js {:className (str "result" " "
                                                      (when (= i highlighted-result-index) "highlight"))
                                      :style #js {:cursor "pointer"}
                                      :onClick (fn []
                                                 (choose-result! result)
                                                 (.focus (om/get-node owner "message-text")))}
                          ((result :html))))
                      results))
                  (dom/div #js {:className "result"}
                    "No Results")))))))))

make autocomplete cycle

make autocomplete cycle


(ns com.nomistech.clojure-the-language.c-800-libraries.s-105-generative-testing.midje-gen-test
  (:require [clojure.test.check.generators :as gen]
            [midje.experimental :refer [for-all]]
            [midje.sweet :refer :all]))

(for-all
 ;; 'the-name
 "A doc string"
 [positive-num gen/s-pos-int
  int          gen/int]
 {:max-size 10
  :num-tests 15
  :seed 1510160943861}
 (fact "An integer added to a positive number is always a number?"
   (+ positive-num int) => integer?)
 #_(fact "An integer added to a positive number is always positive?"
   (+ positive-num int) => pos?))

(defn my-vals [a-map] (map second a-map))

(for-all
 [str-map (gen/map gen/keyword gen/string)]
 {:max-size 10
  :num-tests 15
  :seed 1510160943861}
 (fact "extracted keys are strings"
   (my-vals str-map) => (has every? string?))
 (when-not (empty? str-map)
   (fact "my-vals matches keys behavior"
     (my-vals str-map) => (vals str-map))))

(ns com.nomistech.clojure-the-language.c-800-libraries.s-105-generative-testing.midje-gen-test
  (:require [clojure.test.check.generators :as gen]
            [midje.experimental :refer [for-all]]
            [midje.sweet :refer :all]))

;;;; ___________________________________________________________________________
;;;; From https://github.com/marick/Midje/wiki/Generative-testing-with-for-all

(for-all "Midge generative test example #1 from Midje Wiki page"
    [positive-num gen/s-pos-int
     int          gen/int]
  {:max-size 10
   :num-tests 15
   :seed 1510160943861}
  (fact "An integer added to a positive number is always a number?"
    (+ positive-num int) => integer?)
  #_(fact "An integer added to a positive number is always positive?"
      (+ positive-num int) => pos?))

(defn my-vals [a-map] (map second a-map))

(for-all "Midge generative test example #2 from Midje Wiki page"
    [str-map (gen/map gen/keyword gen/string)]
  {:max-size 10
   :num-tests 15
   :seed 1510160943861}
  (fact "extracted keys are strings"
    (my-vals str-map) => (has every? string?))
  (when-not (empty? str-map)
    (fact "my-vals matches keys behavior"
      (my-vals str-map) => (vals str-map))))

Improve `for-all` examples

Improve `for-all` examples


(ns salava.profile.ui.routes
  (:require [salava.core.ui.layout]
            [salava.core.ui.helper :refer [base-path]]
            [salava.user.ui.profile :as profile]
            [salava.core.i18n :as i18n :refer [t]]
            [salava.page.ui.my :as page]
            [salava.profile.ui.block :as block]
            [salava.profile.ui.profile :as p]
            [salava.profile.ui.edit :as pe]
            [salava.profile.ui.modal :as m]))

(defn ^:export routes [context]
  {(str (base-path context) "/profile") [[["/" [#"\d+" :user-id]] p/handler]]
   (str (base-path context) "/page") [[["/mypages" page/handler]]]})

(defn ^:export navi [context]
  {(str (base-path context) "/profile/\\d+")  {:breadcrumb (t :user/User " / " :user/Profile)}
   (str (base-path context) "/profile/" (get-in context [:user :id])) {:weight 30 :title (t :user/Profile) :top-navi true :site-navi true :breadcrumb (str (t :user/Profile) " / " (get-in context [:user :first_name]) " " (get-in context [:user :last_name]))}})

(ns salava.profile.ui.routes
  (:require [salava.core.ui.layout]
            [salava.core.ui.helper :refer [base-path]]
            [salava.user.ui.profile :as profile]
            [salava.core.i18n :as i18n :refer [t]]
            [salava.page.ui.my :as page]
            [salava.profile.ui.block :as block]
            [salava.profile.ui.profile :as p]
            [salava.profile.ui.embed :as embed]
            [salava.profile.ui.edit :as pe]
            [salava.profile.ui.modal :as m]))

(defn ^:export routes [context]
  {(str (base-path context) "/profile") [[["/" [#"\d+" :user-id]] p/handler]
                                         [["/" [#"\d+" :user-id] "/embed"] embed/handler]]
   (str (base-path context) "/page") [[["/mypages" page/handler]]]})

(defn ^:export navi [context]
  {(str (base-path context) "/profile/\\d+")  {:breadcrumb (t :user/User " / " :user/Profile)}
   (str (base-path context) "/profile/" (get-in context [:user :id])) {:weight 30 :title (t :user/Profile) :top-navi true :site-navi true :breadcrumb (str (t :user/Profile) " / " (get-in context [:user :first_name]) " " (get-in context [:user :last_name]))}})

embed profile

embed profile


;;
;; Author:: Adam Jacob (<adam@opscode.com>)
;; Author:: Christopher Brown (<cb@opscode.com>)
;; Copyright:: Copyright (c) 2010 Opscode, Inc.
;; License:: Apache License, Version 2.0
;;
;; 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.
;;

(software "chef-server" :source "chef"
          :steps [{:command "/opt/opscode/embedded/bin/gem"
                   :args ["install" "chef-server" "-n" "/opt/opscode/bin"
                          "--no-rdoc" "--no-ri"
                          "--" "--with-xml2-include=/opt/opscode/embedded/include/libxml2"
                          "--with-xml2-lib=/opt/opscode/embedded/lib"]}
                  {:command "chown"
                   :args ["-R" (cond
                                (is-os? "darwin")
                                "root:wheel"
                                true "root:root") "/opt/opscode"]}])

;;
;; Author:: Adam Jacob (<adam@opscode.com>)
;; Author:: Christopher Brown (<cb@opscode.com>)
;; Copyright:: Copyright (c) 2010 Opscode, Inc.
;; License:: Apache License, Version 2.0
;;
;; 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.
;;

(software "chef-server" :source "chef"
          :steps [{:command "/opt/opscode/embedded/bin/gem"
                   :args ["install" "chef-server" "-n" "/opt/opscode/bin"
                          "--no-rdoc" "--no-ri"
                          "--" "--with-xml2-include=/opt/opscode/embedded/include/libxml2"
                          "--with-xml2-lib=/opt/opscode/embedded/lib"]}
                  {:command "/opt/opscode/embedded/bin/gem"
                   :args ["install" "merb-core" "merb-assets" "merb-helpers" "merb-param-protection"                                                              ;; base common
                          "mixlib-authentication" "dep_selector" "uuidtools" "thin" "json" "treetop"                                                              ;; + chef-server-api
                          "merb-haml" "haml" "ruby-openid" "coderay"                                                                                ;; + chef-server-webui
                          "mixlib-log" "amqp" "eventmachine" "em-http-request" "yajl-ruby" "bunny" "fast_xs"                                                      ;; + chef-expander
                          "-n" "/opt/opscode/bin"
                          "--no-rdoc" "--no-ri"
                          "--" "--with-xml2-include=/opt/opscode/embedded/include/libxml2"
                          "--with-xml2-lib=/opt/opscode/embedded/lib"]}
                  {:command "chown"
                   :args ["-R" (cond
                                (is-os? "darwin")
                                "root:wheel"
                                true "root:root") "/opt/opscode"]}])

Add 0.10 gems to chef-server

Add 0.10 gems to chef-server


(ns manners.victorian-test
  (:require [manners.victorian :refer :all]
            [clojure.test :refer :all]))

(deftest test-as-coach
  (is (= true
         (:manners.victorian/coach (meta (as-coach (constantly [])))))
      "Adds meta to returned function")
  (are [fns v] (= ((apply comp fns) v)
                  ((apply as-coach fns) v))
       [inc inc inc] 3
       [inc inc inc] 1388
       [inc dec inc] 4))

(deftest test-coach?
  (is (coach? (as-coach (constantly [])))))

(def d-msg "should start with d")
(def keyword-msg "must be a keyword")
(def d-keyword-coach
  (manners [keyword? keyword-msg]
           [(comp (partial re-find #"^d") name) d-msg]))

(deftest test-manners
  (is (= (d-keyword-coach :d) (list)))
  (is (= (d-keyword-coach :a) (list d-msg)))
  (is (= (d-keyword-coach "a") (list keyword-msg d-msg)))
  (is (= (d-keyword-coach "d") (list keyword-msg)))
  (testing "idempotence"
    (let [d-keyword-coach2 (manners (manners (manners d-keyword-coach)))]
      (doseq [v [nil 1 'yp "erp" "derp" :derp]]
        (is (= (d-keyword-coach v)
               (d-keyword-coach2 v)))))))

(def derp-keyword-coach
  (manner d-keyword-coach
          (comp (partial = "derp") name) "name is derp"))

(deftest test-manner
  (testing "simple manner"
    (let [truthy-str-coach (manner identity "is truthy"
                                   string? "is a string")]
      (is (= (truthy-str-coach 1) (list "is a string")))
      (is (= (truthy-str-coach nil) (list "is truthy")))))
  (testing "complex manner with a coach"
    (is (= (derp-keyword-coach :derp) (list)))
    (is (= (derp-keyword-coach "derp") (list keyword-msg)))
    (is (= (derp-keyword-coach "erp")
           (list keyword-msg d-msg)))
    (is (= (derp-keyword-coach :erp) (list d-msg))))
  (testing "idempotence"
    (let [derp-keyword-coach2 (manner (manner (manner derp-keyword-coach)))]
      (doseq [v [nil 1 'yp "erp" "derp" :derp]]
        (is (= (derp-keyword-coach v)
               (derp-keyword-coach2 v)))))))

(def odd-msg "should be odd")
(def num-msg "should be a number")
(def odd-number-etq [[odd? odd-msg]
                     [number? num-msg]])
(def odd-number-coach (etiquette odd-number-etq))

(deftest test-etiquette
  (testing "always returns a sequence"
    (is (sequential? (odd-number-coach nil)))
    (is (sequential? (odd-number-coach 3737))))
  (testing "empty when all predicates pass"
    (is (empty? (odd-number-coach 3))))
  (testing "a sequence of error messages if it does not pass."
    (is (= (list odd-msg) (odd-number-coach 2)))
    (is (= (list odd-msg num-msg) (odd-number-coach nil))))
  (testing "joined manners"
    (let [nine-or-three-msg "it should be 9 or 3"
          nine-or-three-coach
          (manner odd-number-coach
                  (some-fn #(= 9 %) #(= 3 %)) nine-or-three-msg)]
      (testing "short circuits at the first matches predicate"
        (is (= (list odd-msg num-msg) (nine-or-three-coach "hey")))
        (is (= (list odd-msg) (nine-or-three-coach 2)))
        (is (= (list nine-or-three-msg) (nine-or-three-coach 5)))
        (is (= (list) (nine-or-three-coach 3)))))
    (testing "idempotence"
      (let [odd-number-coach2 (etiquette (etiquette odd-number-coach))]
        (doseq [v [nil 1 2 100 78471 :derp]]
          (is (= (odd-number-coach v)
                 (odd-number-coach2 v))))))))

(deftest test-bad-manners
  (testing "works with an empty etiquette"
    (is (= (list) (bad-manners [] nil)))
    (is (= (list) (bad-manners [[]] false))))
  (testing "finds bad-manners"
    (is (= (list odd-msg num-msg)
           (bad-manners odd-number-etq nil)))
    (is (= (list odd-msg) (bad-manners odd-number-etq 2)))
    (is (= (list) (bad-manners odd-number-etq 3)))))

(deftest test-rude?-and-proper?
  (testing "are complements"
    (is (rude? odd-number-etq 2))
    (is (not (proper? odd-number-etq 2)))
    (is (not (rude? odd-number-etq 1)))
    (is (proper? odd-number-etq 1))))

(deftest test-avow
  (testing "throws an error when bad manners are found"
    (is (thrown? AssertionError #"it should be odd, it should be a number"
                 (avow odd-number-etq nil)))
    (is (thrown? AssertionError #"Invalid odd-number: it should be odd"
                 (avow odd-number-etq 2))))
  (testing "does nothing when no bad manners are found"
    (is (nil? (avow odd-number-etq 3)))))

;; An etiquette is a sequence of manners.
;; A manner is either a coach or a predicate message pair.
(deftest test-composable-coaches
  (let [msg1 "should be a map"
        msg2 "should contain the key :hey"
        msg3 "should have an odd number of keys"
        msg4 "should have key :barb"
        msg5 "should length 3 pairs"
        base-coach (manners [map? msg1 :barb msg4]
                            [(comp odd? count) msg3])
        etq [[base-coach :hey msg2]
             [(comp (partial = 3) count) msg5]]
        msg6 "should have key :boom"
        other-etiquette [[:boom msg6 base-coach]]]

    (testing "recognizes a proper value"
      (is (proper? etq {:barb :cats
                            :hey 'yo
                            :anything-else 3})))
    (testing "gets all parellel messages from nested coach"
      (is (= (list msg1 msg3 msg5)
             (bad-manners etq [1 2]))))
    (testing "can get to extended messages if base coach passes"
      (is (= (list msg2 msg5)
             (bad-manners etq {:barb :yo}))))
    (testing "ignores base coach messages unless previous coach in manner passes"
      (is (= (list msg6)
             (bad-manners other-etiquette {:bam 1})))
      (is (= (list msg4)
             (bad-manners other-etiquette {:boom 2})))
      (is (= (list msg4 msg3)
             (bad-manners other-etiquette {:boom 2 :bam 4}))))))

(defmacro catch-message [& body]
  `(try
    ~@body
     (catch AssertionError e#
       (.getMessage e#))))

(deftest test-defmannerisms
  (defmannerisms odd-number odd-number-etq)
  (doseq [v [nil 1 {} 2 "3"]]
    (doseq [[pfunc func] [[proper-odd-number? proper?]
                          [rude-odd-number? rude?]
                          [bad-odd-number-manners bad-manners]]]
      (is (= (pfunc v) (func odd-number-etq v))))
    (is (= (catch-message (avow 'odd-number odd-number-etq v))
           (catch-message (avow-odd-number v))))))

#_(run-tests)

(ns manners.victorian-test
  (:require [manners.victorian :refer :all]
            [clojure.test :refer :all]))

(deftest test-as-coach
  (is (= true
         (:manners.victorian/coach (meta (as-coach (constantly [])))))
      "Adds meta to returned function")
  (are [fns v] (= ((apply comp fns) v)
                  ((apply as-coach fns) v))
       [inc inc inc] 3
       [inc inc inc] 1388
       [inc dec inc] 4))

(deftest test-coach?
  (is (coach? (as-coach (constantly [])))))

(def d-msg "should start with d")
(def keyword-msg "must be a keyword")
(def d-keyword-coach
  (manners [keyword? keyword-msg]
           [(comp (partial re-find #"^d") name) d-msg]))

(deftest test-manners
  (is (= (d-keyword-coach :d) (list)))
  (is (= (d-keyword-coach :a) (list d-msg)))
  (is (= (d-keyword-coach "a") (list keyword-msg d-msg)))
  (is (= (d-keyword-coach "d") (list keyword-msg)))
  (testing "idempotence"
    (let [d-keyword-coach2 (manners (manners (manners d-keyword-coach)))]
      (doseq [v [nil 1 'yp "erp" "derp" :derp]]
        (is (= (d-keyword-coach v)
               (d-keyword-coach2 v)))))))

(def derp-keyword-coach
  (manner d-keyword-coach
          (comp (partial = "derp") name) "name is derp"))

(deftest test-manner
  (testing "simple manner"
    (let [truthy-str-coach (manner identity "is truthy"
                                   string? "is a string")]
      (is (= (truthy-str-coach 1) (list "is a string")))
      (is (= (truthy-str-coach nil) (list "is truthy")))))
  (testing "complex manner with a coach"
    (is (= (derp-keyword-coach :derp) (list)))
    (is (= (derp-keyword-coach "derp") (list keyword-msg)))
    (is (= (derp-keyword-coach "erp")
           (list keyword-msg d-msg)))
    (is (= (derp-keyword-coach :erp) (list d-msg))))
  (testing "idempotence"
    (let [derp-keyword-coach2 (manner (manner (manner derp-keyword-coach)))]
      (doseq [v [nil 1 'yp "erp" "derp" :derp]]
        (is (= (derp-keyword-coach v)
               (derp-keyword-coach2 v)))))))

(def odd-msg "should be odd")
(def num-msg "should be a number")
(def odd-number-etq [[odd? odd-msg]
                     [number? num-msg]])
(def odd-number-coach (etiquette odd-number-etq))

(deftest test-etiquette
  (testing "always returns a sequence"
    (is (sequential? (odd-number-coach nil)))
    (is (sequential? (odd-number-coach 3737))))
  (testing "empty when all predicates pass"
    (is (empty? (odd-number-coach 3))))
  (testing "a sequence of error messages if it does not pass."
    (is (= (list odd-msg) (odd-number-coach 2)))
    (is (= (list odd-msg num-msg) (odd-number-coach nil))))
  (testing "joined manners"
    (let [nine-or-three-msg "it should be 9 or 3"
          nine-or-three-coach
          (manner odd-number-coach
                  (some-fn #(= 9 %) #(= 3 %)) nine-or-three-msg)]
      (testing "short circuits at the first matches predicate"
        (is (= (list odd-msg num-msg) (nine-or-three-coach "hey")))
        (is (= (list odd-msg) (nine-or-three-coach 2)))
        (is (= (list nine-or-three-msg) (nine-or-three-coach 5)))
        (is (= (list) (nine-or-three-coach 3)))))
    (testing "idempotence"
      (let [odd-number-coach2 (etiquette (etiquette odd-number-coach))]
        (doseq [v [nil 1 2 100 78471 :derp]]
          (is (= (odd-number-coach v)
                 (odd-number-coach2 v))))))))

(deftest test-bad-manners
  (testing "works with an empty etiquette"
    (is (= (list) (bad-manners [] nil)))
    (is (= (list) (bad-manners [[]] false))))
  (testing "finds bad-manners"
    (is (= (list odd-msg num-msg)
           (bad-manners odd-number-etq nil)))
    (is (= (list odd-msg) (bad-manners odd-number-etq 2)))
    (is (= (list) (bad-manners odd-number-etq 3)))))

(deftest test-rude?-and-proper?
  (testing "are complements"
    (is (rude? odd-number-etq 2))
    (is (not (proper? odd-number-etq 2)))
    (is (not (rude? odd-number-etq 1)))
    (is (proper? odd-number-etq 1))))

(deftest test-avow
  (testing "throws an error when bad manners are found"
    (is (thrown? AssertionError #"it should be odd, it should be a number"
                 (avow odd-number-etq nil)))
    (is (thrown? AssertionError #"Invalid odd-number: it should be odd"
                 (avow odd-number-etq 2))))
  (testing "does nothing when no bad manners are found"
    (is (nil? (avow odd-number-etq 3)))))

;; An etiquette is a sequence of manners.
;; A manner is either a coach or a predicate message pair.
(deftest test-composable-coaches
  (let [msg1 "should be a map"
        msg2 "should contain the key :hey"
        msg3 "should have an odd number of keys"
        msg4 "should have key :barb"
        msg5 "should length 3 pairs"
        base-coach (manners [map? msg1 :barb msg4]
                            [(comp odd? count) msg3])
        etq [[base-coach :hey msg2]
             [(comp (partial = 3) count) msg5]]
        msg6 "should have key :boom"
        other-etiquette [[:boom msg6 base-coach]]]

    (testing "recognizes a proper value"
      (is (proper? etq {:barb :cats
                        :hey 'yo
                        :anything-else 3})))
    (testing "gets all parallel messages from nested coach"
      (is (= (list msg1 msg3 msg5)
             (bad-manners etq [1 2]))))
    (testing "can get to extended messages if base coach passes"
      (is (= (list msg2 msg5)
             (bad-manners etq {:barb :yo}))))
    (testing "ignores base coach messages unless previous coach in manner passes"
      (is (= (list msg6)
             (bad-manners other-etiquette {:bam 1})))
      (is (= (list msg4)
             (bad-manners other-etiquette {:boom 2})))
      (is (= (list msg4 msg3)
             (bad-manners other-etiquette {:boom 2 :bam 4}))))))

(defmacro catch-message [& body]
  `(try
     ~@body
     (catch AssertionError e#
       (.getMessage e#))))

(deftest test-defmannerisms
  (defmannerisms odd-number odd-number-etq)
  (doseq [v [nil 1 {} 2 "3"]]
    (doseq [[pfunc func] [[proper-odd-number? proper?]
                          [rude-odd-number? rude?]
                          [bad-odd-number-manners bad-manners]]]
      (is (= (pfunc v) (func odd-number-etq v))))
    (is (= (catch-message (avow 'odd-number odd-number-etq v))
           (catch-message (avow-odd-number v))))))

#_(run-tests)

Fix indentation in manners.victorian-test.


(ns metabase.api.card-test
  "Tests for /api/card endpoints."
  (:require [expectations :refer :all]
            [metabase.db :refer :all]
            [metabase.http-client :refer :all]
            [metabase.driver.query-processor.expand :as ql]
            (metabase.models [card :refer [Card]]
                             [card-favorite :refer [CardFavorite]]
                             [card-label :refer [CardLabel]]
                             [common :as common]
                             [database :refer [Database]]
                             [label :refer [Label]]
                             [table :refer [Table]]
                             [view-log :refer [ViewLog]])
            [metabase.test.data :refer :all]
            [metabase.test.data.users :refer :all]
            [metabase.test.util :refer [match-$ expect-eval-actual-first random-name with-temp with-temp* obj->json->obj expect-with-temp]]))

;; # CARD LIFECYCLE

;; ## Helper fns

;; ## GET /api/card
;; Filter cards by database
(expect
  [true
   false
   true]
  (with-temp* [Database [{db-id :id}]
               Card     [{card-1-id :id} {:database_id (id)}]
               Card     [{card-2-id :id} {:database_id db-id}]]
    (let [card-returned? (fn [database-id card-id]
                           (contains? (set (for [card ((user->client :rasta) :get 200 "card", :f :database, :model_id database-id)]
                                             (:id card)))
                                      card-id))]
      [(card-returned? (id) card-1-id)
       (card-returned? db-id card-1-id)
       (card-returned? db-id card-2-id)])))

;; Make sure `id` is required when `f` is :database
(expect {:errors {:id "id is required parameter when filter mode is 'database'"}}
  ((user->client :crowberto) :get 400 "card" :f :database))

;; Filter cards by table
(expect
  [true
   false
   true]
  (with-temp* [Database [{database-id :id}]
               Table    [{table-1-id :id} {:db_id database-id}]
               Table    [{table-2-id :id} {:db_id database-id}]
               Card     [{card-1-id :id} {:table_id table-1-id}]
               Card     [{card-2-id :id} {:table_id table-2-id}]]
    (let [card-returned? (fn [table-id card-id]
                           (contains? (set (for [card ((user->client :rasta) :get 200 "card", :f :table, :model_id table-id)]
                                             (:id card)))
                                      card-id))]
      [(card-returned? table-1-id card-1-id)
       (card-returned? table-2-id card-1-id)
       (card-returned? table-2-id card-2-id)])))

;; Make sure `id` is required when `f` is :table
(expect {:errors {:id "id is required parameter when filter mode is 'table'"}}
        ((user->client :crowberto) :get 400 "card", :f :table))

;;; Filter by `recent`
;; Should return cards that were recently viewed by current user only
(expect-with-temp [Card     [{card-1-id :id}]
                   Card     [{card-2-id :id}]
                   Card     [{card-3-id :id}]
                   Card     [{card-4-id :id}]
                   ;; 3 was viewed most recently, followed by 4, then 1. Card 2 was viewed by a different user so shouldn't be returned
                   ViewLog  [_               {:model "card", :model_id card-1-id, :user_id (user->id :rasta),     :timestamp #inst "2015-12-01"}]
                   ViewLog  [_               {:model "card", :model_id card-2-id, :user_id (user->id :trashbird), :timestamp #inst "2016-01-01"}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta),     :timestamp #inst "2016-02-01"}]
                   ViewLog  [_               {:model "card", :model_id card-4-id, :user_id (user->id :rasta),     :timestamp #inst "2016-03-01"}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta),     :timestamp #inst "2016-04-01"}]]
  [card-3-id card-4-id card-1-id]
  (mapv :id ((user->client :rasta) :get 200 "card", :f :recent)))

;;; Filter by `popular`
;; `f=popular` should return cards sorted by number of ViewLog entries for all users; cards with no entries should be excluded
(expect-with-temp [Card     [{card-1-id :id}]
                   Card     [{card-2-id :id}]
                   Card     [{card-3-id :id}]
                   ;; 3 entries for card 3, 2 for card 2, none for card 1,
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta)}]
                   ViewLog  [_               {:model "card", :model_id card-2-id, :user_id (user->id :trashbird)}]
                   ViewLog  [_               {:model "card", :model_id card-2-id, :user_id (user->id :rasta)}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :crowberto)}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta)}]]
  [card-3-id card-2-id]
  (map :id ((user->client :rasta) :get 200 "card", :f :popular)))

;;; Filter by `archived`
;; check that the set of Card IDs returned with f=archived is equal to the set of archived cards
(expect-with-temp [Card [{card-1-id :id}]
                   Card [{card-2-id :id} {:archived true}]
                   Card [{card-3-id :id} {:archived true}]]
  #{card-2-id card-3-id}
  (set (map :id ((user->client :rasta) :get 200 "card", :f :archived))))

;;; Filter by `fav`
(expect-with-temp [Card         [{card-id-1 :id}]
                   Card         [{card-id-2 :id}]
                   Card         [{card-id-3 :id}]
                   CardFavorite [_ {:card_id card-id-1, :owner_id (user->id :rasta)}]
                   CardFavorite [_ {:card_id card-id-2, :owner_id (user->id :crowberto)}]]
  [{:id card-id-1, :favorite true}]
  (for [card ((user->client :rasta) :get 200 "card", :f :fav)]
    (select-keys card [:id :favorite])))

;;; Filter by labels
(expect-with-temp [Card      [{card-1-id :id}]
                   Card      [{card-2-id :id}]
                   Label     [{label-1-id :id} {:name "Toucans"}]                           ; slug will be `toucans`
                   Label     [{label-2-id :id} {:name "More Toucans"}]                      ; slug will be `more_toucans`
                   CardLabel [_                {:card_id card-1-id, :label_id label-1-id}]
                   CardLabel [_                {:card_id card-2-id, :label_id label-2-id}]]
  ;; When filtering by `more_toucans` only the second Card should get returned
  [card-2-id]
  (map :id ((user->client :rasta) :get 200 "card", :label "more_toucans")))                 ; filtering is done by slug

;; ## POST /api/card
;; Test that we can make a card
(let [card-name (random-name)]
  (expect-with-temp [Database [{database-id :id}]
                     Table    [{table-id :id}  {:db_id database-id}]]
    {:description            nil
     :organization_id        nil
     :name                   card-name
     :creator_id             (user->id :rasta)
     :dataset_query          {:database database-id
                              :type     :query
                              :query    {:source-table table-id, :aggregation {:aggregation-type :count}}}
     :display                "scalar"
     :visualization_settings {:global {:title nil}}
     :public_perms           0
     :database_id            database-id ; these should be inferred automatically
     :table_id               table-id
     :query_type             "query"
     :archived               false}
    (dissoc ((user->client :rasta) :post 200 "card" {:name                   card-name
                                                     :public_perms           0
                                                     :can_read               true
                                                     :can_write              true
                                                     :display                "scalar"
                                                     :dataset_query          {:database database-id
                                                                              :type     :query
                                                                              :query    {:source-table table-id, :aggregation {:aggregation-type :count}}}
                                                     :visualization_settings {:global {:title nil}}})
            :created_at :updated_at :id)))

;; ## GET /api/card/:id
;; Test that we can fetch a card
(expect-with-temp [Database  [{database-id :id}]
                   Table     [{table-id :id}   {:db_id database-id}]
                   Card      [card             {:dataset_query {:database database-id
                                                                :type     :query
                                                                :query    {:source-table table-id, :aggregation {:aggregation-type :count}}}}]]
  (match-$ card
    {:description            nil
     :can_read               true
     :can_write              true
     :organization_id        nil
     :dashboard_count        0
     :name                   $
     :creator_id             (user->id :rasta)
     :creator                (match-$ (fetch-user :rasta)
                               {:common_name  "Rasta Toucan"
                                :is_superuser false
                                :is_qbnewb    true
                                :last_login   $
                                :last_name    "Toucan"
                                :first_name   "Rasta"
                                :date_joined  $
                                :email        "rasta@metabase.com"
                                :id           $})
     :updated_at             $
     :dataset_query          $
     :id                     $
     :display                "table"
     :visualization_settings {}
     :public_perms           0
     :created_at             $
     :database_id            database-id ; these should be inferred from the dataset_query
     :table_id               table-id
     :query_type             "query"
     :archived               false
     :labels                 []})
  ((user->client :rasta) :get 200 (str "card/" (:id card))))

;; ## PUT /api/card/:id
;; Test that we can edit a Card
(let [updated-name (random-name)]
  (expect-with-temp [Card [{card-id :id, original-name :name}]]
    [original-name
     updated-name]
    [(sel :one :field [Card :name] :id card-id)
     (do ((user->client :rasta) :put 200 (str "card/" card-id) {:name updated-name})
         (sel :one :field [Card :name] :id card-id))]))

(defmacro ^:private with-temp-card {:style/indent 1} [binding & body]
  `(with-temp Card ~binding
     ~@body))

;; Can we update a Card's archived status?
(expect
  [false true false]
  (with-temp-card [{:keys [id]}]
    (let [archived?     (fn [] (:archived (Card id)))
          set-archived! (fn [archived]
                          ((user->client :rasta) :put 200 (str "card/" id) {:archived archived})
                          (archived?))]
      [(archived?)
       (set-archived! true)
       (set-archived! false)])))

;; ## DELETE /api/card/:id
;; Check that we can delete a card
(expect
  nil
  (with-temp-card [{:keys [id]}]
    ((user->client :rasta) :delete 204 (str "card/" id))
    (Card id)))

;; deleting a card that doesn't exist should return a 404 (#1957)
(expect "Not found."
  ((user->client :crowberto) :delete 404 "card/12345"))

;; # CARD FAVORITE STUFF

;; Helper Functions
(defn- fave? [card]
  ((user->client :rasta) :get 200 (format "card/%d/favorite" (:id card))))

(defn- fave [card]
  ((user->client :rasta) :post 200 (format "card/%d/favorite" (:id card))))

(defn- unfave [card]
  ((user->client :rasta) :delete 204 (format "card/%d/favorite" (:id card))))

;; ## GET /api/card/:id/favorite
;; Can we see if a Card is a favorite ?
(expect
  {:favorite false}
  (with-temp-card [card]
    (fave? card)))

;; ## POST /api/card/:id/favorite
;; Can we favorite a card?
(expect
  [{:favorite false}
   {:favorite true}]
  (with-temp-card [card]
    [(fave? card)
     (do (fave card)
         (fave? card))]))

;; DELETE /api/card/:id/favorite
;; Can we unfavorite a card?
(expect
  [{:favorite false}
   {:favorite true}
   {:favorite false}]
  (with-temp-card [card]
    [(fave? card)
     (do (fave card)
         (fave? card))
     (do (unfave card)
         (fave? card))]))

;;; POST /api/card/:id/labels
;; Check that we can update card labels
(expect-with-temp [Card  [{card-id :id}]
                   Label [{label-1-id :id} {:name "Toucan-Friendly"}]
                   Label [{label-2-id :id} {:name "Toucan-Unfriendly"}]]
  [[]                                                                                ; (1) should start out with no labels
   [{:id label-1-id, :name "Toucan-Friendly",   :slug "toucan_friendly",   :icon nil}  ; (2) set a few labels
    {:id label-2-id, :name "Toucan-Unfriendly", :slug "toucan_unfriendly", :icon nil}]
   []]                                                                                ; (3) should be able to reset to no labels
  (let [get-labels    (fn []
                        (:labels ((user->client :rasta) :get 200, (str "card/" card-id))))
        update-labels (fn [label-ids]
                        ((user->client :rasta) :post 200, (format "card/%d/labels" card-id) {:label_ids label-ids})
                        (get-labels))]
    [(get-labels)                            ; (1)
     (update-labels [label-1-id label-2-id]) ; (2)
     (update-labels [])]))                   ; (3)

(ns metabase.api.card-test
  "Tests for /api/card endpoints."
  (:require [expectations :refer :all]
            [metabase.db :refer :all]
            [metabase.http-client :refer :all]
            [metabase.driver.query-processor.expand :as ql]
            (metabase.models [card :refer [Card]]
                             [card-favorite :refer [CardFavorite]]
                             [card-label :refer [CardLabel]]
                             [common :as common]
                             [database :refer [Database]]
                             [label :refer [Label]]
                             [table :refer [Table]]
                             [view-log :refer [ViewLog]])
            [metabase.test.data :refer :all]
            [metabase.test.data.users :refer :all]
            [metabase.test.util :refer [match-$ expect-eval-actual-first random-name with-temp with-temp* obj->json->obj expect-with-temp]]))

;; # CARD LIFECYCLE

;; ## Helper fns

;; ## GET /api/card
;; Filter cards by database
(expect
  [true
   false
   true]
  (with-temp* [Database [{db-id :id}]
               Card     [{card-1-id :id} {:database_id (id)}]
               Card     [{card-2-id :id} {:database_id db-id}]]
    (let [card-returned? (fn [database-id card-id]
                           (contains? (set (for [card ((user->client :rasta) :get 200 "card", :f :database, :model_id database-id)]
                                             (:id card)))
                                      card-id))]
      [(card-returned? (id) card-1-id)
       (card-returned? db-id card-1-id)
       (card-returned? db-id card-2-id)])))

;; Make sure `id` is required when `f` is :database
(expect {:errors {:id "id is required parameter when filter mode is 'database'"}}
  ((user->client :crowberto) :get 400 "card" :f :database))

;; Filter cards by table
(expect
  [true
   false
   true]
  (with-temp* [Database [{database-id :id}]
               Table    [{table-1-id :id} {:db_id database-id}]
               Table    [{table-2-id :id} {:db_id database-id}]
               Card     [{card-1-id :id} {:table_id table-1-id}]
               Card     [{card-2-id :id} {:table_id table-2-id}]]
    (let [card-returned? (fn [table-id card-id]
                           (contains? (set (for [card ((user->client :rasta) :get 200 "card", :f :table, :model_id table-id)]
                                             (:id card)))
                                      card-id))]
      [(card-returned? table-1-id card-1-id)
       (card-returned? table-2-id card-1-id)
       (card-returned? table-2-id card-2-id)])))

;; Make sure `id` is required when `f` is :table
(expect {:errors {:id "id is required parameter when filter mode is 'table'"}}
        ((user->client :crowberto) :get 400 "card", :f :table))

;;; Filter by `recent`
;; Should return cards that were recently viewed by current user only
(expect-with-temp [Card     [{card-1-id :id}]
                   Card     [{card-2-id :id}]
                   Card     [{card-3-id :id}]
                   Card     [{card-4-id :id}]
                   ;; 3 was viewed most recently, followed by 4, then 1. Card 2 was viewed by a different user so shouldn't be returned
                   ViewLog  [_               {:model "card", :model_id card-1-id, :user_id (user->id :rasta),     :timestamp #inst "2015-12-01"}]
                   ViewLog  [_               {:model "card", :model_id card-2-id, :user_id (user->id :trashbird), :timestamp #inst "2016-01-01"}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta),     :timestamp #inst "2016-02-01"}]
                   ViewLog  [_               {:model "card", :model_id card-4-id, :user_id (user->id :rasta),     :timestamp #inst "2016-03-01"}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta),     :timestamp #inst "2016-04-01"}]]
  [card-3-id card-4-id card-1-id]
  (mapv :id ((user->client :rasta) :get 200 "card", :f :recent)))

;;; Filter by `popular`
;; `f=popular` should return cards sorted by number of ViewLog entries for all users; cards with no entries should be excluded
(expect-with-temp [Card     [{card-1-id :id}]
                   Card     [{card-2-id :id}]
                   Card     [{card-3-id :id}]
                   ;; 3 entries for card 3, 2 for card 2, none for card 1,
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta)}]
                   ViewLog  [_               {:model "card", :model_id card-2-id, :user_id (user->id :trashbird)}]
                   ViewLog  [_               {:model "card", :model_id card-2-id, :user_id (user->id :rasta)}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :crowberto)}]
                   ViewLog  [_               {:model "card", :model_id card-3-id, :user_id (user->id :rasta)}]]
  [card-3-id card-2-id]
  (map :id ((user->client :rasta) :get 200 "card", :f :popular)))

;;; Filter by `archived`
;; check that the set of Card IDs returned with f=archived is equal to the set of archived cards
(expect-with-temp [Card [{card-1-id :id}]
                   Card [{card-2-id :id} {:archived true}]
                   Card [{card-3-id :id} {:archived true}]]
  #{card-2-id card-3-id}
  (set (map :id ((user->client :rasta) :get 200 "card", :f :archived))))

;;; Filter by `fav`
(expect-with-temp [Card         [{card-id-1 :id}]
                   Card         [{card-id-2 :id}]
                   Card         [{card-id-3 :id}]
                   CardFavorite [_ {:card_id card-id-1, :owner_id (user->id :rasta)}]
                   CardFavorite [_ {:card_id card-id-2, :owner_id (user->id :crowberto)}]]
  [{:id card-id-1, :favorite true}]
  (for [card ((user->client :rasta) :get 200 "card", :f :fav)]
    (select-keys card [:id :favorite])))

;;; Filter by labels
(expect-with-temp [Card      [{card-1-id :id}]
                   Card      [{card-2-id :id}]
                   Label     [{label-1-id :id} {:name "Toucans"}]                           ; slug will be `toucans`
                   Label     [{label-2-id :id} {:name "More Toucans"}]                      ; slug will be `more_toucans`
                   CardLabel [_                {:card_id card-1-id, :label_id label-1-id}]
                   CardLabel [_                {:card_id card-2-id, :label_id label-2-id}]]
  ;; When filtering by `more_toucans` only the second Card should get returned
  [card-2-id]
  (map :id ((user->client :rasta) :get 200 "card", :label "more_toucans")))                 ; filtering is done by slug

;; ## POST /api/card
;; Test that we can make a card
(let [card-name (random-name)]
  (expect-with-temp [Database [{database-id :id}]
                     Table    [{table-id :id}  {:db_id database-id}]]
    {:description            nil
     :organization_id        nil
     :name                   card-name
     :creator_id             (user->id :rasta)
     :dataset_query          {:database database-id
                              :type     "query"
                              :query    {:source-table table-id, :aggregation {:aggregation-type "count"}}}
     :display                "scalar"
     :visualization_settings {:global {:title nil}}
     :public_perms           0
     :database_id            database-id ; these should be inferred automatically
     :table_id               table-id
     :query_type             "query"
     :archived               false}
    (dissoc ((user->client :rasta) :post 200 "card" {:name                   card-name
                                                     :public_perms           0
                                                     :can_read               true
                                                     :can_write              true
                                                     :display                "scalar"
                                                     :dataset_query          {:database database-id
                                                                              :type     :query
                                                                              :query    {:source-table table-id, :aggregation {:aggregation-type :count}}}
                                                     :visualization_settings {:global {:title nil}}})
            :created_at :updated_at :id)))

;; ## GET /api/card/:id
;; Test that we can fetch a card
(expect-with-temp [Database  [{database-id :id}]
                   Table     [{table-id :id}   {:db_id database-id}]
                   Card      [card             {:dataset_query {:database database-id
                                                                :type     :query
                                                                :query    {:source-table table-id, :aggregation {:aggregation-type :count}}}}]]
  (match-$ card
    {:description            nil
     :can_read               true
     :can_write              true
     :organization_id        nil
     :dashboard_count        0
     :name                   $
     :creator_id             (user->id :rasta)
     :creator                (match-$ (fetch-user :rasta)
                               {:common_name  "Rasta Toucan"
                                :is_superuser false
                                :is_qbnewb    true
                                :last_login   $
                                :last_name    "Toucan"
                                :first_name   "Rasta"
                                :date_joined  $
                                :email        "rasta@metabase.com"
                                :id           $})
     :updated_at             $
     :dataset_query          $
     :id                     $
     :display                "table"
     :visualization_settings {}
     :public_perms           0
     :created_at             $
     :database_id            database-id ; these should be inferred from the dataset_query
     :table_id               table-id
     :query_type             "query"
     :archived               false
     :labels                 []})
  ((user->client :rasta) :get 200 (str "card/" (:id card))))

;; ## PUT /api/card/:id
;; Test that we can edit a Card
(let [updated-name (random-name)]
  (expect-with-temp [Card [{card-id :id, original-name :name}]]
    [original-name
     updated-name]
    [(sel :one :field [Card :name] :id card-id)
     (do ((user->client :rasta) :put 200 (str "card/" card-id) {:name updated-name})
         (sel :one :field [Card :name] :id card-id))]))

(defmacro ^:private with-temp-card {:style/indent 1} [binding & body]
  `(with-temp Card ~binding
     ~@body))

;; Can we update a Card's archived status?
(expect
  [false true false]
  (with-temp-card [{:keys [id]}]
    (let [archived?     (fn [] (:archived (Card id)))
          set-archived! (fn [archived]
                          ((user->client :rasta) :put 200 (str "card/" id) {:archived archived})
                          (archived?))]
      [(archived?)
       (set-archived! true)
       (set-archived! false)])))

;; ## DELETE /api/card/:id
;; Check that we can delete a card
(expect
  nil
  (with-temp-card [{:keys [id]}]
    ((user->client :rasta) :delete 204 (str "card/" id))
    (Card id)))

;; deleting a card that doesn't exist should return a 404 (#1957)
(expect "Not found."
  ((user->client :crowberto) :delete 404 "card/12345"))

;; # CARD FAVORITE STUFF

;; Helper Functions
(defn- fave? [card]
  ((user->client :rasta) :get 200 (format "card/%d/favorite" (:id card))))

(defn- fave [card]
  ((user->client :rasta) :post 200 (format "card/%d/favorite" (:id card))))

(defn- unfave [card]
  ((user->client :rasta) :delete 204 (format "card/%d/favorite" (:id card))))

;; ## GET /api/card/:id/favorite
;; Can we see if a Card is a favorite ?
(expect
  {:favorite false}
  (with-temp-card [card]
    (fave? card)))

;; ## POST /api/card/:id/favorite
;; Can we favorite a card?
(expect
  [{:favorite false}
   {:favorite true}]
  (with-temp-card [card]
    [(fave? card)
     (do (fave card)
         (fave? card))]))

;; DELETE /api/card/:id/favorite
;; Can we unfavorite a card?
(expect
  [{:favorite false}
   {:favorite true}
   {:favorite false}]
  (with-temp-card [card]
    [(fave? card)
     (do (fave card)
         (fave? card))
     (do (unfave card)
         (fave? card))]))

;;; POST /api/card/:id/labels
;; Check that we can update card labels
(expect-with-temp [Card  [{card-id :id}]
                   Label [{label-1-id :id} {:name "Toucan-Friendly"}]
                   Label [{label-2-id :id} {:name "Toucan-Unfriendly"}]]
  [[]                                                                                ; (1) should start out with no labels
   [{:id label-1-id, :name "Toucan-Friendly",   :slug "toucan_friendly",   :icon nil}  ; (2) set a few labels
    {:id label-2-id, :name "Toucan-Unfriendly", :slug "toucan_unfriendly", :icon nil}]
   []]                                                                                ; (3) should be able to reset to no labels
  (let [get-labels    (fn []
                        (:labels ((user->client :rasta) :get 200, (str "card/" card-id))))
        update-labels (fn [label-ids]
                        ((user->client :rasta) :post 200, (format "card/%d/labels" card-id) {:label_ids label-ids})
                        (get-labels))]
    [(get-labels)                            ; (1)
     (update-labels [label-1-id label-2-id]) ; (2)
     (update-labels [])]))                   ; (3)

Test fix :sad:

Test fix :sad:


; Iyye - AI agent
; Copyright (C) 2016-2017  Sasha Yumzya

; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as
; published by the Free Software Foundation, either version 3 of the
; License, or (at your option) any later version.

; This program 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 Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(ns iyye.subcon.knowledge.builtins (:require
                                     [clojure.tools.logging :as log]
                                     [iyye.bios.persistence :as persistence]
                                     ;[iyye.subcon.knowledge.relation :as relation]
                                     [iyye.subcon.knowledge.words :as words]
                                     ))

; Builtin types
(def iyye_actor (ref 0))
(def iyye_ai (ref 0))
(def iyye_iyye (ref 0))
(def iyye_human (ref 0))
(def iyye_yumzya (ref 0))

; Builtin relations
(def iyye_is_type (ref 0))
(def iyye_consists_type (ref 0))
(def iyye_create_instance (ref 0))

(defn iyye_is_type_predicate_function [p1-types p2-types]
  (when (and (not(empty? p1-types))
             (not(empty? p2-types)))
    (let [p1-type (first p1-types)                        ; FIXME Yumzya first
          p2-type (first p2-types)
          p1-name (:Name (:atom p1-type))
          p2-name (:Name (:atom p2-type))
          p1-data (:Data p1-type)
          p2-data (:Data p2-type)]
      (and (= p1-name (:super p2-data))                     ; FIXME Yumzia modal logic
           (= p2-name (:sub p1-data))))))

(defn iyye_is_type_function [p1-types p2-types]
    (when (and (not(empty? p1-types))
               (not(empty? p2-types)))
      (let [p1-type (first p1-types)                        ; FIXME Yumzya first
            p2-type (first p2-types)

            p1-supertypes (assoc @iyye_is_type :Data {:super (:Name (:atom p2-type))})
            p2-subtypes (assoc @iyye_is_type :Data {:sub (:Name (:atom p1-type))})
            new-p1-type (assoc p1-type :Relations p1-supertypes)
            new-p2-type (assoc p2-type :Relations p2-subtypes)]
      (do
        (words/set-iyye-type! new-p1-type)
        (words/set-iyye-type! new-p2-type)))))

(defn iyye_is_type_create_function [p1-name p2-type]
  (let [p1-type (words/create-iyye-type p1-name)]
    (when (and p1-type p2-type)
      (let [new-p1-type (assoc p1-type :Relations (conj (:Relations p1-type)))
            p2-subtypes (assoc @iyye_is_type :Data {:sub (:Name (:atom p1-type))})
            new-p2-type (assoc p2-type :Relations p2-subtypes)]
      (do
        (words/set-iyye-type! new-p1-type)
        (words/set-iyye-type! new-p2-type))))))

(defn iyye_consists_function [p1 p2]
  (let [])
  )

(defn iyye_instance_function [p1 name]
  (let [])
  )

;(dosync (alter relations-words conj relation))
;(persistence/write-action-to-db (conj (into {} (:atom action)) (dissoc (into {} action) :atom)))
;
; (defn write-to-db [atom]
;  (persistence/write-knowledge-to-db (conj (into {} (:atom action)) (dissoc (into {} action) :atom))))

;(defn ^{:source "(+ 1 a)"} aaa [a] (+ 1 a))
;(defmacro getsrc [func] `(:source (meta (var ~func))))

(defn create-iyye-builtin-relation [name types func pred-func]
  (words/create-iyye-relation name
                              (words/->Iyye_ModalPredicate :IYE :AXIOM (persistence/current-time-to-string) :ALWAYS)
                              types func pred-func true))

(defn- create-entry [entry] {(:Uname (:atom entry)) entry})

(defn- init-builtin-words []
  (let [actor (words/create-iyye-type "actor" true)
        ai (words/create-iyye-type "ai" true)
        iyye (words/create-iyye-type "iyye" true)
        human (words/create-iyye-type "human" true)
        yumzya (words/create-iyye-type "yumzya" true)]
    (dosync (ref-set iyye_actor actor))
    (dosync (ref-set iyye_ai ai))
    (dosync (ref-set iyye_iyye iyye))
    (dosync (ref-set iyye_human human))
    (dosync (ref-set iyye_yumzya yumzya))
    (dosync (alter words/noun-words conj (create-entry actor)
                   (create-entry ai) (create-entry iyye) (create-entry human) (create-entry yumzya)))))

(defn- init-builtin-relations []
  (let [t_is (create-iyye-builtin-relation "is" ["type" "type"] iyye_is_type_function iyye_is_type_predicate_function)
        t_is2 (create-iyye-builtin-relation "is" [:UNKNOWN "type"] iyye_is_type_create_function iyye_is_type_predicate_function)
        consistsof (create-iyye-builtin-relation "consists" [] iyye_consists_function iyye_is_type_predicate_function)
        instof (create-iyye-builtin-relation "instance" ["type"] iyye_instance_function iyye_is_type_predicate_function)]
    (dosync (ref-set iyye_is_type t_is))
    (dosync (ref-set iyye_consists_type consistsof))
    (dosync (ref-set iyye_create_instance instof))
    (dosync (alter words/action-words conj (create-entry t_is) (create-entry t_is2) (create-entry consistsof) (create-entry instof)))))

(defn- apply-builtin-relations []
  (do
    ((:Function @iyye_is_type) @iyye_ai @iyye_actor)
    ((:Function @iyye_is_type) @iyye_human @iyye_actor)
    ((:Function @iyye_is_type) @iyye_iyye @iyye_ai)
    ((:Function @iyye_is_type) @iyye_yumzya @iyye_human)))

(defn- init-builtins-kb []
  (init-builtin-words)
  (init-builtin-relations)
  (apply-builtin-relations))

;(dorun (map #(do ( persistence/write-fact-to-db (into {} %))) @action-words))
; (apply str (rest (str (:When {:When :ALWAYS}))))

(defn- init-db-kb []
  (let []
    (dosync (alter words/action-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "relations" {}))) ; {:When :ALWAYS}
    (dosync (alter words/noun-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "types" {} ; {:When :ALWAYS}
    )))
      ; others
    ))

(defn load-init-kb []
  (init-builtins-kb)
  (init-db-kb))

(defn init-kb []
  (init-builtins-kb))

; Iyye - AI agent
; Copyright (C) 2016-2017  Sasha Yumzya

; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as
; published by the Free Software Foundation, either version 3 of the
; License, or (at your option) any later version.

; This program 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 Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(ns iyye.subcon.knowledge.builtins (:require
                                     [clojure.tools.logging :as log]
                                     [iyye.bios.persistence :as persistence]
                                     ;[iyye.subcon.knowledge.relation :as relation]
                                     [iyye.subcon.knowledge.words :as words]
                                     ))

; Builtin types
(def iyye_actor (ref 0))
(def iyye_ai (ref 0))
(def iyye_iyye (ref 0))
(def iyye_human (ref 0))
(def iyye_yumzya (ref 0))

; Builtin relations
(def iyye_is_type (ref 0))
(def iyye_consists_type (ref 0))
(def iyye_create_instance (ref 0))

(defn iyye_is_type_predicate_function [p1-types p2-types]
  (when (and (not(empty? p1-types))
             (not(empty? p2-types)))
    (let [p1-type (first p1-types)                        ; FIXME Yumzya first
          p2-type (first p2-types)
          p1-name (:Name (:atom p1-type))
          p2-name (:Name (:atom p2-type))
          p1-data (:Data p1-type)
          p2-data (:Data p2-type)]
      (and (= p1-name (:super p2-data))                     ; FIXME Yumzia modal logic
           (= p2-name (:sub p1-data))))))

(defn iyye_is_type_function [p1-type p2-type]
    (when (and p1-type p2-type)
      (let [p1-supertypes (assoc @iyye_is_type :Data {:super (:Name (:atom p2-type))})
            p2-subtypes (assoc @iyye_is_type :Data {:sub (:Name (:atom p1-type))})
            new-p1-type (assoc p1-type :Relations p1-supertypes)
            new-p2-type (assoc p2-type :Relations p2-subtypes)]
      (do
        (words/set-iyye-type! new-p1-type)
        (words/set-iyye-type! new-p2-type)))))

(defn iyye_is_type_create_function [p1-name p2-type]
  (let [p1-type (words/create-iyye-type p1-name)]
    (when (and p1-type p2-type)
      (let [new-p1-type (assoc p1-type :Relations (conj (:Relations p1-type)))
            p2-subtypes (assoc @iyye_is_type :Data {:sub (:Name (:atom p1-type))})
            new-p2-type (assoc p2-type :Relations p2-subtypes)]
      (do
        (words/set-iyye-type! new-p1-type)
        (words/set-iyye-type! new-p2-type))))))

(defn iyye_consists_function [p1 p2]
  (let [])
  )

(defn iyye_instance_function [p1 name]
  (let [])
  )

;(dosync (alter relations-words conj relation))
;(persistence/write-action-to-db (conj (into {} (:atom action)) (dissoc (into {} action) :atom)))
;
; (defn write-to-db [atom]
;  (persistence/write-knowledge-to-db (conj (into {} (:atom action)) (dissoc (into {} action) :atom))))

;(defn ^{:source "(+ 1 a)"} aaa [a] (+ 1 a))
;(defmacro getsrc [func] `(:source (meta (var ~func))))

(defn create-iyye-builtin-relation [name types func pred-func]
  (words/create-iyye-relation name
                              (words/->Iyye_ModalPredicate :IYE :AXIOM (persistence/current-time-to-string) :ALWAYS)
                              types func pred-func true))

(defn- create-entry [entry] {(:Uname (:atom entry)) entry})

(defn- init-builtin-words []
  (let [actor (words/create-iyye-type "actor" true)
        ai (words/create-iyye-type "ai" true)
        iyye (words/create-iyye-type "iyye" true)
        human (words/create-iyye-type "human" true)
        yumzya (words/create-iyye-type "yumzya" true)]
    (dosync (ref-set iyye_actor actor))
    (dosync (ref-set iyye_ai ai))
    (dosync (ref-set iyye_iyye iyye))
    (dosync (ref-set iyye_human human))
    (dosync (ref-set iyye_yumzya yumzya))
    (dosync (alter words/noun-words conj (create-entry actor)
                   (create-entry ai) (create-entry iyye) (create-entry human)
                   (create-entry yumzya)))))

(defn- init-builtin-relations []
  (let [t_is (create-iyye-builtin-relation "is" ["type" "type"] iyye_is_type_function iyye_is_type_predicate_function)
        t_is2 (create-iyye-builtin-relation "is" [:UNKNOWN "type"] iyye_is_type_create_function iyye_is_type_predicate_function)
        consistsof (create-iyye-builtin-relation "consists" [] iyye_consists_function iyye_is_type_predicate_function)
        instof (create-iyye-builtin-relation "instance" ["type"] iyye_instance_function iyye_is_type_predicate_function)]
    (dosync (ref-set iyye_is_type t_is))
    (dosync (ref-set iyye_consists_type consistsof))
    (dosync (ref-set iyye_create_instance instof))
    (dosync (alter words/action-words conj (create-entry t_is) (create-entry t_is2) (create-entry consistsof) (create-entry instof)))))

(defn- apply-builtin-relations []
  (do
    ((:Function @iyye_is_type) @iyye_ai @iyye_actor)
    ((:Function @iyye_is_type) @iyye_human @iyye_actor)
    ((:Function @iyye_is_type) @iyye_iyye @iyye_ai)
    ((:Function @iyye_is_type) @iyye_yumzya @iyye_human)))

(defn- init-builtins-kb []
  (init-builtin-words)
  (init-builtin-relations)
  (apply-builtin-relations))

;(dorun (map #(do ( persistence/write-fact-to-db (into {} %))) @action-words))
; (apply str (rest (str (:When {:When :ALWAYS}))))

(defn- init-db-kb []
  (let []
    (dosync (alter words/action-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "relations" {}))) ; {:When :ALWAYS}
    (dosync (alter words/noun-words #(apply conj %1 %2) (persistence/read-knowledge-from-db "types" {} ; {:When :ALWAYS}
    )))
      ; others
    ))

(defn load-init-kb []
  (init-builtins-kb)
  (init-db-kb))

(defn init-kb []
  (init-builtins-kb))

Update builtins.clj

Update builtins.clj


(ns cmr.indexer.data.concepts.organization
  "Contains functions to extract organizaiton fields"
  (require [cmr.common-app.services.kms-fetcher :as kf]
           [clojure.string :as str]))

(defn extract-archive-centers
  "Extract the archive organization/archive-centers from collection"
  [collection]
  (let [orgs (:organizations collection)]
    (for [org orgs
          :when (= :archive-center (:type org))]
      (:org-name org))))

(def default-archive-center-values
  "Default values to use for any archive-center fields which are nil."
  (zipmap [:level-0 :level-1 :level-2 :level-3 :long-name :data-center-url]
          (repeat kf/FIELD_NOT_PRESENT)))

(defn archive-center-short-name->elastic-doc
  "Converts an archive-center short-name into an elastic document with the full nested hierarchy
  for that short-name from the GCMD KMS keywords. If a field is not present in the KMS hierarchy,
  we use a dummy value to indicate the field was not present."
  [gcmd-keywords-map short-name]
  (let [full-archive-center
        (merge default-archive-center-values
               (kf/get-full-hierarchy-for-short-name gcmd-keywords-map :providers short-name))
        {:keys [level-0 level-1 level-2 level-3 long-name data-center-url uuid]} full-archive-center]
    {:level-0 level-0
     :level-0.lowercase (str/lower-case level-0)
     :level-1 level-1
     :level-1.lowercase (str/lower-case level-1)
     :level-2 level-2
     :level-2.lowercase (str/lower-case level-2)
     :level-3 level-3
     :level-3.lowercase (str/lower-case level-3)
     :short-name short-name
     :short-name.lowercase (str/lower-case short-name)
     :long-name long-name
     :long-name.lowercase (str/lower-case long-name)
     :data-center-url data-center-url
     :data-center-url.lowercase (str/lower-case data-center-url)
     :uuid uuid
     :uuid.lowercase (when uuid (str/lower-case uuid))}))

(ns cmr.indexer.data.concepts.organization
  "Contains functions to extract organization fields"
  (require [cmr.common-app.services.kms-fetcher :as kf]
           [clojure.string :as str]))

(defn extract-archive-centers
  "Extract the archive organization/archive-centers from collection"
  [collection]
  (let [orgs (:organizations collection)]
    (for [org orgs
          :when (= :archive-center (:type org))]
      (:org-name org))))

(def default-archive-center-values
  "Default values to use for any archive-center fields which are nil."
  (zipmap [:level-0 :level-1 :level-2 :level-3 :long-name :data-center-url]
          (repeat kf/FIELD_NOT_PRESENT)))

(defn archive-center-short-name->elastic-doc
  "Converts an archive-center short-name into an elastic document with the full nested hierarchy
  for that short-name from the GCMD KMS keywords. If a field is not present in the KMS hierarchy,
  we use a dummy value to indicate the field was not present."
  [gcmd-keywords-map short-name]
  (let [full-archive-center
        (merge default-archive-center-values
               (kf/get-full-hierarchy-for-short-name gcmd-keywords-map :providers short-name))
        {:keys [level-0 level-1 level-2 level-3 long-name data-center-url uuid]} full-archive-center]
    {:level-0 level-0
     :level-0.lowercase (str/lower-case level-0)
     :level-1 level-1
     :level-1.lowercase (str/lower-case level-1)
     :level-2 level-2
     :level-2.lowercase (str/lower-case level-2)
     :level-3 level-3
     :level-3.lowercase (str/lower-case level-3)
     :short-name short-name
     :short-name.lowercase (str/lower-case short-name)
     :long-name long-name
     :long-name.lowercase (str/lower-case long-name)
     :data-center-url data-center-url
     :data-center-url.lowercase (str/lower-case data-center-url)
     :uuid uuid
     :uuid.lowercase (when uuid (str/lower-case uuid))}))

Fix misspelling

CMR-1801: Fix misspelling


(ns semtag-web.rendering.bar-chart
  "D3 bar chart based on http://mbostock.github.io/d3/tutorial/bar-1.html
  and https://github.com/dribnet/strokes/tree/master/examples/simple-bar"
  (:require [domina :as dom]))

(def d3 (this-as ct (aget ct "d3")))

;; mouse* fns for tooltips - based on http://bl.ocks.org/biovisualize/1016860
(defn mouseover [e]
  (when-let [title (-> d3.event .-target .-parentNode .-attributes (.getNamedItem "title"))]
    (dom/set-html! (dom/by-id "tooltip") (.-value title)))
  (-> (dom/by-id "tooltip") .-style .-visibility (set! "visible")))

(defn mousemove []
  (-> (dom/by-id "tooltip") .-style .-top (set! (str (- d3.event.pageY 10) "px")))
  (-> (dom/by-id "tooltip") .-style .-left (set! (str (+ d3.event.pageX 10) "px"))))

(defn mouseout []
  (-> (dom/by-id "tooltip") .-style .-visibility (set! "hidden")))

(defn setup-bar [bar x y]
  ;; add rect
  (-> bar (.append "rect")
      (.attr (clj->js {:width x
                       :height (.rangeBand y)})))

  ;; add text
  (-> bar (.append "text")
      (.attr (clj->js {:x x
                       :y (/ (.rangeBand y) 2)
                       :dx -6
                       :dy ".35em"
                       :text-anchor "end"}))
      (.style "fill" "white")
      (.text identity))

  (-> bar
      (.on "mouseover" mouseover)
      (.on "mousemove" mousemove)
      (.on "mouseout" mouseout)))

(defn render* [id data labels]
  (let [height (* 20 (count data))
        width 440
        x (-> d3 .-scale (.linear)
              (.domain (array 0 (apply max data)))
              (.range (array 0 width)))
        y (-> d3 .-scale (.ordinal)
              (.domain (apply array (range (count data))))
              (.rangeRoundBands (array 0 height) 0.2))
        svg (-> d3 (.select id) (.append "svg")
                (.attr (clj->js {:width width :height height}))
                (.append "g"))
        bar (-> svg (.selectAll "g.bar")
                (.data (clj->js data))
                (.enter) (.append "g")
                (.attr (clj->js {:class "bar"
                                 :title #(get labels %2)
                                 :transform #(str "translate(0," (y %2) ")")})))]
    (setup-bar bar x y)))

(defn render [id data]
  (if (empty? data)
    (dom/append! (dom/by-id (subs id 1)) "
There are no statistics for this empty data set.
")
    (render* id (mapv first data) (mapv second data))))

(ns semtag-web.rendering.bar-chart
  "D3 bar chart based on http://mbostock.github.io/d3/tutorial/bar-1.html
  and https://github.com/dribnet/strokes/tree/master/examples/simple-bar"
  (:require [domina :as dom]))

(def d3 (this-as ct (aget ct "d3")))

;; mouse* fns for tooltips - based on http://bl.ocks.org/biovisualize/1016860
(defn mouseover [e]
  (when-let [title (-> d3.event .-target .-parentNode .-attributes (.getNamedItem "title"))]
    (dom/set-html! (dom/by-id "tooltip") (.-value title)))
  (-> (dom/by-id "tooltip") .-style .-visibility (set! "visible")))

(defn mousemove []
  (-> (dom/by-id "tooltip") .-style .-top (set! (str (- d3.event.pageY 10) "px")))
  (-> (dom/by-id "tooltip") .-style .-left (set! (str (+ d3.event.pageX 10) "px"))))

(defn mouseout []
  (-> (dom/by-id "tooltip") .-style .-visibility (set! "hidden")))

(defn setup-bar [bar x y labels data]
  ;; add rect
  (-> bar (.append "rect")
      (.attr (clj->js {:width x
                       :height (.rangeBand y)})))

  ;; add number at end
  (-> bar (.append "text")
      (.attr (clj->js {:x x
                       :y (/ (.rangeBand y) 2)
                       :dx -6
                       :dy ".35em"
                       :text-anchor "end"}))
      (.style "fill" "white")
      (.text identity))

  ;; add optional label at beginning
  (let [sum (apply + data)]
    (-> bar (.append "text")
        (.attr (clj->js {:x 0
                         :y  (/ (.rangeBand y) 2)
                         :dx 2
                         :dy ".35em"}))
        (.style "fill" "white")
        ;; only show text if bar is wide enough and important enough
        ;; This doesn't work for long labels for small bars e.g. 'java' but that's ok for now
        (.text #(when (> (/ (get data %2) sum) 0.15)
                  (get labels %2)))))

  (-> bar
      (.on "mouseover" mouseover)
      (.on "mousemove" mousemove)
      (.on "mouseout" mouseout)))

(defn render* [id data labels]
  (let [height (* 20 (count data))
        width 440
        x (-> d3 .-scale (.linear)
              (.domain (array 0 (apply max data)))
              (.range (array 0 width)))
        y (-> d3 .-scale (.ordinal)
              (.domain (apply array (range (count data))))
              (.rangeRoundBands (array 0 height) 0.2))
        svg (-> d3 (.select id) (.append "svg")
                (.attr (clj->js {:width width :height height}))
                (.append "g"))
        bar (-> svg (.selectAll "g.bar")
                (.data (clj->js data))
                (.enter) (.append "g")
                (.attr (clj->js {:class "bar"
                                 :title #(str (get data %2) " for " (get labels %2))
                                 :transform #(str "translate(0," (y %2) ")")})))]
    (setup-bar bar x y labels data)))

(defn render [id data]
  (if (empty? data)
    (dom/append! (dom/by-id (subs id 1)) "
There are no statistics for this empty data set.
")
    (render* id (mapv first data) (mapv second data))))

add optional label in bars, add num to tooltip