(ns planck.shell
  (:require-macros planck.shell)
  (:require [cljs.spec :as s]
            [clojure.string]
            [planck.io :refer [as-file]]))

(def ^:dynamic *sh-dir* nil)
(def ^:dynamic *sh-env* nil)

(def ^:private cb-idx (atom 0))
(def ^:private callbacks (atom {}))
(defn- assoc-cb [cb]
  (let [idx (swap! cb-idx inc)]
    (swap! callbacks assoc idx cb)
    idx))
(defn do-callback [idx]
  (this-as this ((@callbacks idx) this))
  (swap! callbacks dissoc idx))
(aset js/global "do_async_sh_callback" do-callback)

(defn translate-result [js-res]
  (let [[exit out err] (js->clj js-res)]
    {:exit exit :out out :err err}))
(aset js/global "translate_async_result" translate-result)

(def ^:private nil-func (fn [_] nil))
(defn- sh-internal
  "Launches a sub-process with the supplied arguments.
  Parameters: cmd, <options>, cb (may be nil-func for synchronous)
  cmd      the command(s) (Strings) to execute. will be concatenated together.
  options  optional keyword arguments-- see below.
  cb       the callback to call upon completion (for async). specify nil-func for sync.
  Options are:
  :in      may be given followed by a string of one of the following formats:
           String conforming to URL Syntax: 'file:///tmp/test.txt'
           String pointing at an *existing* 'file: '/tmp/test.txt'
           String with string input: 'Printing input from stdin with funny chars like $@ &'
           to be fed to the sub-process's stdin.
  :in-enc  option may be given followed by a String, used as a character
           encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to
           convert the input string specified by the :in option to the
           sub-process's stdin.  Defaults to UTF-8.
  :out-enc option may be given followed by a String. If a
           String is given, it will be used as a character encoding
           name (for example \"UTF-8\" or \"ISO-8859-1\") to convert
           the sub-process's stdout to a String which is returned.
  :env     override the process env with a map of String: String.
  :dir     override the process dir with a String or planck.io/File.
  if the command can be launched and cb is nil-func, sh returns a map of
    :exit => sub-process's exit code
    :out  => sub-process's stdout (as String)
    :err  => sub-process's stderr (String via platform default encoding),
  otherwise if cb is not nil-func, executes async and returns nil immediately.
  otherwise it throws an exception"
  [& args]
  (let [{:keys [cmd opts cb]} (s/conform ::sh-async-args args)]
    (when (nil? cmd)
      (throw (s/explain ::sh-async-args args)))
    (let [{:keys [in in-enc out-enc env dir]}
          (merge {:out-enc nil :in-enc nil :dir (and *sh-dir* [:sh-dir *sh-dir*]) :env *sh-env*}
            (into {} (map (comp (juxt :key :val) second) opts)))
          dir (and dir (:path (as-file (second dir))))
          async? (not= cb nil-func)
          translated (translate-result (js/PLANCK_SHELL_SH (clj->js cmd) in in-enc out-enc
                                                           (clj->js (seq env)) dir (if async? (assoc-cb cb))))
          {:keys [exit err]} translated]
      (if (and (== -1 exit)
               (= "launch path not accessible" err))
        (throw (js/Error. err))
        (if async? nil translated)))))

(defn sh [& args]
  (apply sh-internal (concat args [nil-func])))

(when-not (clojure.string/starts-with? js/PLANCK_VERSION "1.")
  (defn sh-async [& args]
    (apply sh-internal args)))

(s/def ::string-string-map? (s/and map? (fn [m]
                                          (and (every? string? (keys m))
                                               (every? string? (vals m))))))

(s/def ::sh-opt
  (s/alt :in      (s/cat :key #{:in}      :val string?)
         :in-enc  (s/cat :key #{:in-enc}  :val string?)
         :out-enc (s/cat :key #{:out-enc} :val string?)
         :dir     (s/cat :key #{:dir}     :val :planck.io/coercible-file?)
         :env     (s/cat :key #{:env}     :val ::string-string-map?)))

(s/def ::sh-args (s/cat :cmd (s/+ string?) :opts (s/* ::sh-opt)))
(s/def ::sh-async-args (s/cat :cmd (s/+ string?) :opts (s/* ::sh-opt) :cb fn?))

(s/def ::exit integer?)
(s/def ::out string?)
(s/def ::err string?)

(s/fdef sh-internal
  :args ::sh-async-args
  :ret (s/keys :req-un [::exit ::out ::err]))

(s/fdef sh
  :args ::sh-args
  :ret (s/keys :req-un [::exit ::out ::err]))

(ns planck.shell
  (:require-macros planck.shell)
  (:require [cljs.spec :as s]
            [clojure.string]
            [planck.io :refer [as-file]]))

(def ^:dynamic *sh-dir* nil)
(def ^:dynamic *sh-env* nil)

(def ^:private cb-idx (atom 0))
(def ^:private callbacks (atom {}))
(defn- assoc-cb [cb]
  (let [idx (swap! cb-idx inc)]
    (swap! callbacks assoc idx cb)
    idx))
(defn do-callback [idx]
  (this-as this ((@callbacks idx) this))
  (swap! callbacks dissoc idx))
(aset js/global "do_async_sh_callback" do-callback)

(defn translate-result [js-res]
  (let [[exit out err] (js->clj js-res)]
    {:exit exit :out out :err err}))
(aset js/global "translate_async_result" translate-result)

(def ^:private nil-func (fn [_] nil))
(defn- sh-internal
  [& args]
  (let [{:keys [cmd opts cb]} (s/conform ::sh-async-args args)]
    (when (nil? cmd)
      (throw (s/explain ::sh-async-args args)))
    (let [{:keys [in in-enc out-enc env dir]}
          (merge {:out-enc nil :in-enc nil :dir (and *sh-dir* [:sh-dir *sh-dir*]) :env *sh-env*}
            (into {} (map (comp (juxt :key :val) second) opts)))
          dir (and dir (:path (as-file (second dir))))
          async? (not= cb nil-func)
          translated (translate-result (js/PLANCK_SHELL_SH (clj->js cmd) in in-enc out-enc
                                                           (clj->js (seq env)) dir (if async? (assoc-cb cb))))
          {:keys [exit err]} translated]
      (if (and (== -1 exit)
               (= "launch path not accessible" err))
        (throw (js/Error. err))
        (if async? nil translated)))))

(defn sh
  "Launches a sub-process with the supplied arguments.
  Parameters: cmd, <options>
  cmd      the command(s) (Strings) to execute. will be concatenated together.
  options  optional keyword arguments-- see below.
  Options are:
  :in      may be given followed by a string of one of the following formats:
           String conforming to URL Syntax: 'file:///tmp/test.txt'
           String pointing at an *existing* 'file: '/tmp/test.txt'
           String with string input: 'Printing input from stdin with funny chars like $@ &'
           to be fed to the sub-process's stdin.
  :in-enc  option may be given followed by a String, used as a character
           encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to
           convert the input string specified by the :in option to the
           sub-process's stdin.  Defaults to UTF-8.
  :out-enc option may be given followed by a String. If a
           String is given, it will be used as a character encoding
           name (for example \"UTF-8\" or \"ISO-8859-1\") to convert
           the sub-process's stdout to a String which is returned.
  :env     override the process env with a map of String: String.
  :dir     override the process dir with a String or planck.io/File.
  if the command can be launched, sh returns a map of
    :exit => sub-process's exit code
    :out  => sub-process's stdout (as String)
    :err  => sub-process's stderr (String via platform default encoding),
  otherwise it throws an exception"
  [& args]
  (apply sh-internal (concat args [nil-func])))

(when-not (clojure.string/starts-with? js/PLANCK_VERSION "1.")
  (defn sh-async
    "Launches a sub-process with the supplied arguments.
    Parameters: cmd, <options>, cb
    cmd      the command(s) (Strings) to execute. will be concatenated together.
    options  optional keyword arguments-- see below.
    cb       the callback to call upon completion
    Options are:
    :in      may be given followed by a string of one of the following formats:
             String conforming to URL Syntax: 'file:///tmp/test.txt'
             String pointing at an *existing* 'file: '/tmp/test.txt'
             String with string input: 'Printing input from stdin with funny chars like $@ &'
             to be fed to the sub-process's stdin.
    :in-enc  option may be given followed by a String, used as a character
             encoding name (for example \"UTF-8\" or \"ISO-8859-1\") to
             convert the input string specified by the :in option to the
             sub-process's stdin.  Defaults to UTF-8.
    :out-enc option may be given followed by a String. If a
             String is given, it will be used as a character encoding
             name (for example \"UTF-8\" or \"ISO-8859-1\") to convert
             the sub-process's stdout to a String which is returned.
    :env     override the process env with a map of String: String.
    :dir     override the process dir with a String or planck.io/File.
    if the command can be launched, sh-async calls back with a map of
      :exit => sub-process's exit code
      :out  => sub-process's stdout (as String)
      :err  => sub-process's stderr (String via platform default encoding),
    Returns nil immediately"
    [& args]
    (apply sh-internal args)))

(s/def ::string-string-map? (s/and map? (fn [m]
                                          (and (every? string? (keys m))
                                               (every? string? (vals m))))))

(s/def ::sh-opt
  (s/alt :in      (s/cat :key #{:in}      :val string?)
         :in-enc  (s/cat :key #{:in-enc}  :val string?)
         :out-enc (s/cat :key #{:out-enc} :val string?)
         :dir     (s/cat :key #{:dir}     :val :planck.io/coercible-file?)
         :env     (s/cat :key #{:env}     :val ::string-string-map?)))

(s/def ::sh-args (s/cat :cmd (s/+ string?) :opts (s/* ::sh-opt)))
(s/def ::sh-async-args (s/cat :cmd (s/+ string?) :opts (s/* ::sh-opt) :cb fn?))

(s/def ::exit integer?)
(s/def ::out string?)
(s/def ::err string?)

(s/fdef sh
  :args ::sh-args
  :ret (s/keys :req-un [::exit ::out ::err]))

(s/fdef sh-async
  :args ::sh-async-args
  :ret nil?)

Arrange things so that sh and sy-async have public docs


(ns ^:figwheel-always text-justification.model
    (:require [reagent.core :as reagent :refer [atom]]
              [goog.string :as gstring]))

(enable-console-print!)

;;;; TODO precalc badness to hash ?

;;;;
;;;; consts
;;;;

(defonce invisible-char (gstring/unescapeEntities " ")) ;; \u00A0 ?

;;;;
;;;; state
;;;;

(defonce state (atom []))

(defn- set-state    [new-state] (reset! state new-state))
(defn- clear-state  [] (set-state []))
(defn- update-state [new-lines] (set-state (concat @state new-lines)))

;;;;
;;;; implementation
;;;;

(defn- badness
  "given line and page width returns measurement how `pretty` the line is"
  [words-lengths page-width]
  (let [total-length (+ (reduce + words-lengths) (count words-lengths) -1)] ;; count whitespaces too
    (if (> total-length page-width)
      js/Infinity
      (let [a (- page-width total-length)] (* a a a)) )))

;; cache results (memo)
;; f.e. result for 'justify text after X word is: [lines]'
(def tj-memo (atom {}))

(defn- clear-memo [] (reset! tj-memo {}))
(defn- add-memo   [arg-val return-val] (swap! tj-memo #(assoc % arg-val return-val)))
(defn- has-memo?  [arg-val] (contains? @tj-memo arg-val)) ;; TODO use let-if instead, to search for value once
(defn- get-memo   [arg-val] (get @tj-memo arg-val))

(defn- tj-inner
  "fits words into lines so that whole text looks pretty
  @return #words in each line"
  ([page-width words]
    (clear-memo)
    (second (tj-inner page-width words 0)))
  ([page-width words word-idx]
    (cond
      (empty? words) [0.0 []]
      (has-memo? word-idx) (get-memo word-idx)
      :else
        (reduce
          (fn [acc newline-placement-idx]
             (let [line (subvec words 0 newline-placement-idx)
                   rest-of-text (subvec words newline-placement-idx)
                   newline-word-idx (+ word-idx newline-placement-idx)
                   [sub-prob-ugliness sub-prob-lines :as sub-prob-solution]
                            (tj-inner page-width rest-of-text newline-word-idx)
                   ugliness (+ (badness line page-width) sub-prob-ugliness)
                   solution-proposal (cons newline-placement-idx sub-prob-lines)]
              ; (print "sub" line "|words in line" (count words))
              (add-memo newline-word-idx sub-prob-solution)
              (if (< ugliness (first acc)) [ugliness solution-proposal] acc)))
          [js/Infinity []]
          (map inc (range (count words))) )))) ;; TODO (dec (count words)) ?

(defn- split-word
  "Split words that have length > max-len"
  [max-len word]
  (let [len (count word)]
    (if (<= len max-len)
      [word]
      (concat
        [(.substring word 0 max-len)]
        (split-word max-len (str " -" (.substring word max-len))) ))))

(defn- prepare-paragraph
  [paragraph max-chars-in-line]
  (-> paragraph
         gstring/trim
         (.split #" +")
         (->> (mapv #(split-word max-chars-in-line %))
              flatten
              vec)))

(defn- prepare-text
  "Prepare whole text for justification.
   1) split by paragraphs / treat text as single text flow
   2) trim words
   @return vector of lines, where each line is vector of words"
  [text separate-paragraphs max-chars-in-line]
  (let [paragraphs (if separate-paragraphs
                        (seq (.split text "\n"))
                        [(clojure.string/replace text #"\n" " ")] )]
      (mapv #(prepare-paragraph % max-chars-in-line) paragraphs) ))

;;;;
;;;; public interface
;;;;

(defn text-justification
  "justify text provided as a collection of words to given page width"
  [text separate-paragraphs page-width]
  {:pre [(> page-width 0)]}

  (clear-state)
  (.profile js.console "text-justification")
  (doseq [words-in-paragraph (prepare-text text separate-paragraphs page-width)]
    ; (println "PARAGRAPH:" words-in-paragraph)
    (let [words-lengths (mapv count words-in-paragraph)
          justified-text (tj-inner page-width words-lengths)]
       ; (.log js/console "words" (count words) ":" words)
       ; (.log js/console "state" (count justified-text) ":" justified-text)
       (update-state
        (second (reduce
          (fn [[start-word-idx lines-atm] line-words-count]
            (let [next-word-start-idx (+ start-word-idx line-words-count)
                  words-in-this-line (subvec words-in-paragraph start-word-idx next-word-start-idx)]
              ; (println words-in-this-line)
              [next-word-start-idx (conj lines-atm words-in-this-line)] ))
          [0 []]
          justified-text))) ))
  (.profileEnd js.console)
  )

(ns ^:figwheel-always text-justification.model
    (:require [reagent.core :as reagent :refer [atom]]
              [goog.string :as gstring]))

(enable-console-print!)

;;;; TODO precalc badness to hash ?
;;;; TODO profile usage of type hinting

;;;;
;;;; consts
;;;;

(defonce invisible-char (gstring/unescapeEntities " ")) ;; \u00A0 ?

;;;;
;;;; state
;;;;

(defonce state (atom []))

(defn- set-state    [new-state] (reset! state new-state))
(defn- clear-state  [] (set-state []))
(defn- update-state [new-lines] (set-state (concat @state new-lines)))

;;;;
;;;; implementation
;;;;

(defn- badness
  "given line and page width returns measurement how `pretty` the line is"
  [words-lengths page-width]
  (let [total-length (+ (reduce + words-lengths) (count words-lengths) -1)] ;; count whitespaces too
    (if (> total-length page-width)
      js/Infinity
      (let [a (- page-width total-length)] (* a a a)) )))

;; cache results (memo)
;; f.e. result for 'justify text after X word is: [lines]'
(def tj-memo (atom {}))

(defn- clear-memo [] (reset! tj-memo {}))
(defn- add-memo   [arg-val return-val] (swap! tj-memo #(assoc % arg-val return-val)))
(defn- has-memo?  [arg-val] (contains? @tj-memo arg-val)) ;; TODO use let-if instead, to search for value once
(defn- get-memo   [arg-val] (get @tj-memo arg-val))

(defn- tj-inner
  "fits words into lines so that whole text looks pretty
  @return #words in each line"
  ([page-width words] ;; NOTE: dynamic dispatching does not hurt performance here. Curious..
    (clear-memo)
    (second (tj-inner page-width words 0)))
  ([page-width words word-idx]
    (cond
      (empty? words) [0.0 []]
      (has-memo? word-idx) (get-memo word-idx)
      :else
        (reduce
          (fn [acc newline-placement-idx]
             (let [line (subvec words 0 newline-placement-idx)
                   rest-of-text (subvec words newline-placement-idx)
                   newline-word-idx (+ word-idx newline-placement-idx)
                   [sub-prob-ugliness sub-prob-lines :as sub-prob-solution]
                            (tj-inner page-width rest-of-text newline-word-idx)
                   ugliness (+ (badness line page-width) sub-prob-ugliness)
                   solution-proposal (cons newline-placement-idx sub-prob-lines)]
              ; (print "sub" line "|words in line" (count words))
              (add-memo newline-word-idx sub-prob-solution)
              (if (< ugliness (first acc)) [ugliness solution-proposal] acc)))
          [js/Infinity []]
          (map inc (range (count words))) )))) ;; TODO (dec (count words)) ?

(defn- split-word
  "Split words that have length > max-len"
  [max-len word]
  (let [len (count word)]
    (if (<= len max-len)
      [word]
      (concat
        [(.substring word 0 max-len)]
        (split-word max-len (str " -" (.substring word max-len))) ))))

(defn- prepare-paragraph
  [paragraph max-chars-in-line]
  (-> paragraph
         gstring/trim
         (.split #" +")
         (->> (mapv #(split-word max-chars-in-line %))
              flatten
              vec)))

(defn- prepare-text
  "Prepare whole text for justification.
   1) split by paragraphs / treat text as single text flow
   2) trim words
   @return vector of lines, where each line is vector of words"
  [text separate-paragraphs max-chars-in-line]
  (let [paragraphs (if separate-paragraphs
                        (seq (.split text "\n"))
                        [(clojure.string/replace text #"\n" " ")] )]
      (mapv #(prepare-paragraph % max-chars-in-line) paragraphs) ))

;;;;
;;;; public interface
;;;;

(defn text-justification
  "justify text provided as a collection of words to given page width"
  [text separate-paragraphs page-width]
  {:pre [(> page-width 0)]}

  (clear-state)
  (.profile js.console "text-justification")
  (doseq [words-in-paragraph (prepare-text text separate-paragraphs page-width)]
    ; (println "PARAGRAPH:" words-in-paragraph)
    (let [words-lengths (mapv count words-in-paragraph)
          justified-text (tj-inner page-width words-lengths)]
       ; (.log js/console "words" (count words) ":" words)
       ; (.log js/console "state" (count justified-text) ":" justified-text)
       (update-state
        (second (reduce
          (fn [[start-word-idx lines-atm] line-words-count]
            (let [next-word-start-idx (+ start-word-idx line-words-count)
                  words-in-this-line (subvec words-in-paragraph start-word-idx next-word-start-idx)]
              ; (println words-in-this-line)
              [next-word-start-idx (conj lines-atm words-in-this-line)] ))
          [0 []]
          justified-text))) ))
  (.profileEnd js.console)
  )

Add note after dynamic dispatching profiling


(ns rotational-cipher)

(def ^:private string (partial apply str))

(def ^:private lower-case "abcdefghijklmnopqrstuvwxyz")

(def ^:private upper-case (->> lower-case (map clojure.string/upper-case) string))

(def ^:private letters (into #{} (concat lower-case upper-case)))

(defn- rotater [shift]
  (let [encoding (->> (cycle letters)
                      (drop (* shift 2))
                      (take 52)
                      (zipmap letters))]
    (fn [char] (get encoding char char))))

(defn rotate [message shift]
  (->> message
       (map (rotater shift))
       string))

(ns rotational-cipher)

(defn ^:private spinner [s a]
  (let [a (int a)
        spin (fn [c] (mod (+ c s) 26))]
    (fn [c]
      (let [c (- (int c) a)]
        (char (+ (spin c) a))))))

(defn ^:private upper-spinner [s]
  (spinner s \A))

(defn ^:private lower-spinner [s]
  (spinner s \a))

(defn ^:private cipher [spin]
  (let [upper-spin (upper-spinner spin)
        lower-spin (lower-spinner spin)]
    (fn [c]
      (cond
        (Character/isUpperCase c) (upper-spin c)
        (Character/isLowerCase c) (lower-spin c)
        :default c))))

(defn rotate [text spin]
  (let [cipher (cipher spin)]
    (apply str (map cipher text)) ))

Fix example does not rotate backwards.

Fix example does not rotate backwards.

Fixes the example so that it can handle backward rotations.


(ns holiday-ping-ui.common.views
  (:require [re-frame.core :as re-frame]))

;; HELPER VIEWS
(defn message-view []
  [:div
   (when-let [message @(re-frame/subscribe [:error-message])]
     [:article.message.is-danger
      [:div.message-body message]])
   (when-let [message @(re-frame/subscribe [:success-message])]
     [:article.message.is-success
      [:div.message-body message]])])

(defn section
  "Wrap the given views in a regular section"
  [& views]
  [:section.section
   (apply vector :div.container views)])

(defn section-size
  "Take the bulma class for size as the first parameter, i.e. :is-half"
  [size & views]
  [:section.section
   [:div.container
    [:div.columns.is-centered
     (apply vector :div.column {:class (name size)} views)]]])

;; APP VIEWS
(defn user-info-view []
  (when @(re-frame/subscribe [:access-token])
    (let [{name :name} @(re-frame/subscribe [:user-info])
          avatar       @(re-frame/subscribe [:avatar])]
      [:header.navbar-item.is-hoverable.has-dropdown
       [:a.navbar-link
        [:img {:src avatar}]]
       [:div.navbar-dropdown
        [:div.navbar-item.has-text-grey name]
        [:hr.navbar-divider]
        [:a.navbar-item {:href "#" :on-click #(re-frame/dispatch [:logout])} "Logout"]]])))

(defn navbar-view
  []
  [:nav.navbar.is-dark
   [:div.container

    [:div.navbar-brand
     [:a.navbar-item.is-size-3.app-title {:href "/"} "HolidayPing"]
     [:a.navbar-item.is-hidden-desktop
      {:href "https://notamonadtutorial.com" :target "_blank"} "Logout"]]

    [:div.navbar-menu
     [:div.navbar-start
      [:a.navbar-item
       {:href   "https://notamonadtutorial.com"
        :target "_blank"}
       "Blog"]
      [:a.navbar-item
       {:href   "https://github.com/lambdaclass/holiday_ping"
        :target "_blank"}
       "GitHub"]]
     [:div.navbar-end [user-info-view]]]]])

(defn footer-view
  []
  [:footer.footer
   [:div.container
    [:div.content.has-text-centered
     [:p [:strong "HolidayPing"] " by "
      [:a {:href "https://github.com/lambdaclass/" :target "_blank"} "LambdaClass"] "."]
     [:p [:a.icon {:href "https://github.com/lambdaclass/holiday_ping"}
          [:i.fa.fa-github]]]]]])

(defn loading-view
  []
  [:div
   [section-size :is-one-third
    [:div.card
     [:div.card-content
      [:div.has-text-centered
       [:div.subtitle "Mining bitcoins…"]
       [:a.button.is-medium.is-primary.is-loading
        [:span "Mining bitcoins"]]]]]]])

(defn not-found-view
  []
  [section
   [:div.has-text-centered
    [:div.subtitle "The page you are looking for was not found."]
    [:div.subtitle [:a {:href "/"} "Take me some place safe."]]]])

(defn breadcrumbs
  [items]
  [:div.breadcrumb.has-succeeds-separator
   [:ul
    (for [[text href] (butlast items)]
      [:li {:key text }[:a {:href href} text]])
    [:li.is-active [:a (-> items last first)]]]])

(ns holiday-ping-ui.common.views
  (:require [re-frame.core :as re-frame]))

;; HELPER VIEWS
(defn message-view []
  [:div
   (when-let [message @(re-frame/subscribe [:error-message])]
     [:article.message.is-danger
      [:div.message-body message]])
   (when-let [message @(re-frame/subscribe [:success-message])]
     [:article.message.is-success
      [:div.message-body message]])])

(defn section
  "Wrap the given views in a regular section"
  [& views]
  [:section.section
   (apply vector :div.container views)])

(defn section-size
  "Take the bulma class for size as the first parameter, i.e. :is-half"
  [size & views]
  [:section.section
   [:div.container
    [:div.columns.is-centered
     (apply vector :div.column {:class (name size)} views)]]])

;; APP VIEWS
(defn user-info-view []
  (when @(re-frame/subscribe [:access-token])
    (let [{name :name} @(re-frame/subscribe [:user-info])
          avatar       @(re-frame/subscribe [:avatar])]
      [:header.navbar-item.is-hoverable.has-dropdown
       [:a.navbar-link
        [:img {:src avatar}]]
       [:div.navbar-dropdown
        [:div.navbar-item.has-text-grey name]
        [:hr.navbar-divider]
        [:a.navbar-item {:href "#" :on-click #(re-frame/dispatch [:logout])} "Logout"]]])))

(defn navbar-view
  []
  [:nav.navbar.is-dark
   [:div.container

    [:div.navbar-brand
     [:a.navbar-item.is-size-3.app-title {:href "/"} "HolidayPing"]
     [:a.navbar-item.is-hidden-desktop
      {:href "#" :on-click #(re-frame/dispatch [:logout])} "Logout"]]

    [:div.navbar-menu
     [:div.navbar-start
      [:a.navbar-item
       {:href   "https://notamonadtutorial.com"
        :target "_blank"}
       "Blog"]
      [:a.navbar-item
       {:href   "https://github.com/lambdaclass/holiday_ping"
        :target "_blank"}
       "GitHub"]]
     [:div.navbar-end [user-info-view]]]]])

(defn footer-view
  []
  [:footer.footer
   [:div.container
    [:div.content.has-text-centered
     [:p [:strong "HolidayPing"] " by "
      [:a {:href "https://github.com/lambdaclass/" :target "_blank"} "LambdaClass"] "."]
     [:p [:a.icon {:href "https://github.com/lambdaclass/holiday_ping"}
          [:i.fa.fa-github]]]]]])

(defn loading-view
  []
  [:div
   [section-size :is-one-third
    [:div.card
     [:div.card-content
      [:div.has-text-centered
       [:div.subtitle "Mining bitcoins…"]
       [:a.button.is-medium.is-primary.is-loading
        [:span "Mining bitcoins"]]]]]]])

(defn not-found-view
  []
  [section
   [:div.has-text-centered
    [:div.subtitle "The page you are looking for was not found."]
    [:div.subtitle [:a {:href "/"} "Take me some place safe."]]]])

(defn breadcrumbs
  [items]
  [:div.breadcrumb.has-succeeds-separator
   [:ul
    (for [[text href] (butlast items)]
      [:li {:key text }[:a {:href href} text]])
    [:li.is-active [:a (-> items last first)]]]])

fix logout link in mobile, #fixes 162

fix logout link in mobile, #fixes 162


(ns asciinema-player.core-test
  (:require-macros [cljs.test :refer (is deftest testing)])
  (:require [cljs.test]
            [asciinema-player.core :as c]))

(deftest make-player-test
  (let [make-player #(c/make-player 80 24 "https://..." %)]
    (let [player (make-player {})]
      (is (= (:width player) 80))
      (is (= (:height player) 24))
      (is (= (:asciicast-url player) "https://..."))
      (is (= (:duration player) 0))
      (is (= (:start-at player) 0))
      (is (= (:current-time player) 0))
      (is (= (:theme player) "asciinema"))
      (is (= (:font-size player) "small"))
      (is (= (:speed player) 1))
      (is (= (:auto-play player) false))
      (is (= (:loop player) nil)))
    (let [player (make-player {:speed 3 :theme "tango" :font-size "big" :loop true :author "me"})]
      (is (= (:speed player) 3))
      (is (= (:theme player) "tango"))
      (is (= (:font-size player) "big"))
      (is (= (:loop player) true))
      (is (= (:author player) "me")))
    (let [player (make-player {:start-at 15})]
      (is (= (:start-at player) 15))
      (is (= (:current-time player) 15))
      (is (= (:auto-play player) true)))
    (let [player (make-player {:start-at 15 :auto-play false})]
      (is (= (:start-at player) 15))
      (is (= (:current-time player) 15))
      (is (= (:auto-play player) false)))
    (let [player (make-player {:snapshot [[["foo" {}] ["bar" {:fg 1}]] [["baz" {:bg 2}]]]})]
      (is (= (:lines player) [[["foo" {}] ["bar" {:fg 1}]] [["baz" {:bg 2}]]])))))

(deftest update-screen-test
  (let [frame-fn #(update-in % [:cursor :y] inc)
        state {:lines {2 :a}
               :cursor {:y 5}
               :frame-fn frame-fn}
        changes {:lines {1 :b 3 :d}
                 :cursor {:x 1 :y 2 :visible true}
                 :unknown true}]
    (is (= (c/update-screen state changes) {:lines {1 :b 3 :d}
                                            :cursor {:x 1 :y 3 :visible true}
                                            :frame-fn frame-fn}))))

(deftest new-position-test
  (is (= (c/new-position 2 5 -3) 0.0))
  (is (= (c/new-position 2 5 -1) 0.2))
  (is (= (c/new-position 2 5 4) 1.0))
  (is (= (c/new-position 2 5 2) 0.8)))

(deftest screen-state-at-test
  (let [frames [[5 :foo] [3 :bar] [4 :baz]]]
    (is (= (c/screen-state-at frames 0) nil))
    (is (= (c/screen-state-at frames 1) nil))
    (is (= (c/screen-state-at frames 2) nil))
    (is (= (c/screen-state-at frames 3) nil))
    (is (= (c/screen-state-at frames 4) nil))
    (is (= (c/screen-state-at frames 5) :foo))
    (is (= (c/screen-state-at frames 6) :foo))
    (is (= (c/screen-state-at frames 7) :foo))
    (is (= (c/screen-state-at frames 8) :bar))
    (is (= (c/screen-state-at frames 9) :bar))
    (is (= (c/screen-state-at frames 10) :bar))
    (is (= (c/screen-state-at frames 11) :bar))
    (is (= (c/screen-state-at frames 12) :baz))
    (is (= (c/screen-state-at frames 13) :baz))))

(deftest next-frames-test
  (let [frames [[2 :a] [4 :b] [6 :c]]]
    (is (= (c/next-frames frames 0) [[2 :a] [4 :b] [6 :c]]))
    (is (= (c/next-frames frames 1) [[1 :a] [4 :b] [6 :c]]))
    (is (= (c/next-frames frames 2) [[4 :b] [6 :c]]))
    (is (= (c/next-frames frames 3) [[3 :b] [6 :c]]))
    (is (= (c/next-frames frames 4) [[2 :b] [6 :c]]))
    (is (= (c/next-frames frames 5) [[1 :b] [6 :c]]))
    (is (= (c/next-frames frames 6) [[6 :c]]))
    (is (= (c/next-frames frames 11) [[1 :c]]))
    (is (= (c/next-frames frames 12) []))
    (is (= (c/next-frames frames 13) []))))

(deftest fix-diffs-test
  (let [diffs [[1.2 {:lines {:0 [["foo" {:fg 1}]] :1 [["bar" {:bg 2}]]} :cursor {:x 1 :y 2 :visible false}}]]]
    (is (= (c/fix-diffs diffs) [[1.2 {:lines {0 [["foo" {:fg 1}]] 1 [["bar" {:bg 2}]]} :cursor {:x 1 :y 2 :visible false}}]]))))

(ns asciinema-player.core-test
  (:require-macros [cljs.test :refer (is deftest testing)])
  (:require [cljs.test]
            [asciinema-player.core :as c]))

(deftest make-player-test
  (let [make-player #(c/make-player "https://..." %)]
    (let [player (make-player {})]
      (is (= (:width player) nil))
      (is (= (:height player) nil))
      (is (= (:asciicast-url player) "https://..."))
      (is (= (:duration player) 0))
      (is (= (:start-at player) 0))
      (is (= (:current-time player) 0))
      (is (= (:theme player) "asciinema"))
      (is (= (:font-size player) "small"))
      (is (= (:speed player) 1))
      (is (= (:auto-play player) false))
      (is (= (:loop player) nil)))
    (let [player (make-player {:width 100 :height 40 :speed 3 :theme "tango" :font-size "big" :loop true :author "me"})]
      (is (= (:width player) 100))
      (is (= (:height player) 40))
      (is (= (:speed player) 3))
      (is (= (:theme player) "tango"))
      (is (= (:font-size player) "big"))
      (is (= (:loop player) true))
      (is (= (:author player) "me")))
    (let [player (make-player {:start-at 15})]
      (is (= (:start-at player) 15))
      (is (= (:current-time player) 15))
      (is (= (:auto-play player) true)))
    (let [player (make-player {:start-at 15 :auto-play false})]
      (is (= (:start-at player) 15))
      (is (= (:current-time player) 15))
      (is (= (:auto-play player) false)))
    (let [player (make-player {:snapshot [[["foo" {}] ["bar" {:fg 1}]] [["baz" {:bg 2}]]]})]
      (is (= (:lines player) [[["foo" {}] ["bar" {:fg 1}]] [["baz" {:bg 2}]]])))))

(deftest update-screen-test
  (let [frame-fn #(update-in % [:cursor :y] inc)
        state {:lines {2 :a}
               :cursor {:y 5}
               :frame-fn frame-fn}
        changes {:lines {1 :b 3 :d}
                 :cursor {:x 1 :y 2 :visible true}
                 :unknown true}]
    (is (= (c/update-screen state changes) {:lines {1 :b 3 :d}
                                            :cursor {:x 1 :y 3 :visible true}
                                            :frame-fn frame-fn}))))

(deftest new-position-test
  (is (= (c/new-position 2 5 -3) 0.0))
  (is (= (c/new-position 2 5 -1) 0.2))
  (is (= (c/new-position 2 5 4) 1.0))
  (is (= (c/new-position 2 5 2) 0.8)))

(deftest screen-state-at-test
  (let [frames [[5 :foo] [3 :bar] [4 :baz]]]
    (is (= (c/screen-state-at frames 0) nil))
    (is (= (c/screen-state-at frames 1) nil))
    (is (= (c/screen-state-at frames 2) nil))
    (is (= (c/screen-state-at frames 3) nil))
    (is (= (c/screen-state-at frames 4) nil))
    (is (= (c/screen-state-at frames 5) :foo))
    (is (= (c/screen-state-at frames 6) :foo))
    (is (= (c/screen-state-at frames 7) :foo))
    (is (= (c/screen-state-at frames 8) :bar))
    (is (= (c/screen-state-at frames 9) :bar))
    (is (= (c/screen-state-at frames 10) :bar))
    (is (= (c/screen-state-at frames 11) :bar))
    (is (= (c/screen-state-at frames 12) :baz))
    (is (= (c/screen-state-at frames 13) :baz))))

(deftest next-frames-test
  (let [frames [[2 :a] [4 :b] [6 :c]]]
    (is (= (c/next-frames frames 0) [[2 :a] [4 :b] [6 :c]]))
    (is (= (c/next-frames frames 1) [[1 :a] [4 :b] [6 :c]]))
    (is (= (c/next-frames frames 2) [[4 :b] [6 :c]]))
    (is (= (c/next-frames frames 3) [[3 :b] [6 :c]]))
    (is (= (c/next-frames frames 4) [[2 :b] [6 :c]]))
    (is (= (c/next-frames frames 5) [[1 :b] [6 :c]]))
    (is (= (c/next-frames frames 6) [[6 :c]]))
    (is (= (c/next-frames frames 11) [[1 :c]]))
    (is (= (c/next-frames frames 12) []))
    (is (= (c/next-frames frames 13) []))))

(deftest fix-diffs-test
  (let [diffs [[1.2 {:lines {:0 [["foo" {:fg 1}]] :1 [["bar" {:bg 2}]]} :cursor {:x 1 :y 2 :visible false}}]]]
    (is (= (c/fix-diffs diffs) [[1.2 {:lines {0 [["foo" {:fg 1}]] 1 [["bar" {:bg 2}]]} :cursor {:x 1 :y 2 :visible false}}]]))))

Fix tests

Fix tests


(ns tropology.test.db-nodes
  (:refer-clojure :exclude [update])
  (:require [clojure.test :refer :all]
            [korma.core :refer :all]
            [taoensso.timbre.profiling :as prof]
            [tropology.db :refer :all]
            [tropology.base :as b]
            [clojure.string :as s]
            [tropology.db :as db]
            [tropology.parsing :as p]
            [tropology.test.parsing :as tp]
            [tropology.s3 :as s3]))

(defn wipe-test-db []
  (delete contents)
  (delete links)
  (delete pages))

;
; Test node creation and tagging
;

(defn sanitize-test-data [data]
  (let [code (:code data)]
    (->> (merge data {:code (s/lower-case code)})
         (merge {:display code}))))

(defn create-node!
  "Creates a node directly."
  [data-items]
  (let [data (timestamp-create (sanitize-test-data data-items))
        _    (db/save-page! data)]
    (db/query-by-code (:code data))))

(defn relate-nodes!
  "Links two nodes by a relationship"
  [rel n1 n2]
  (insert db/links (values {:from-code (:code n1) :to-code (:code n2) :type (name rel)})))

;
; Helper functions
;

(defn basic-test-node [code]
  {:code (s/lower-case code) :display code :title "Test node" :url "http://localhost/" :type "Test"})

(defn get-all-articles []
  (->> (select pages)
       (map db/rename-db-keywords)
       ))

(defn get-all-article-rels []
  (->> (select links)
       (map db/rename-db-keywords)))

(defn get-all-contents []
  (select contents))

;
; Tests
;

(deftest test-create-node
  (wipe-test-db)
  (let [node (create-node! {:code "TestNode/First" :next-update 5 :url "http://localhost/"})]
    (is (not= node nil))
    (are [path result] (= (get-in node path) result)
                       [:code] "testnode/first"
                       [:next-update] 5
                       [:url] "http://localhost/")))

(deftest test-create-page
  (wipe-test-db)
  ; Test single page creation
  (let [_    (create-page-and-links! (assoc (basic-test-node "TestNode/First")
                                       :html "Basic test node"))
        all  (get-all-articles)
        item (first all)]
    (is (= 1 (count all)))
    (are [k v] (= v (k item))
               :code "testnode/first"
               :display "TestNode/First"
               :title "Test node"
               :url "http://localhost/"
               :type "Test"
               ; Review defaults
               :category nil
               :image nil
               :size 15
               :has-error false
               :is-redirect false))
  ; Test creating linked nodes
  (let [linked ["L/N1" "L/N2" "L/N3" "L/N4"]
        urls   (map #(str b/base-url %) linked)
        _      (create-page-and-links! (basic-test-node "TestNode/Links")
                                       :LINKSTO
                                       (map p/node-data-from-url urls)
                                       {:is-redirect false})
        all    (get-all-articles)
        item   (first (filter #(= "TestNode/Links" (:display %)) all))]
    (is (= 6 (count all)))                                  ; Five we created, and the existing one
    (doseq [k linked]
      (is (not-empty (filter #(= (s/lower-case k) (:code %)) all))))
    (are [k v] (= v (k item))
               :code "testnode/links"
               :display "TestNode/Links"
               :title "Test node"
               :url "http://localhost/"
               :type "Test"
               ; Review defaults
               :category nil
               :image nil
               :has-error false
               :is-redirect false))
  )

(deftest test-create-node-assigns-timestamps
  (wipe-test-db)
  (let [node (create-node! (basic-test-node "TestNode/First"))]
    (is (not= node nil))
    (are [path] (> (get-in node path) 0)
                [:time-stamp]
                [:next-update])))

(deftest test-query-by-code
  (wipe-test-db)
  (is (nil? (query-by-code "TestNode/ForQuerying")))
  (is (nil? (query-by-code nil)))
  (let [_    (create-page-and-links! (basic-test-node "TestNode/ForQuerying"))
        node (query-by-code "TestNode/ForQuerying")]
    (is (not= node nil))
    (are [path result] (= result (node path))
                       :code "testnode/forquerying"
                       :display "TestNode/ForQuerying"
                       )))

(deftest test-get-string
  (s3/put-string! "test-code" "Some HTML message that isn't very long")
  (is (= 38 (count (s3/get-string "test-code"))))
  (is (nil? (s3/get-string "invalid-code")))
  (println "Yes, we were supposed to get an AmazonS3Exception exception logged up there. ⤴")
  )

(deftest test-query-nodes-when-empty
  (wipe-test-db)
  (is (= (count (query-nodes-to-crawl 100)) 0))
  (is (= (query-nodes-to-crawl 100) '())))

(defn create-nodes!
  ([n is-redirect]
   (create-nodes! n is-redirect 0))
  ([n is-redirect base-n]
   (dotimes [s n]
     (let [i (+ s base-n)]
       (create-node! {:code        (str "TestNode/" i)
                      :display     (str "TestNode/" i)
                      :next-update i
                      :url         (str i)                  ; Keep the i as the url for ease of testing
                      :type        "Test"
                      :title       (str "Test node " i)
                      :is-redirect is-redirect
                      :size        (inc i)                  ; Add a fake size
                      :has-error   false})))))

(defn create-contents!
  ([n file-path]
   (create-contents! n file-path 0))
  ([n file-path base-n]
   (let [html (slurp (str tp/test-file-path file-path))]
     (dotimes [s n]
       (s3/put-string! (str "TestNode/" (+ s base-n)) html)
       )
     )))

(deftest test-fetch-random-code
  (wipe-test-db)
  (create-nodes! 50 false)
  (create-contents! 10 "TakeMeInstead-pruned.html")
  (is (= 50 (count (get-all-articles))))
  (dotimes [_ 100]
    ; Run this a few times to ensure we can always get a random code
    (is (not-empty (db/fetch-random-contents-code)))
    ))

(deftest test-query-nodes-node-limit
  (wipe-test-db)
  (create-nodes! 30 false)                                  ; Create non-redirect nodes
  (is (= 30 (count (query-nodes-to-crawl 100))))
  (is (= 15 (count (query-nodes-to-crawl 15))))
  (is (= (query-nodes-to-crawl 0) '())))

(deftest test-query-nodes-node-skip-errors
  (wipe-test-db)
  (create-nodes! 30 false)
  (log-error! {:code "TestNode/10" :url "10" :has-error true :error "Oopsy"})
  (is (= (count (query-nodes-to-crawl 100)) 29))            ; We skip the error node
  (is (= (count (query-nodes-to-crawl 15)) 15))             ; We can still find 15 nodes to crawl
  )

(deftest test-query-nodes-time-limit
  (wipe-test-db)
  (create-nodes! 15 false)
  (create-nodes! 3 true 20)
  (dotimes [i 16]
    (is (= (count (query-nodes-to-crawl 100 i)) i)))        ; The number of nodes where the nextupdate time is under i is the i itself
  (is (= (count (query-nodes-to-crawl 100 20)) 15))         ; All nodes are older than 100, we should get all
  (is (every?
        #(< (Integer. %) 5)                                 ; We were keeping in the URL, which will be the returned value, the same limit...
        (query-nodes-to-crawl 20 5)))                       ; ... so we can check every node returned is indeed under
  )

(deftest test-query-nodes-sort-order
  (wipe-test-db)
  (create-nodes! 20 false)
  (dotimes [i 16]
    ; We are going to limit the number of nodes every time we query.
    ; Given that the nextupdate is used as the url (for this test), and
    ; that the nodes should be sorted by nextupdate, every url returned
    ; should be lower than the limit
    (is (every?
          #(< (Integer. %) i)
          (query-nodes-to-crawl i)))
    ))

(deftest test-relate-nodes
  (wipe-test-db)
  (let [n1  (create-node! (basic-test-node "TestNode/N1"))
        n2  (create-node! (basic-test-node "TestNode/N2"))
        rel (relate-nodes! :LINKSTO n1 n2)]
    (is (not= rel nil))
    (are [query result] (= query result)
                        (:type rel) "LINKSTO"
                        (:start rel) (:location-uri n1)
                        (:end rel) (:location-uri n2))
    ))

(deftest test-query-from
  (wipe-test-db)
  (let [n1 (create-node! (basic-test-node "TestNode/N1"))
        n2 (create-node! (basic-test-node "TestNode/N2"))
        n3 (create-node! (basic-test-node "TestNode/N3"))
        _  (relate-nodes! :LINKSTO n1 n2)
        _  (relate-nodes! :LINKSTO n1 n3)
        _  (relate-nodes! :LINKSTO n2 n3)
        ]
    (let [r (query-from "TestNode/N1" :LINKSTO)]
      (is (= (count r) 2))
      (is (some #(= (:display %) "TestNode/N2") r))
      (is (some #(= (:display %) "TestNode/N3") r)))
    (let [r (query-from "TestNode/N2" :LINKSTO)]
      (is (= (count r) 1))
      (is (some #(= (:display %) "TestNode/N3") r)))
    (let [r (query-from "TestNode/N3" :LINKSTO)]
      (is (empty? r)))
    ))

(deftest test-query-to
  (wipe-test-db)
  (let [n1 (create-node! (basic-test-node "TestNode/N1"))
        n2 (create-node! (basic-test-node "TestNode/N2"))
        n3 (create-node! (basic-test-node "TestNode/N3"))
        _  (relate-nodes! :LINKSTO n1 n2)
        _  (relate-nodes! :LINKSTO n1 n3)
        _  (relate-nodes! :LINKSTO n2 n3)
        ]
    (let [r (query-to :LINKSTO "TestNode/N3")]
      (is (= (count r) 2))
      (is (some #(= (:display %) "TestNode/N1") r))
      (is (some #(= (:display %) "TestNode/N2") r)))
    (let [r (query-to :LINKSTO "TestNode/N2")]
      (is (= (count r) 1))
      (is (some #(= (:display %) "TestNode/N1") r)))
    (let [r (query-to :LINKSTO "TestNode/N1")]
      (is (empty? r)))
    ))

(deftest test-common-from
  (wipe-test-db)
  (let [n1 (create-node! (-> (basic-test-node "TestNode/N1") (assoc :incoming 100)))
        n2 (create-node! (-> (basic-test-node "TestNode/N2") (assoc :incoming 500))) ; To test limits later
        n3 (create-node! (-> (basic-test-node "TestNode/N3") (assoc :incoming 100)))
        n4 (create-node! (-> (basic-test-node "TestNode/N4") (assoc :incoming 100)))
        n5 (create-node! (-> (basic-test-node "TestNode/N5") (assoc :incoming 100)))
        n6 (create-node! (-> (basic-test-node "TestNode/N6") (assoc :incoming 100)))
        _  (relate-nodes! :LINKSTO n1 n2)
        _  (relate-nodes! :LINKSTO n1 n3)
        _  (relate-nodes! :LINKSTO n1 n5)
        _  (relate-nodes! :LINKSTO n1 n6)
        _  (relate-nodes! :LINKSTO n2 n3)
        _  (relate-nodes! :LINKSTO n2 n4)
        _  (relate-nodes! :LINKSTO n3 n4)
        _  (relate-nodes! :LINKSTO n3 n5)
        _  (relate-nodes! :LINKSTO n4 n5)
        _  (relate-nodes! :LINKSTO n4 n6)
        _  (relate-nodes! :DIFFREL n1 n4)                   ; To be excluded in most tests below
        _  (relate-nodes! :DIFFREL n1 n3)                   ; To be excluded in most tests below
        _  (relate-nodes! :DIFFREL n3 n4)                   ; To be excluded in most tests below
        ]
    ; Test relationships
    (let [r (query-common-nodes-from "TestNode/N3")]
      (is (= 4 (count r)))                                  ; N1 links out to N2 and N5, and both are related to N3. So is N4.
      (are [from to] (some #(and (= (:to-code %) to) (= (:from-code %) from)) r)
                     "testnode/n1" "testnode/n2"
                     "testnode/n1" "testnode/n5"
                     "testnode/n2" "testnode/n4"
                     "testnode/n4" "testnode/n5"))
    (let [r (query-common-nodes-from "TestNode/N1")]
      (is (= 2 (count r)))
      (are [from to] (some #(and (= (:to-code %) to) (= (:from-code %) from)) r)
                     "testnode/n2" "testnode/n3"
                     "testnode/n3" "testnode/n5"))
    ; Test incoming limits
    (let [r (query-common-nodes-from "TestNode/N3" :LINKSTO 400)]
      (is (= 2 (count r)))                                  ; N2 is excluded because of too many incoming links
      (are [from to] (some #(and (= (:to-code %) to) (= (:from-code %) from)) r)
                     "testnode/n1" "testnode/n5"
                     "testnode/n4" "testnode/n5")
      )
    ; Test link relationship types
    (let [r (query-common-nodes-from "TestNode/N3" :DIFFREL 1000)]
      (is (= 1 (count r)))                                  ; Only one node in common with that relationship type
      (is (some #(= (:to-code %) "testnode/n4") r)))

    ))

(ns tropology.test.db-nodes
  (:refer-clojure :exclude [update])
  (:require [clojure.test :refer :all]
            [korma.core :refer :all]
            [taoensso.timbre.profiling :as prof]
            [tropology.db :refer :all]
            [tropology.base :as b]
            [clojure.string :as s]
            [tropology.db :as db]
            [tropology.parsing :as p]
            [tropology.test.parsing :as tp]
            [tropology.s3 :as s3]))

(defn wipe-test-db []
  (delete contents)
  (delete links)
  (delete pages))

;
; Test node creation and tagging
;

(defn sanitize-test-data [data]
  (let [code (:code data)]
    (->> (merge data {:code (s/lower-case code)})
         (merge {:display code}))))

(defn create-node!
  "Creates a node directly."
  [data-items]
  (let [data (timestamp-create (sanitize-test-data data-items))
        _    (db/save-page! data)]
    (db/query-by-code (:code data))))

(defn relate-nodes!
  "Links two nodes by a relationship"
  [rel n1 n2]
  (insert db/links (values {:from-code (:code n1) :to-code (:code n2) :type (name rel)})))

;
; Helper functions
;

(defn basic-test-node [code]
  {:code (s/lower-case code) :display code :title "Test node" :url "http://localhost/" :type "Test"})

(defn get-all-articles []
  (->> (select pages)
       (map db/rename-db-keywords)
       ))

(defn get-all-article-rels []
  (->> (select links)
       (map db/rename-db-keywords)))

;
; Tests
;

(deftest test-create-node
  (wipe-test-db)
  (let [node (create-node! {:code "TestNode/First" :next-update 5 :url "http://localhost/"})]
    (is (not= node nil))
    (are [path result] (= (get-in node path) result)
                       [:code] "testnode/first"
                       [:next-update] 5
                       [:url] "http://localhost/")))

(deftest test-create-page
  (wipe-test-db)
  ; Test single page creation
  (let [_    (create-page-and-links! (assoc (basic-test-node "TestNode/First")
                                       :html "Basic test node"))
        all  (get-all-articles)
        item (first all)]
    (is (= 1 (count all)))
    (are [k v] (= v (k item))
               :code "testnode/first"
               :display "TestNode/First"
               :title "Test node"
               :url "http://localhost/"
               :type "Test"
               ; Review defaults
               :category nil
               :image nil
               :size 15
               :has-error false
               :is-redirect false))
  ; Test creating linked nodes
  (let [linked ["L/N1" "L/N2" "L/N3" "L/N4"]
        urls   (map #(str b/base-url %) linked)
        _      (create-page-and-links! (basic-test-node "TestNode/Links")
                                       :LINKSTO
                                       (map p/node-data-from-url urls)
                                       {:is-redirect false})
        all    (get-all-articles)
        item   (first (filter #(= "TestNode/Links" (:display %)) all))]
    (is (= 6 (count all)))                                  ; Five we created, and the existing one
    (doseq [k linked]
      (is (not-empty (filter #(= (s/lower-case k) (:code %)) all))))
    (are [k v] (= v (k item))
               :code "testnode/links"
               :display "TestNode/Links"
               :title "Test node"
               :url "http://localhost/"
               :type "Test"
               ; Review defaults
               :category nil
               :image nil
               :has-error false
               :is-redirect false))
  )

(deftest test-create-node-assigns-timestamps
  (wipe-test-db)
  (let [node (create-node! (basic-test-node "TestNode/First"))]
    (is (not= node nil))
    (are [path] (> (get-in node path) 0)
                [:time-stamp]
                [:next-update])))

(deftest test-query-by-code
  (wipe-test-db)
  (is (nil? (query-by-code "TestNode/ForQuerying")))
  (is (nil? (query-by-code nil)))
  (let [_    (create-page-and-links! (basic-test-node "TestNode/ForQuerying"))
        node (query-by-code "TestNode/ForQuerying")]
    (is (not= node nil))
    (are [path result] (= result (node path))
                       :code "testnode/forquerying"
                       :display "TestNode/ForQuerying"
                       )))

(deftest test-get-string
  (s3/put-string! "test-code" "Some HTML message that isn't very long")
  (is (= 38 (count (s3/get-string "test-code"))))
  (is (nil? (s3/get-string "invalid-code")))
  (println "Yes, we were supposed to get an AmazonS3Exception exception logged up there. ⤴")
  )

(deftest test-query-nodes-when-empty
  (wipe-test-db)
  (is (= (count (query-nodes-to-crawl 100)) 0))
  (is (= (query-nodes-to-crawl 100) '())))

(defn create-nodes!
  ([n is-redirect]
   (create-nodes! n is-redirect 0))
  ([n is-redirect base-n]
   (dotimes [s n]
     (let [i (+ s base-n)]
       (create-node! {:code        (str "TestNode/" i)
                      :display     (str "TestNode/" i)
                      :next-update i
                      :url         (str i)                  ; Keep the i as the url for ease of testing
                      :type        "Test"
                      :title       (str "Test node " i)
                      :is-redirect is-redirect
                      :size        (inc i)                  ; Add a fake size
                      :has-error   false})))))

(defn create-contents!
  ([n file-path]
   (create-contents! n file-path 0))
  ([n file-path base-n]
   (let [html (slurp (str tp/test-file-path file-path))]
     (dotimes [s n]
       (s3/put-string! (str "TestNode/" (+ s base-n)) html)
       )
     )))

(deftest test-fetch-random-code
  (wipe-test-db)
  (create-nodes! 50 false)
  (create-contents! 10 "TakeMeInstead-pruned.html")
  (is (= 50 (count (get-all-articles))))
  (dotimes [_ 100]
    ; Run this a few times to ensure we can always get a random code
    (is (not-empty (db/fetch-random-contents-code)))
    ))

(deftest test-query-nodes-node-limit
  (wipe-test-db)
  (create-nodes! 30 false)                                  ; Create non-redirect nodes
  (is (= 30 (count (query-nodes-to-crawl 100))))
  (is (= 15 (count (query-nodes-to-crawl 15))))
  (is (= (query-nodes-to-crawl 0) '())))

(deftest test-query-nodes-node-skip-errors
  (wipe-test-db)
  (create-nodes! 30 false)
  (log-error! {:code "TestNode/10" :url "10" :has-error true :error "Oopsy"})
  (is (= (count (query-nodes-to-crawl 100)) 29))            ; We skip the error node
  (is (= (count (query-nodes-to-crawl 15)) 15))             ; We can still find 15 nodes to crawl
  )

(deftest test-query-nodes-time-limit
  (wipe-test-db)
  (create-nodes! 15 false)
  (create-nodes! 3 true 20)
  (dotimes [i 16]
    (is (= (count (query-nodes-to-crawl 100 i)) i)))        ; The number of nodes where the nextupdate time is under i is the i itself
  (is (= (count (query-nodes-to-crawl 100 20)) 15))         ; All nodes are older than 100, we should get all
  (is (every?
        #(< (Integer. %) 5)                                 ; We were keeping in the URL, which will be the returned value, the same limit...
        (query-nodes-to-crawl 20 5)))                       ; ... so we can check every node returned is indeed under
  )

(deftest test-query-nodes-sort-order
  (wipe-test-db)
  (create-nodes! 20 false)
  (dotimes [i 16]
    ; We are going to limit the number of nodes every time we query.
    ; Given that the nextupdate is used as the url (for this test), and
    ; that the nodes should be sorted by nextupdate, every url returned
    ; should be lower than the limit
    (is (every?
          #(< (Integer. %) i)
          (query-nodes-to-crawl i)))
    ))

(deftest test-relate-nodes
  (wipe-test-db)
  (let [n1  (create-node! (basic-test-node "TestNode/N1"))
        n2  (create-node! (basic-test-node "TestNode/N2"))
        rel (relate-nodes! :LINKSTO n1 n2)]
    (is (not= rel nil))
    (are [query result] (= query result)
                        (:type rel) "LINKSTO"
                        (:start rel) (:location-uri n1)
                        (:end rel) (:location-uri n2))
    ))

(deftest test-query-from
  (wipe-test-db)
  (let [n1 (create-node! (basic-test-node "TestNode/N1"))
        n2 (create-node! (basic-test-node "TestNode/N2"))
        n3 (create-node! (basic-test-node "TestNode/N3"))
        _  (relate-nodes! :LINKSTO n1 n2)
        _  (relate-nodes! :LINKSTO n1 n3)
        _  (relate-nodes! :LINKSTO n2 n3)
        ]
    (let [r (query-from "TestNode/N1" :LINKSTO)]
      (is (= (count r) 2))
      (is (some #(= (:display %) "TestNode/N2") r))
      (is (some #(= (:display %) "TestNode/N3") r)))
    (let [r (query-from "TestNode/N2" :LINKSTO)]
      (is (= (count r) 1))
      (is (some #(= (:display %) "TestNode/N3") r)))
    (let [r (query-from "TestNode/N3" :LINKSTO)]
      (is (empty? r)))
    ))

(deftest test-query-to
  (wipe-test-db)
  (let [n1 (create-node! (basic-test-node "TestNode/N1"))
        n2 (create-node! (basic-test-node "TestNode/N2"))
        n3 (create-node! (basic-test-node "TestNode/N3"))
        _  (relate-nodes! :LINKSTO n1 n2)
        _  (relate-nodes! :LINKSTO n1 n3)
        _  (relate-nodes! :LINKSTO n2 n3)
        ]
    (let [r (query-to :LINKSTO "TestNode/N3")]
      (is (= (count r) 2))
      (is (some #(= (:display %) "TestNode/N1") r))
      (is (some #(= (:display %) "TestNode/N2") r)))
    (let [r (query-to :LINKSTO "TestNode/N2")]
      (is (= (count r) 1))
      (is (some #(= (:display %) "TestNode/N1") r)))
    (let [r (query-to :LINKSTO "TestNode/N1")]
      (is (empty? r)))
    ))

(deftest test-common-from
  (wipe-test-db)
  (let [n1 (create-node! (-> (basic-test-node "TestNode/N1") (assoc :incoming 100)))
        n2 (create-node! (-> (basic-test-node "TestNode/N2") (assoc :incoming 500))) ; To test limits later
        n3 (create-node! (-> (basic-test-node "TestNode/N3") (assoc :incoming 100)))
        n4 (create-node! (-> (basic-test-node "TestNode/N4") (assoc :incoming 100)))
        n5 (create-node! (-> (basic-test-node "TestNode/N5") (assoc :incoming 100)))
        n6 (create-node! (-> (basic-test-node "TestNode/N6") (assoc :incoming 100)))
        _  (relate-nodes! :LINKSTO n1 n2)
        _  (relate-nodes! :LINKSTO n1 n3)
        _  (relate-nodes! :LINKSTO n1 n5)
        _  (relate-nodes! :LINKSTO n1 n6)
        _  (relate-nodes! :LINKSTO n2 n3)
        _  (relate-nodes! :LINKSTO n2 n4)
        _  (relate-nodes! :LINKSTO n3 n4)
        _  (relate-nodes! :LINKSTO n3 n5)
        _  (relate-nodes! :LINKSTO n4 n5)
        _  (relate-nodes! :LINKSTO n4 n6)
        _  (relate-nodes! :DIFFREL n1 n4)                   ; To be excluded in most tests below
        _  (relate-nodes! :DIFFREL n1 n3)                   ; To be excluded in most tests below
        _  (relate-nodes! :DIFFREL n3 n4)                   ; To be excluded in most tests below
        ]
    ; Test relationships
    (let [r (query-common-nodes-from "TestNode/N3")]
      (is (= 4 (count r)))                                  ; N1 links out to N2 and N5, and both are related to N3. So is N4.
      (are [from to] (some #(and (= (:to-code %) to) (= (:from-code %) from)) r)
                     "testnode/n1" "testnode/n2"
                     "testnode/n1" "testnode/n5"
                     "testnode/n2" "testnode/n4"
                     "testnode/n4" "testnode/n5"))
    (let [r (query-common-nodes-from "TestNode/N1")]
      (is (= 2 (count r)))
      (are [from to] (some #(and (= (:to-code %) to) (= (:from-code %) from)) r)
                     "testnode/n2" "testnode/n3"
                     "testnode/n3" "testnode/n5"))
    ; Test incoming limits
    (let [r (query-common-nodes-from "TestNode/N3" :LINKSTO 400)]
      (is (= 2 (count r)))                                  ; N2 is excluded because of too many incoming links
      (are [from to] (some #(and (= (:to-code %) to) (= (:from-code %) from)) r)
                     "testnode/n1" "testnode/n5"
                     "testnode/n4" "testnode/n5")
      )
    ; Test link relationship types
    (let [r (query-common-nodes-from "TestNode/N3" :DIFFREL 1000)]
      (is (= 1 (count r)))                                  ; Only one node in common with that relationship type
      (is (some #(= (:to-code %) "testnode/n4") r)))

    ))

Test function get-all-contents is no longer relevant after using S3


(ns zaffre.components.render
  (:require [clojure.test :refer [is]]
            [taoensso.timbre :as log]
            [zaffre.components :as zc]
            [zaffre.terminal :as zt]))

;; Env functions

(defn wrap-env [parent child key]
  {
    :key key
    :style (get (second child) :style {})
    ;:env/props (assoc (second child)
    ;                  :children (drop 2 child))
    :parent parent
  })

(defn env-path [env]
  (if (nil? env)
    []
    (cons (get env :key) (env-path (get env :parent)))))

(defn env-path->str [env]
  (apply str (interpose " > " (reverse (env-path env)))))

;; Primitive elements
(def primitive-elements #{:terminal :group :layer :view :text})
(defn primitive? [component]
  (or (string? component)
      (contains? primitive-elements (first component))))

;; Recursively calculate dimensions based on size of child components
;; Finds env in render-state and returns it. If not found,
;; evaluates body and caches result in render-state
(defmacro caching-render [component render-state & body]
  `(let [component# ~component
         render-state# ~render-state
         k# component#]
     (log/trace "render-state val" render-state# (contains? (deref render-state#) k#))
     ;; either get the cached value, or generate, cache and return it
     ;; use or instead of default value for get because get's default value
     ;; is eagerly evaluaged and will swap! every time
     (or
       (get (deref render-state#) k#)
       (let [result# (do ~@body)]
         (when (> (count (deref render-state#)) 10000)
           (reset! render-state# {}))
         (log/trace "swap!-ing render-state" render-state# k#)
         (swap! render-state# #(assoc % k# result#))
         (log/trace "new render-state" (deref render-state#))
         result#))))

(declare render)
(defn render-primitive [env render-state component]
  (log/trace "render-primitive" (env-path->str env) component)
  (caching-render component render-state
    (if (string? component)
      component
      #_[:text {:children [component]}]
      (let [[type props & children] component
            wrapped-env (wrap-env env component type)]
        [type
         (assoc props
                :zaffre/children
                (vec (map-indexed
                       (fn [index child]
                         (render
                           (wrap-env
                             env
                             child
                             (get props :key index))
                           render-state
                           child))
                       children)))]))))

(defn render-composite [env render-state component]
  (log/trace "render-composite" (env-path->str env) (vec component))
  (caching-render component render-state
    (if (string? component)
      (zc/render-comp component {})
      (let [type     (first component)
            props    (or (second component) {})
            children (drop 2 component)
            element  (zc/render-comp type (assoc props :zaffre/children children))]
        (render env render-state element)))))

(defn render
  [env render-state component]
  (log/trace "render" (env-path->str env) component)
  (let [env (wrap-env env component (first component))]
    (caching-render component render-state
      ;; render the component
      (if (primitive? component)
        (render-primitive env render-state component)
        (render-composite env render-state component)))))

(defn flatten-text [parent-style element]
  "Splits text into words and flattens all child text element"
  (lazy-seq
    (if (string? element)
      (let [words (clojure.string/split (clojure.string/trim element) #"\s+")]
        (interpose
          [:text (assoc parent-style :zaffre/children [" "])]
          (map (fn [word] [:text (assoc parent-style :zaffre/children [word])])
            words)))
      (let [[type {:keys [style zaffre/children]}] element]
        (if (= type :text)
          (mapcat (partial flatten-text (merge parent-style style)) children)
          (assert false (format "found non-text element %s" type)))))))

(defn text-length [text-element]
  (-> text-element second :children first count))

(defn space? [text-element]
  (= " " (-> text-element second :children first)))

;; Adapted from https://www.rosettacode.org/wiki/Word_wrap#Clojure
(defn wrap-lines [size style text]
  "Text elements may only contain child text elements"
  (loop [left size line [] lines []
         words (or (flatten-text style text)
                   [[:text {:children [""]}]])]
    (log/trace "wrap-lines words" left style (vec words))
    (if-let [word (first words)]
      (let [wlen (text-length word)
            spacing (if (== left size) "" " ")
            alen (+ (count spacing) wlen)]
        (log/trace "wlen" wlen "spacing" spacing "alen" alen)
        (if (<= alen left)
          (recur (- left alen) (conj line word) lines (next words))
          (if (space? word)
            (recur size [] (conj lines line) (next words))
            (recur (- size wlen) [word] (conj lines line) (next words)))))
      (if (seq line)
        (conj lines line)
        words))))

(defn render-string-into-container [target x y fg bg s]
  (when (< y (count target))
    (let [target-line (aget target y)
          max-x (count target-line)]
    (log/trace "render-string-into-container" x y fg bg s)
    (loop [index 0 s s]
      (let [target-index (+ x index)]
        (when (and (seq s) (< target-index max-x))
          (aset target-line target-index {:c (first s) :fg fg :bg bg})
          (recur (inc index) (rest s))))))))

(def default-style
  {:fg [255 255 255 255]
   :bg [0 0 0 255]
})

(defn render-text-into-container [target text]
  (log/info "render-text-into-container" text)
  (let [[type {:keys [zaffre/style zaffre/layout zaffre/children] :as props}] text
        {:keys [x y width height]} layout
        style (merge default-style style)
        lines (wrap-lines width
                          style
                          text)]
    (log/info "render-text-into-container lines" lines)
    (doseq [[dy line] (map-indexed vector lines)]
      ;; remove inc? for spaces
      (let [offsets (cons 0 (reductions + (map (fn [word] (inc (count (last word)))) line)))]
        (doseq [[dx {:keys [fg bg text]}] (map vector offsets line)]
          (when (< dy height)
            (render-string-into-container target (+ x dx) (+ y dy) fg bg text)))))))

(defn component-seq [component]
  (tree-seq (fn [[_ {:keys [zaffre/children]}]] (every? (comp not string?) children))
            (fn [[_ {:keys [zaffre/children]}]] children)
            component))

(defmulti render-component-into-container (fn [target [type]] type))

;; render text
(defmethod render-component-into-container :text
  [target [type {:keys [zaffre/children zaffre/style zaffre/layout]}]]
  (doseq [child children]
    (render-text-into-container target child)))

;; render views
(defmethod render-component-into-container :view
  [target [type {:keys [zaffre/style zaffre/layout]}]]
    nil)

;; Do nothing for :layer
(defmethod render-component-into-container :layer
  [_ component]
  nil)

;; die if not :layer nor :view nor :text
(defmethod render-component-into-container :default
  [_ component]
  (assert false (format "Found unknown component %s" component)))

(defn render-layer-into-container
  [target layer]
  (log/info "render-layer-into-container" layer)
  (let [descendants (vec (component-seq layer))]
    (log/info "render-layer-into-container descendants" descendants))
  (doseq [descendant (component-seq layer)]
    (render-component-into-container target descendant)))

(defn layer-info [group-info]
  "Given a terminal's group info, create a map layer-id->{:columns rows}."
  (into {}
    (mapcat identity
      (map (fn [{:keys [layers columns rows]}]
             (map (fn [layer-id]
                    [layer-id {:columns columns :rows rows}])
                  layers))
           (vals group-info)))))

;; Renders component into container. Does not call refresh! on container
(defn render-into-container
  [target render-state component]
  (let [group-info (zt/groups target)
        layer-info (layer-info group-info)
        [type {:keys [children]} :as terminal-element] (render {:style default-style}
                                                               render-state
                                                               component)
        groups children]
    (log/trace "render-into-container" terminal-element)
    (assert (= type :terminal)
            (format "Root component not :terminal found %s instead" type))
    ;; for each group in terminal
    (doseq [[type {:keys [group-id pos children]}] groups
            :let [layers children
                  {:keys [columns rows]} (get group-info group-id)]]
      (assert (= type :group)
              (format "Expected :group found %s instead" type))
      ;; update group pos
      (when pos
        (zt/alter-group-pos! target group-id pos))
      ;; for each layer in group
      (doseq [[type {:keys [layer-id zaffre/style]} :as layer] layers]
        (assert (= type :layer)
                (format "Expected :layer found %s instead" type))
        ;; create a container to hold cells
        (let [layer-container (object-array rows)
              ;; merge layer width height into layer's style
              {:keys [columns rows]} (get layer-info layer-id)
              style (merge style {:width columns :height rows})]
          (doseq [i (range rows)]
            (aset layer-container i (object-array columns)))
          ;; render layer into layer-container
          (render-layer-into-container layer-container  (assoc-in layer [1 :zaffre/style] style))
          ;; replace chars in layer
          (zt/replace-chars! target layer-id layer-container))))))

(ns zaffre.components.render
  (:require [clojure.test :refer [is]]
            [taoensso.timbre :as log]
            [zaffre.components :as zc]
            [zaffre.terminal :as zt]))

;; Env functions

(defn wrap-env [parent child key]
  {
    :key key
    :style (get (second child) :style {})
    ;:env/props (assoc (second child)
    ;                  :children (drop 2 child))
    :parent parent
  })

(defn env-path [env]
  (if (nil? env)
    []
    (cons (get env :key) (env-path (get env :parent)))))

(defn env-path->str [env]
  (apply str (interpose " > " (reverse (env-path env)))))

;; Primitive elements
(def primitive-elements #{:terminal :group :layer :view :text})
(defn primitive? [component]
  (or (string? component)
      (contains? primitive-elements (first component))))

;; Recursively calculate dimensions based on size of child components
;; Finds env in render-state and returns it. If not found,
;; evaluates body and caches result in render-state
(defmacro caching-render [component render-state & body]
  `(let [component# ~component
         render-state# ~render-state
         k# component#]
     (log/trace "render-state val" render-state# (contains? (deref render-state#) k#))
     ;; either get the cached value, or generate, cache and return it
     ;; use or instead of default value for get because get's default value
     ;; is eagerly evaluaged and will swap! every time
     (or
       (get (deref render-state#) k#)
       (let [result# (do ~@body)]
         (when (> (count (deref render-state#)) 10000)
           (reset! render-state# {}))
         (log/trace "swap!-ing render-state" render-state# k#)
         (swap! render-state# #(assoc % k# result#))
         (log/trace "new render-state" (deref render-state#))
         result#))))

(declare render)
(defn render-primitive [env render-state component]
  (log/trace "render-primitive" (env-path->str env) component)
  (caching-render component render-state
    (if (string? component)
      component
      #_[:text {:children [component]}]
      (let [[type props & children] component
            wrapped-env (wrap-env env component type)]
        [type
         (assoc props
                :zaffre/children
                (vec (map-indexed
                       (fn [index child]
                         (render
                           (wrap-env
                             env
                             child
                             (get props :key index))
                           render-state
                           child))
                       children)))]))))

(defn render-composite [env render-state component]
  (log/trace "render-composite" (env-path->str env) (vec component))
  (caching-render component render-state
    (if (string? component)
      (zc/render-comp component {})
      (let [type     (first component)
            props    (or (second component) {})
            children (drop 2 component)
            element  (zc/render-comp type (assoc props :zaffre/children children))]
        (render env render-state element)))))

(defn render
  [env render-state component]
  (log/trace "render" (env-path->str env) component)
  (let [env (wrap-env env component (first component))]
    (caching-render component render-state
      ;; render the component
      (if (primitive? component)
        (render-primitive env render-state component)
        (render-composite env render-state component)))))

(defn flatten-text [parent-style element]
  "Splits text into words and flattens all child text element"
  (lazy-seq
    (if (string? element)
      (let [words (clojure.string/split (clojure.string/trim element) #"\s+")]
        (interpose
          [:text (assoc parent-style :zaffre/children [" "])]
          (map (fn [word] [:text (assoc parent-style :zaffre/children [word])])
            words)))
      (let [[type {:keys [style zaffre/children]}] element]
        (if (= type :text)
          (mapcat (partial flatten-text (merge parent-style style)) children)
          (assert false (format "found non-text element %s" type)))))))

(defn text-length [text-element]
  (-> text-element second :zaffre/children first count))

(defn space? [text-element]
  (= " " (-> text-element second :zaffre/children first)))

;; Adapted from https://www.rosettacode.org/wiki/Word_wrap#Clojure
(defn wrap-lines [size style text]
  "Text elements may only contain child text elements"
  (loop [left size line [] lines []
         words (or (flatten-text style text)
                   [[:text {:children [""]}]])]
    (log/trace "wrap-lines words" left style (vec words))
    (if-let [word (first words)]
      (let [wlen (text-length word)
            spacing (if (== left size) "" " ")
            alen (+ (count spacing) wlen)]
        (log/trace "wlen" wlen "spacing" spacing "alen" alen)
        (if (<= alen left)
          (recur (- left alen) (conj line word) lines (next words))
          (if (space? word)
            (recur size [] (conj lines line) (next words))
            (recur (- size wlen) [word] (conj lines line) (next words)))))
      (if (seq line)
        (conj lines line)
        words))))

(defn render-string-into-container [target x y fg bg s]
  (when (< y (count target))
    (let [target-line (aget target y)
          max-x (count target-line)]
    (log/trace "render-string-into-container" x y fg bg s)
    (loop [index 0 s s]
      (let [target-index (+ x index)]
        (when (and (seq s) (< target-index max-x))
          (aset target-line target-index {:c (first s) :fg fg :bg bg})
          (recur (inc index) (rest s))))))))

(def default-style
  {:fg [255 255 255 255]
   :bg [0 0 0 255]
})

(defn render-text-into-container [target text]
  (log/info "render-text-into-container" text)
  (let [[type {:keys [zaffre/style zaffre/layout zaffre/children] :as props}] text
        {:keys [x y width height]} layout
        style (merge default-style style)
        lines (wrap-lines width
                          style
                          text)]
    (log/info "render-text-into-container lines" lines)
    (doseq [[dy line] (map-indexed vector lines)]
      ;; remove inc? for spaces
      (let [offsets (cons 0 (reductions + (map (fn [word] (inc (count (last word)))) line)))]
        (doseq [[dx {:keys [fg bg text]}] (map vector offsets line)]
          (when (< dy height)
            (render-string-into-container target (+ x dx) (+ y dy) fg bg text)))))))

(defn component-seq [component]
  (tree-seq (fn [[_ {:keys [zaffre/children]}]] (every? (comp not string?) children))
            (fn [[_ {:keys [zaffre/children]}]] children)
            component))

(defmulti render-component-into-container (fn [target [type]] type))

;; render text
(defmethod render-component-into-container :text
  [target [type {:keys [zaffre/children zaffre/style zaffre/layout]}]]
  (doseq [child children]
    (render-text-into-container target child)))

;; render views
(defmethod render-component-into-container :view
  [target [type {:keys [zaffre/style zaffre/layout]}]]
    nil)

;; Do nothing for :layer
(defmethod render-component-into-container :layer
  [_ component]
  nil)

;; die if not :layer nor :view nor :text
(defmethod render-component-into-container :default
  [_ component]
  (assert false (format "Found unknown component %s" component)))

(defn render-layer-into-container
  [target layer]
  (log/info "render-layer-into-container" layer)
  (let [descendants (vec (component-seq layer))]
    (log/info "render-layer-into-container descendants" descendants))
  (doseq [descendant (component-seq layer)]
    (render-component-into-container target descendant)))

(defn layer-info [group-info]
  "Given a terminal's group info, create a map layer-id->{:columns rows}."
  (into {}
    (mapcat identity
      (map (fn [{:keys [layers columns rows]}]
             (map (fn [layer-id]
                    [layer-id {:columns columns :rows rows}])
                  layers))
           (vals group-info)))))

;; Renders component into container. Does not call refresh! on container
(defn render-into-container
  [target render-state component]
  (let [group-info (zt/groups target)
        layer-info (layer-info group-info)
        [type {:keys [children]} :as terminal-element] (render {:style default-style}
                                                               render-state
                                                               component)
        groups children]
    (log/trace "render-into-container" terminal-element)
    (assert (= type :terminal)
            (format "Root component not :terminal found %s instead" type))
    ;; for each group in terminal
    (doseq [[type {:keys [group-id pos children]}] groups
            :let [layers children
                  {:keys [columns rows]} (get group-info group-id)]]
      (assert (= type :group)
              (format "Expected :group found %s instead" type))
      ;; update group pos
      (when pos
        (zt/alter-group-pos! target group-id pos))
      ;; for each layer in group
      (doseq [[type {:keys [layer-id zaffre/style]} :as layer] layers]
        (assert (= type :layer)
                (format "Expected :layer found %s instead" type))
        ;; create a container to hold cells
        (let [layer-container (object-array rows)
              ;; merge layer width height into layer's style
              {:keys [columns rows]} (get layer-info layer-id)
              style (merge style {:width columns :height rows})]
          (doseq [i (range rows)]
            (aset layer-container i (object-array columns)))
          ;; render layer into layer-container
          (render-layer-into-container layer-container  (assoc-in layer [1 :zaffre/style] style))
          ;; replace chars in layer
          (zt/replace-chars! target layer-id layer-container))))))

Fix test

Fix test


(ns videotest.coral.coral
  (:require
   [quil.core :as q]
   [videotest.coral.color :as color]
   [videotest.coral.hex :as hex]
   [videotest.sound.sound :as sound]))

;; (def NUM-CORAL-COL-BINS 64.0)
;; (def HEX-W 10.0)
(def NUM-CORAL-COL-BINS 110.0)
(def HEX-W 10.6)
(def CORAL-STROKE-WEIGHT 2.0)

(def CORAL-ROT-CYCLE 120)

(def BOTTOM-ATTACH-PCT 0.1)

;; 127.5 = 180 degress (max on 0-255 scale)
;; 21.25 = 30 degrees (on 0-255 scale)
(def HUE-DIFF-CLIQUEY-THRESH-MAX 21.25)

(defn coral-size [display-w display-h]
  (let [col-bins NUM-CORAL-COL-BINS
        cell-w (/ display-w col-bins)
        row-bins (/ display-h cell-w)
        hex-w HEX-W]
    {:num-col-bins col-bins
     :num-row-bins row-bins
     :cell-w cell-w
     :cell-half-w (/ cell-w 2.0)
     :hex-w hex-w
     :hex-half-w (/ hex-w 2.0)
     :hex-y-offset (hex/hex-y-offset hex-w)
     :rot-cycle-length CORAL-ROT-CYCLE
     :rot-cycle 0
     :rot-cycle2 0
     :odd-col-lower true}))

(defn x->col [cell-w x]
  (int (/ x cell-w)))

(defn y->row [cell-w y]
  (int (/ y cell-w)))

(defn xy->coords
  ([cell-w [x y]]
     (xy->coords cell-w x y))
  ([cell-w x y]
     (let [col (x->col cell-w x)
           row (y->row cell-w y)]
       [col row])))

(defn is-bottom? [num-rows row]
  (<= (dec num-rows) row))

(defn is-occupied? [coral coords]
  (contains? coral coords))

(defn occupied-coral-under
  ([coral [col row :as coords]]
     (occupied-coral-under true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-plus (inc row)
           under-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row]
                           [     col  row-plus]
                           [(inc col) row]]
                          [[(dec col) row-plus]
                           [     col  row-plus]
                           [(inc col) row-plus]])]
       (filter #(is-occupied? coral %) under-coords))))

(defn occupied-coral-above
  ([coral [col row :as coords]]
     (occupied-coral-above true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-minus (dec row)
           other-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row-minus]
                           [     col  row-minus]
                           [(inc col) row-minus]]
                          [[(dec col) row]
                           [     col  row-minus]
                           [(inc col) row]])]
       (filter #(is-occupied? coral %) other-coords))))

#_(defn is-row-under-occupied? [coral [col row]]
  (seq (occupied-coral-under coral [col row])))

(defn is-leaf? [odd-col-lower coral [col row :as coords]]
  (not (seq (occupied-coral-above odd-col-lower coral coords))))

(defn is-cliquey? [odd-col-lower coral coords this-hue]
  (if-let [occupied-under (seq
                           (occupied-coral-under odd-col-lower coral coords))]
    (let [sum-hue (reduce (fn [memo under-coords]
                            (let [{:keys [color-hsva]} (coral under-coords)]
                              (+ memo (first color-hsva))))
                          0
                          occupied-under)
          avg-hue (/ sum-hue (count occupied-under))
          diff (color/hue-diff avg-hue this-hue)]
      (and (< diff HUE-DIFF-CLIQUEY-THRESH-MAX)
           (> (q/map-range diff
                           0 HUE-DIFF-CLIQUEY-THRESH-MAX
                           1.0 0.0) (rand))))
    false))

(defn is-attaching? [coral coral-size
                     {:keys [x y color-hsva] :as seed}]
  (let [{:keys [num-row-bins cell-w odd-col-lower]} coral-size
        [col row :as coords] (xy->coords cell-w x y)]
    (and (not (is-occupied? coral coords))
         (not (is-occupied? coral [col (dec row)]))
         (or (and (is-bottom? num-row-bins row)
                  (> BOTTOM-ATTACH-PCT (rand)))
             (is-cliquey? odd-col-lower coral coords (first color-hsva)))
    )))

(defn remove-seeds [all-seeds seeds]
  (remove (set seeds) all-seeds))

(defn make-sound-for-polyp-creation? [seed-count]
  (> (q/map-range seed-count 1 1000 1.0 0.01) (rand)))

(defn add-polyp [coral-size seed-count coral x y color-rgba color-hsva]
  (let [{:keys [cell-w num-row-bins]} coral-size
        [col row :as coords] (xy->coords cell-w x y)]
    (if (make-sound-for-polyp-creation? seed-count)
      (sound/polyp-creation (q/map-range row 0 num-row-bins 0.0 1.0)
                            (q/map-range row 0 num-row-bins 0.0 1.0)))
    (assoc-in coral [coords] {:color-rgba color-rgba
                              :color-hsva color-hsva})))

(defn add-seeds-to-coral [coral-size coral seeds]
  (let [seed-count (count seeds)]
   (doall
    (reduce (fn [memo {:keys [x y color-rgba color-hsva] :as seed}]
              (add-polyp coral-size
                         seed-count
                         memo
                         x y
                         color-rgba color-hsva))
            coral
            seeds))))

(defn attach-seeds
  [display-h {:keys [motion-seeds coral-size coral] :as state}]
  (let [attaching (filter (fn [seed]
                            (is-attaching? coral coral-size seed))
                          motion-seeds)]
    (-> state
        (update-in [:motion-seeds] #(remove-seeds % attaching))
        (update-in [:coral] #(add-seeds-to-coral coral-size % attaching)))))

;; ----------------------------------
;;  Rotation of coral (move to side)
;; ----------------------------------
(defn rotate-coral-side [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle]} coral-size]
    (if (= 0 rot-cycle)
      (update-in state [:coral]
                 #(reduce (fn [memo [[col row :as coords]
                                    polyp]]
                            (if (< col 1)
                              memo
                              (let [new-coords [(dec col) row]]
                                (assoc-in memo [new-coords] polyp))))
                          {}
                          %))
      state)))

(defn update-rot-cycle [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle-length]} coral-size
        frame-count (q/frame-count)
        rot-cycle   (mod frame-count rot-cycle-length)
        rot-cycle2 (mod frame-count (* 2 rot-cycle-length))]
   (update-in state [:coral-size]
              #(-> %
                   (assoc-in [:rot-cycle] rot-cycle)
                   (assoc-in [:rot-cycle2] rot-cycle2)
                   (assoc-in [:odd-col-lower]
                             (>= rot-cycle2 rot-cycle-length))))))

(defn rotate-coral [state]
  (-> state
      (update-rot-cycle)
      (rotate-coral-side)))

;; ----------------------------------
;;  Decay of Coral
;; ----------------------------------

(def LEAF-DECAY-PCT-MIN 0.0)
(def LEAF-DECAY-PCT-MAX 0.03)

(defn play-polyp-decay [all-decaying num-rows]
  (let [avg-row (/ (reduce (fn [memo [col row]]
                             (+ memo row))
                           0
                           all-decaying)
                   (count all-decaying))
        rel-amp (q/map-range avg-row 0 num-rows
                             1.0 0.0)
        rel-freq (q/map-range avg-row 0 num-rows
                              1.0 0.0)]
   (sound/polyp-decay-sound rel-amp rel-freq)))

(defn decay-coral [{:keys [coral coral-size] :as state}]
  (let [{:keys [odd-col-lower num-row-bins]} coral-size
        all-coords (keys coral)
        leaf-nodes (filter (fn [coords]
                             (is-leaf? odd-col-lower coral coords))
                           all-coords)
        num-coral (count all-coords)
        decay-pct (q/map-range num-coral 0 1000
                               LEAF-DECAY-PCT-MIN LEAF-DECAY-PCT-MAX)
        dead (filter (fn [leaf-node]
                        (> decay-pct (rand)))
                     leaf-nodes)]
    (when (seq dead)
      (play-polyp-decay dead num-row-bins))
    (update-in state [:coral] #(apply dissoc % dead))))

;; ----------------------------------
;;  Draw Coral
;; ----------------------------------
(defn leaf-alpha [col row]
  (let [nz (q/noise col row (* 0.99 (q/frame-count)))]
    (q/map-range nz 0.0 1.0
                 50.0 150.0)))

(defn draw-polyp [coral
                  {:keys [cell-w cell-half-w
                          hex-w hex-half-w
                          hex-y-offset
                          odd-col-lower] :as coral-size}
                  [[col row :as coords]
                   {:keys [color-rgba color-hsva] :as polyp}]]
  #_(apply q/fill color-rgba)
  (if (is-leaf? odd-col-lower coral coords)
    (q/fill 255 (leaf-alpha col row))
    (q/no-fill))
  (apply q/stroke color-rgba)
  (hex/draw-hex-cell odd-col-lower
                     cell-w cell-half-w
                     hex-w hex-half-w
                     hex-y-offset
                     col (- row 1)))

(defn draw-coral [{:keys [coral-size coral]}]
  (q/push-style)
  (q/no-fill)
  (q/stroke-weight CORAL-STROKE-WEIGHT)
  #_(q/stroke 255)
  (let [{:keys [cell-w rot-cycle-length rot-cycle odd-col-lower]} coral-size
        x-offset (* (/ cell-w (float rot-cycle-length))
                    (float rot-cycle))]
    (q/with-translation [(- x-offset) 0]
      (dorun
       (map (partial draw-polyp coral coral-size)
            coral))))
  (q/pop-style))

(ns videotest.coral.coral
  (:require
   [quil.core :as q]
   [videotest.coral.color :as color]
   [videotest.coral.hex :as hex]
   [videotest.sound.sound :as sound]))

;; (def NUM-CORAL-COL-BINS 64.0)
;; (def HEX-W 10.0)
(def NUM-CORAL-COL-BINS 110.0)
(def HEX-W 10.6)
(def CORAL-STROKE-WEIGHT 2.0)

(def CORAL-ROT-CYCLE 120)

(def BOTTOM-ATTACH-PCT 0.1)

;; 127.5 = 180 degress (max on 0-255 scale)
;; 21.25 = 30 degrees (on 0-255 scale)
(def HUE-DIFF-CLIQUEY-THRESH-MAX 21.25)

(defn coral-size [display-w display-h]
  (let [col-bins NUM-CORAL-COL-BINS
        cell-w (/ display-w col-bins)
        row-bins (/ display-h cell-w)
        hex-w HEX-W]
    {:num-col-bins col-bins
     :num-row-bins row-bins
     :cell-w cell-w
     :cell-half-w (/ cell-w 2.0)
     :hex-w hex-w
     :hex-half-w (/ hex-w 2.0)
     :hex-y-offset (hex/hex-y-offset hex-w)
     :rot-cycle-length CORAL-ROT-CYCLE
     :rot-cycle 0
     :rot-cycle2 0
     :odd-col-lower true}))

(defn x->col [cell-w x]
  (int (/ x cell-w)))

(defn y->row [cell-w y]
  (int (/ y cell-w)))

(defn xy->coords
  ([cell-w [x y]]
     (xy->coords cell-w x y))
  ([cell-w x y]
     (let [col (x->col cell-w x)
           row (y->row cell-w y)]
       [col row])))

(defn is-bottom? [num-rows row]
  (<= (dec num-rows) row))

(defn is-occupied? [coral coords]
  (contains? coral coords))

(defn occupied-coral-under
  ([coral [col row :as coords]]
     (occupied-coral-under true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-plus (inc row)
           under-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row]
                           [     col  row-plus]
                           [(inc col) row]]
                          [[(dec col) row-plus]
                           [     col  row-plus]
                           [(inc col) row-plus]])]
       (filter #(is-occupied? coral %) under-coords))))

(defn occupied-coral-above
  ([coral [col row :as coords]]
     (occupied-coral-above true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-minus (dec row)
           other-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row-minus]
                           [     col  row-minus]
                           [(inc col) row-minus]]
                          [[(dec col) row]
                           [     col  row-minus]
                           [(inc col) row]])]
       (filter #(is-occupied? coral %) other-coords))))

#_(defn is-row-under-occupied? [coral [col row]]
  (seq (occupied-coral-under coral [col row])))

(defn is-leaf? [odd-col-lower coral [col row :as coords]]
  (not (seq (occupied-coral-above odd-col-lower coral coords))))

(defn is-cliquey? [odd-col-lower coral coords this-hue]
  (if-let [occupied-under (seq
                           (occupied-coral-under odd-col-lower coral coords))]
    (let [sum-hue (reduce (fn [memo under-coords]
                            (let [{:keys [color-hsva]} (coral under-coords)]
                              (+ memo (first color-hsva))))
                          0
                          occupied-under)
          avg-hue (/ sum-hue (count occupied-under))
          diff (color/hue-diff avg-hue this-hue)]
      (and (< diff HUE-DIFF-CLIQUEY-THRESH-MAX)
           (> (q/map-range diff
                           0 HUE-DIFF-CLIQUEY-THRESH-MAX
                           1.0 0.0) (rand))))
    false))

(defn is-attaching? [coral coral-size
                     {:keys [x y color-hsva] :as seed}]
  (let [{:keys [num-row-bins cell-w odd-col-lower]} coral-size
        [col row :as coords] (xy->coords cell-w x y)]
    (and (not (is-occupied? coral coords))
         (not (is-occupied? coral [col (dec row)]))
         (or (and (is-bottom? num-row-bins row)
                  (> BOTTOM-ATTACH-PCT (rand)))
             (is-cliquey? odd-col-lower coral coords (first color-hsva)))
    )))

(defn remove-seeds [all-seeds seeds]
  (remove (set seeds) all-seeds))

(defn play-polyp-creation [cell-w num-row-bins seeds]
  (when (seq seeds)
    (let [avg-y (/ (reduce (fn [memo {:keys [x y]}]
                             (+ memo y))
                           0
                           seeds)
                   (count seeds))
          [_ row] (xy->coords cell-w 0 avg-y)]
      (sound/polyp-creation (q/map-range row 0 num-row-bins 0.0 1.0)
                            (q/map-range row 0 num-row-bins 0.0 1.0)))))

(defn add-polyp [coral-size seed-count coral x y color-rgba color-hsva]
  (let [{:keys [cell-w num-row-bins]} coral-size
        [col row :as coords] (xy->coords cell-w x y)]
    (assoc-in coral [coords] {:color-rgba color-rgba
                              :color-hsva color-hsva})))

(defn add-seeds-to-coral [coral-size coral seeds]
  (let [{:keys [cell-w num-row-bins]} coral-size
        seed-count (count seeds)]
    (play-polyp-creation cell-w num-row-bins seeds)
    (doall
     (reduce (fn [memo {:keys [x y color-rgba color-hsva] :as seed}]
               (add-polyp coral-size
                          seed-count
                          memo
                          x y
                          color-rgba color-hsva))
             coral
             seeds))))

(defn attach-seeds
  [display-h {:keys [motion-seeds coral-size coral] :as state}]
  (let [attaching (filter (fn [seed]
                            (is-attaching? coral coral-size seed))
                          motion-seeds)]
    (-> state
        (update-in [:motion-seeds] #(remove-seeds % attaching))
        (update-in [:coral] #(add-seeds-to-coral coral-size % attaching)))))

;; ----------------------------------
;;  Rotation of coral (move to side)
;; ----------------------------------
(defn rotate-coral-side [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle]} coral-size]
    (if (= 0 rot-cycle)
      (update-in state [:coral]
                 #(reduce (fn [memo [[col row :as coords]
                                    polyp]]
                            (if (< col 1)
                              memo
                              (let [new-coords [(dec col) row]]
                                (assoc-in memo [new-coords] polyp))))
                          {}
                          %))
      state)))

(defn update-rot-cycle [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle-length]} coral-size
        frame-count (q/frame-count)
        rot-cycle   (mod frame-count rot-cycle-length)
        rot-cycle2 (mod frame-count (* 2 rot-cycle-length))]
   (update-in state [:coral-size]
              #(-> %
                   (assoc-in [:rot-cycle] rot-cycle)
                   (assoc-in [:rot-cycle2] rot-cycle2)
                   (assoc-in [:odd-col-lower]
                             (>= rot-cycle2 rot-cycle-length))))))

(defn rotate-coral [state]
  (-> state
      (update-rot-cycle)
      (rotate-coral-side)))

;; ----------------------------------
;;  Decay of Coral
;; ----------------------------------

(def LEAF-DECAY-PCT-MIN 0.0)
(def LEAF-DECAY-PCT-MAX 0.03)

(defn play-polyp-decay [all-decaying num-rows]
  (let [avg-row (/ (reduce (fn [memo [col row]]
                             (+ memo row))
                           0
                           all-decaying)
                   (count all-decaying))
        rel-amp (q/map-range avg-row 0 num-rows
                             1.0 0.0)
        rel-freq (q/map-range avg-row 0 num-rows
                              1.0 0.0)]
   (sound/polyp-decay-sound rel-amp rel-freq)))

(defn decay-coral [{:keys [coral coral-size] :as state}]
  (let [{:keys [odd-col-lower num-row-bins]} coral-size
        all-coords (keys coral)
        leaf-nodes (filter (fn [coords]
                             (is-leaf? odd-col-lower coral coords))
                           all-coords)
        num-coral (count all-coords)
        decay-pct (q/map-range num-coral 0 1000
                               LEAF-DECAY-PCT-MIN LEAF-DECAY-PCT-MAX)
        dead (filter (fn [leaf-node]
                        (> decay-pct (rand)))
                     leaf-nodes)]
    (when (seq dead)
      (play-polyp-decay dead num-row-bins))
    (update-in state [:coral] #(apply dissoc % dead))))

;; ----------------------------------
;;  Draw Coral
;; ----------------------------------
(defn leaf-alpha [col row]
  (let [nz (q/noise col row (* 0.99 (q/frame-count)))]
    (q/map-range nz 0.0 1.0
                 50.0 150.0)))

(defn draw-polyp [coral
                  {:keys [cell-w cell-half-w
                          hex-w hex-half-w
                          hex-y-offset
                          odd-col-lower] :as coral-size}
                  [[col row :as coords]
                   {:keys [color-rgba color-hsva] :as polyp}]]
  #_(apply q/fill color-rgba)
  (if (is-leaf? odd-col-lower coral coords)
    (q/fill 255 (leaf-alpha col row))
    (q/no-fill))
  (apply q/stroke color-rgba)
  (hex/draw-hex-cell odd-col-lower
                     cell-w cell-half-w
                     hex-w hex-half-w
                     hex-y-offset
                     col (- row 1)))

(defn draw-coral [{:keys [coral-size coral]}]
  (q/push-style)
  (q/no-fill)
  (q/stroke-weight CORAL-STROKE-WEIGHT)
  #_(q/stroke 255)
  (let [{:keys [cell-w rot-cycle-length rot-cycle odd-col-lower]} coral-size
        x-offset (* (/ cell-w (float rot-cycle-length))
                    (float rot-cycle))]
    (q/with-translation [(- x-offset) 0]
      (dorun
       (map (partial draw-polyp coral coral-size)
            coral))))
  (q/pop-style))

Clean up generation of sound on polyp creation.

Use average row.