(ns babel.generate
  (:refer-clojure :exclude [get-in deref resolve find parents])
  (:require
   [babel.cache :refer [check-index get-head-phrases-of get-lex]]
   [babel.over :as over]
   [babel.stringutils :refer [show-as-tree]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.string :as string]
   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path
                                        ref? remove-false remove-top-values-log
                                        strip-refs show-spec unify unifyc

                                        ;; temporary
                                        deserialize serialize
                                        )]))

;; during generation, will not search deeper than this:
(def ^:const max-total-depth 6)

;; use map or pmap.
(def ^:const mapfn map)

(declare add-complement)
(declare lexemes-before-phrases)
(declare lightning-bolt)
(declare generate-all)
(declare in-case-of-no-phrasal-complements)
(declare path-to-map)
(declare show-bolt)

(defn exception [error-string]
  #?(:clj
     (throw (Exception. (str ": " error-string))))
  #?(:cljs
     (throw (js/Error. error-string))))

(defn current-time []
  #?(:clj (System/currentTimeMillis))
  #?(:cljs (.getTime (js/Date.))))

(defn try-hard-to [function]
  "try 100 times to do (function), where function presumable has some randomness that causes it to return nil. Ignore such nils and keep trying."
  (first
   (take
    1
    (filter
     #(not (nil? %))
     (take 100
           (repeatedly function))))))

(defn subpath? [path1 path2]
  "return true if path1 is subpath of path2."
  (if (empty? path1)
    true
    (if (= (first path1) (first path2))
      (subpath? (rest path1)
                (rest path2))
      false)))

(defn truncate [input truncate-paths]
  (let [serialized (if (:serialized input)
                     (:serialized input)
                     (serialize input))
        paths-and-vals (rest serialized)
        path-sets (mapfn first paths-and-vals)
        path-vals (mapfn second paths-and-vals)
        truncated-path-sets (mapfn
                             (fn [path-set]
                               (filter (fn [path]
                                         (not (some (fn [truncate-path]
                                                      (subpath? truncate-path path))
                                                    truncate-paths)))
                                       path-set))
                             path-sets)
        skeleton (first serialized)
        truncated-skeleton (dissoc-paths skeleton truncate-paths)
        truncated-serialized
        (cons truncated-skeleton
              (zipmap truncated-path-sets
                      path-vals))]
    (deserialize truncated-serialized)))

(defn generate [spec grammar lexicon index morph]
  (cond (or (vector? spec)
            (seq? spec))
        (let [spec (vec (set spec))]
          (log/debug (str "generating from " (count spec) " spec(s)"))
          (let [expression
                (first (take 1
                             (mapcat (fn [each-spec]
                                       (log/info (str "generate: generating from spec: "
                                                      each-spec))
                                       (let [expressions
                                             (generate-all each-spec grammar lexicon index morph)]
                                         expressions))
                                     spec)))]
            ;; TODO: show time information
            (if expression
              (log/info (str "generate: generated "
                             "'" (morph expression) "'"
                             " from " (count spec) " spec(s)"))
              (log/warn (str "generate: no expression could be generated for any of the "
                             " from " (count spec) " spec(s)")))
            expression))

        (empty? grammar)
        (do
          (log/error (str "grammar is empty."))
          (exception (str "grammar is empty.")))

        true
        (do
          (log/info (str "generate: generating from spec: "
                         (strip-refs spec)))
          (let [expression
                (first (take 1 (generate-all spec grammar lexicon index morph)))]
            (if expression
              (log/info (str "generate: generated "
                             "'" (morph expression) "'"
                             " for spec:" (strip-refs spec) ";"
                             " expr spec: "
                             (unifyc
                              spec
                              {:synsem {:sem (strip-refs (get-in expression [:synsem :sem]))}})))
              (log/info (str "generate: no expression could be generated for spec:" (strip-refs spec))))
            expression))))

(defn generate-all-with-model [spec {grammar :grammar
                                     index :index
                                     lexicon :lexicon
                                     morph :morph}]
  (let []
    (log/info (str "using grammar of size: " (count grammar)))
    (log/info (str "using index of size: " (count index)))
    (if (seq? spec)
      #?(:clj (map generate-all spec grammar lexicon index morph))
      #?(:cljs (map generate-all spec grammar lexicon index morph))
      (generate spec grammar
                (flatten (vals lexicon))
                index
                morph))))

(defn generate-all [spec grammar lexicon index morph & [total-depth]]
  (log/debug (str "generate-all: generating from spec with cat "
                  (get-in spec [:synsem :cat])))
  (if (= false (get-in spec [:phrasal] true))
    (exception (str "do not call generate-all with spec:[phrasal=false]"))
    ;; else, phrasal:
    (let [total-depth (if total-depth total-depth 0)
          add-complements-to-bolts
          (fn [bolts path]
            (mapcat
             #(if (not (= :none (get-in % path :none)))
                (lazy-seq (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path))))
                [%])
             (filter #(not (nil? %)) bolts)))

          expressions
          (lazy-seq
           (-> (lightning-bolt grammar
                               lexicon
                               spec 0 index morph total-depth)
               ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
               (add-complements-to-bolts [:head :head :head :comp])
               (add-complements-to-bolts [:head :head :comp])
               (add-complements-to-bolts [:head :comp])
               (add-complements-to-bolts [:comp])))]
      (map (fn [expr]
             (truncate expr [[:head][:comp]]))
           expressions))))

(defn candidate-parents [rules spec]
  "find subset of _rules_ for which each member unifies successfully with _spec_"
  (log/trace (str "candidate-parents: spec: " (strip-refs spec)))
  (filter #(not (fail? %))
          (mapfn (fn [rule]
                   (if (and (not (fail? (unifyc (get-in rule [:synsem :cat] :top)
                                                (get-in spec [:synsem :cat] :top))))
                            (not (fail? (unifyc (get-in rule [:synsem :infl] :top)
                                                (get-in spec [:synsem :infl] :top))))
                            (not (fail? (unifyc (get-in rule [:synsem :sem :tense] :top)
                                                (get-in spec [:synsem :sem :tense] :top))))
                            (not (fail? (unifyc (get-in rule [:synsem :modified] :top)
                                                (get-in spec [:synsem :modified] :top)))))
                     (unifyc spec rule)
                     :fail))
                 (lazy-seq rules))))

(declare morph-with-recovery)

(defn lightning-bolt [grammar lexicon spec depth index morph total-depth]
  "Returns a lazy-sequence of all possible trees given a spec, where
there is only one child for each parent, and that single child is the
head of its parent. generate (above) 'decorates' each returned lightning bolt
of this function with complements."
  (if (or (vector? spec) (seq? spec))
    (exception (str "don't call (lightning-bolt) with a vector of specs."))
    (do
      (log/trace (str "lightning-bolt(depth=" depth "; total-depth=" total-depth "; cat=" (get-in spec [:synsem :cat]) "; spec=" (strip-refs spec) ")"))
      (let [morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
            depth (if depth depth 0)
            parents (candidate-parents grammar spec)]
        (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
              (mapcat (fn [parent]
                        (if (= false (get-in parent [:head :phrasal] false))
                          (let [candidate-lexemes (filter #(not (nil? %)) (get-lex parent :head index spec))]
                            (filter #(not (nil? %))
                                    (over/overh parent (mapfn copy candidate-lexemes))))))
                      parents)
              phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
              (if (< depth max-total-depth)
                (mapcat (fn [parent]
                          (over/overh parent
                                      (lightning-bolt grammar lexicon (get-in parent [:head])
                                                      (+ 1 depth) index morph (+ 1 total-depth))))
                        parents))]
          (if (lexemes-before-phrases total-depth)
            (concat lexical phrasal)
            (concat phrasal lexical)))))))

(defn morph-with-recovery [morph-fn input]
  (if (nil? input)
    (exception (str "don't call morph-with-recovery with input=nil.")))
  (let [result (morph-fn input)
        result (if (or (nil? result)
                       (= "" result))
                 (get-in input [:english :english] "")
                 result)
        result (if (or (nil? result)
                       (= "" result))
                 (get-in input [:english] "")
                 result)
        result (if (or (nil? result)
                       (= "" result))
                 (get-in input [:rule] "")
                 result)
        result (if (or (nil? result)
                       (= "" result))
                 (exception
                  (str "r5: " input "/" (nil? input)))
                 result)]
    result))

(defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
  (log/debug (str "add-complement: start: " (show-bolt bolt path morph) "@" path))
  (let [input-spec spec
        from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
        spec (unifyc spec (get-in bolt path))
        immediate-parent (get-in bolt (butlast path))
        complement-candidate-lexemes
        (if (not (= true
                    (get-in bolt (concat path [:phrasal]))))
          (let [cached (if cache
                         (get-lex immediate-parent :comp cache spec))]
            (if cached cached (lazy-seq (flatten (vals lexicon))))))

        complement-pre-check (fn [child parent path-to-child]
                               (let [child-in-bolt (get-in bolt path-to-child)
                                     result (not (fail?
                                                  (unifyc (get-in child [:synsem] :top)
                                                          (get-in child-in-bolt [:synsem] :top))))]
                                 (log/trace (str "add-complement: checking child: " (morph child) "success?:" result))
                                 result))
        filtered-lexical-complements (filter (fn [lexeme]
                                               (complement-pre-check lexeme bolt path))
                                             complement-candidate-lexemes)]
    (filter #(not (fail? %))
            (mapfn (fn [complement]
                    (unify (copy bolt)
                           (path-to-map path
                                        (copy complement))))
                  (let [debug (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                              ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                              "): calling generate-all(" (strip-refs spec) ");"
                                              "input-spec: " input-spec))
                        phrasal-complements (if (and (> max-total-depth total-depth)
                                                     (= true (get-in spec [:phrasal] true)))
                                              (generate-all spec grammar lexicon cache morph (+ depth total-depth)))]
                    (if (lexemes-before-phrases total-depth)
                      (lazy-cat filtered-lexical-complements phrasal-complements)
                      (lazy-cat phrasal-complements filtered-lexical-complements)))))))

(defn path-to-map [path val]
  (let [feat (first path)]
    (if feat
      {feat (path-to-map (rest path) val)}
      val)))

(defn in-case-of-no-phrasal-complements [bolt path run-time from-bolt complement-candidate-lexemes morph]
  ;; No complements could be added to this bolt: Throw an exception or log/warn. debateable about which to do
  ;; in which circumstances.
  (let [log-limit 1000
        log-fn (fn [message] (log/warn message))
        throw-exception-if-no-complements-found false
        message
        (str " add-complement to " (get-in bolt [:rule]) " at path: " path
             " took " run-time " msec, but found neither phrasal nor lexical complements for "
             "'" (morph from-bolt) "'"
             ". Bolt wants phrasal-wise: " (get-in bolt (concat path [:phrasal]))
             ". Desired complement [:synsem] was: "
             (strip-refs (get-in bolt (concat path [:synsem]))) ". "
             (if (= false (get-in bolt (concat path [:phrasal]) false))
               (str
                (count complement-candidate-lexemes) " lexical complement(s) tried were:"
                " "
                (string/join "," (sort (map morph (take log-limit complement-candidate-lexemes))))

                (if (< 0 (- (count complement-candidate-lexemes) log-limit))
                  (str ",.. and "
                       (- (count complement-candidate-lexemes) log-limit) " more."))

                ";     with preds:   "
                (string/join "," (map #(get-in % [:synsem :sem :pred]) (take log-limit complement-candidate-lexemes)))

                ";     fail-paths:   "
                (string/join ","
                             (map #(if
                                       (or true (not (fail? (unifyc (get-in % [:synsem :sem :pred])
                                                                    (get-in bolt (concat path
                                                                                [:synsem :sem :pred]))))))
                                     (str "'" (morph %) "':"
                                          (fail-path (strip-refs %)
                                                     (strip-refs (get-in bolt path)))))
                                  (take log-limit complement-candidate-lexemes)))

                (if (< 0 (- (count complement-candidate-lexemes) log-limit))
                  (str ",.. and "
                       (- (count complement-candidate-lexemes) log-limit) " more.")))))]
    (log-fn message)

    ;; set to true to work on optimizing generation, since this situation of failing to add any
    ;; complements is expensive.
    (if (and throw-exception-if-no-complements-found
             (not (= true (get-in bolt (concat path [:phrasal])))))
      (exception message))))

(defn lexemes-before-phrases [depth]
  "returns true or false: true means generate by adding lexemes first; otherwise, by adding phrases first. Takes depth as an argument, which makes returning true (i.e. lexemes first) increasingly likely as depth increases."
  (if true false
  (if (> max-total-depth 0)
    (let [prob (- 1.0 (/ (- max-total-depth depth) max-total-depth))]
      (> (* 10 prob) (rand-int 10)))
    false)))

(defn show-bolt [bolt path morph]
  (if (nil? bolt)
    (exception (str "don't call show-bolt with bolt=null."))
    (if (not (empty? path))
      (str "[" (get-in bolt [:rule])
           " '" (morph-with-recovery morph bolt) "'"
           (let [head-bolt (get-in bolt [:head])]
             (if (not (nil? head-bolt))
               (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
                 (if (not (nil? rest-str))
                   (str " -> " rest-str)))))
           "]"))))

(ns babel.generate
  (:refer-clojure :exclude [get-in deref resolve find parents])
  (:require
   [babel.cache :refer [check-index get-head-phrases-of get-lex]]
   [babel.over :as over]
   [babel.stringutils :refer [show-as-tree]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.string :as string]
   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path
                                        ref? remove-false remove-top-values-log
                                        strip-refs show-spec unify unifyc

                                        ;; temporary
                                        deserialize serialize
                                        )]))

;; during generation, will not decend deeper than this when creating a tree:
(def ^:const max-total-depth 2)

;; use map or pmap.
(def ^:const mapfn map)

(declare add-complement)
(declare lexemes-before-phrases)
(declare lightning-bolt)
(declare generate-all)
(declare in-case-of-no-phrasal-complements)
(declare path-to-map)
(declare show-bolt)

(defn exception [error-string]
  #?(:clj
     (throw (Exception. (str ": " error-string))))
  #?(:cljs
     (throw (js/Error. error-string))))

(defn current-time []
  #?(:clj (System/currentTimeMillis))
  #?(:cljs (.getTime (js/Date.))))

(defn try-hard-to [function]
  "try 100 times to do (function), where function presumable has some randomness that causes it to return nil. Ignore such nils and keep trying."
  (first
   (take
    1
    (filter
     #(not (nil? %))
     (take 100
           (repeatedly function))))))

(defn subpath? [path1 path2]
  "return true if path1 is subpath of path2."
  (if (empty? path1)
    true
    (if (= (first path1) (first path2))
      (subpath? (rest path1)
                (rest path2))
      false)))

(defn truncate [input truncate-paths]
  (let [serialized (if (:serialized input)
                     (:serialized input)
                     (serialize input))
        paths-and-vals (rest serialized)
        path-sets (mapfn first paths-and-vals)
        path-vals (mapfn second paths-and-vals)
        truncated-path-sets (mapfn
                             (fn [path-set]
                               (filter (fn [path]
                                         (not (some (fn [truncate-path]
                                                      (subpath? truncate-path path))
                                                    truncate-paths)))
                                       path-set))
                             path-sets)
        skeleton (first serialized)
        truncated-skeleton (dissoc-paths skeleton truncate-paths)
        truncated-serialized
        (cons truncated-skeleton
              (zipmap truncated-path-sets
                      path-vals))]
    (deserialize truncated-serialized)))

(defn generate [spec grammar lexicon index morph]
  (cond (or (vector? spec)
            (seq? spec))
        (let [spec (vec (set spec))]
          (log/debug (str "generating from " (count spec) " spec(s)"))
          (let [expression
                (first (take 1
                             (mapcat (fn [each-spec]
                                       (log/info (str "generate: generating from spec: "
                                                      each-spec))
                                       (let [expressions
                                             (generate-all each-spec grammar lexicon index morph)]
                                         expressions))
                                     spec)))]
            ;; TODO: show time information
            (if expression
              (log/info (str "generate: generated "
                             "'" (morph expression) "'"
                             " from " (count spec) " spec(s)"))
              (log/warn (str "generate: no expression could be generated for any of the "
                             " from " (count spec) " spec(s)")))
            expression))

        (empty? grammar)
        (do
          (log/error (str "grammar is empty."))
          (exception (str "grammar is empty.")))

        true
        (do
          (log/info (str "generate: generating from spec: "
                         (strip-refs spec)))
          (let [expression
                (first (take 1 (generate-all spec grammar lexicon index morph)))]
            (if expression
              (log/info (str "generate: generated "
                             "'" (morph expression) "'"
                             " for spec:" (strip-refs spec) ";"
                             " expr spec: "
                             (unifyc
                              spec
                              {:synsem {:sem (strip-refs (get-in expression [:synsem :sem]))}})))
              (log/info (str "generate: no expression could be generated for spec:" (strip-refs spec))))
            expression))))

(defn generate-all-with-model [spec {grammar :grammar
                                     index :index
                                     lexicon :lexicon
                                     morph :morph}]
  (let []
    (log/info (str "using grammar of size: " (count grammar)))
    (log/info (str "using index of size: " (count index)))
    (if (seq? spec)
      #?(:clj (map generate-all spec grammar lexicon index morph))
      #?(:cljs (map generate-all spec grammar lexicon index morph))
      (generate spec grammar
                (flatten (vals lexicon))
                index
                morph))))

(defn generate-all [spec grammar lexicon index morph & [total-depth]]
  (log/debug (str "generate-all: generating from spec with cat "
                  (get-in spec [:synsem :cat])))
  (if (= false (get-in spec [:phrasal] true))
    (exception (str "do not call generate-all with spec:[phrasal=false]"))
    ;; else, phrasal:
    (let [total-depth (if total-depth total-depth 0)
          add-complements-to-bolts
          (fn [bolts path]
            (mapcat
             #(if (not (= :none (get-in % path :none)))
                (lazy-seq (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path))))
                [%])
             (filter #(not (nil? %)) bolts)))

          expressions
          (lazy-seq
           (-> (lightning-bolt grammar
                               lexicon
                               spec 0 index morph total-depth)
               ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
               (add-complements-to-bolts [:head :head :head :comp])
               (add-complements-to-bolts [:head :head :comp])
               (add-complements-to-bolts [:head :comp])
               (add-complements-to-bolts [:comp])))]
      (map (fn [expr]
             (truncate expr [[:head][:comp]]))
           expressions))))

(defn candidate-parents [rules spec]
  "find subset of _rules_ for which each member unifies successfully with _spec_"
  (log/trace (str "candidate-parents: spec: " (strip-refs spec)))
  (filter #(not (fail? %))
          (mapfn (fn [rule]
                   (if (and (not (fail? (unifyc (get-in rule [:synsem :cat] :top)
                                                (get-in spec [:synsem :cat] :top))))
                            (not (fail? (unifyc (get-in rule [:synsem :infl] :top)
                                                (get-in spec [:synsem :infl] :top))))
                            (not (fail? (unifyc (get-in rule [:synsem :sem :tense] :top)
                                                (get-in spec [:synsem :sem :tense] :top))))
                            (not (fail? (unifyc (get-in rule [:synsem :modified] :top)
                                                (get-in spec [:synsem :modified] :top)))))
                     (unifyc spec rule)
                     :fail))
                 (lazy-seq rules))))

(declare morph-with-recovery)

(defn lightning-bolt [grammar lexicon spec depth index morph total-depth]
  "Returns a lazy-sequence of all possible trees given a spec, where
there is only one child for each parent, and that single child is the
head of its parent. generate (above) 'decorates' each returned lightning bolt
of this function with complements."
  (if (or (vector? spec) (seq? spec))
    (exception (str "don't call (lightning-bolt) with a vector of specs."))
    (do
      (log/trace (str "lightning-bolt(depth=" depth "; total-depth=" total-depth "; cat=" (get-in spec [:synsem :cat]) "; spec=" (strip-refs spec) ")"))
      (let [morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
            depth (if depth depth 0)
            parents (candidate-parents grammar spec)]
        (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
              (mapcat (fn [parent]
                        (if (= false (get-in parent [:head :phrasal] false))
                          (let [candidate-lexemes (filter #(not (nil? %)) (get-lex parent :head index spec))]
                            (filter #(not (nil? %))
                                    (over/overh parent (mapfn copy candidate-lexemes))))))
                      parents)
              phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
              (if (< depth max-total-depth)
                (mapcat (fn [parent]
                          (over/overh parent
                                      (lightning-bolt grammar lexicon (get-in parent [:head])
                                                      (+ 1 depth) index morph (+ 1 total-depth))))
                        parents))]
          (if (lexemes-before-phrases total-depth)
            (concat lexical phrasal)
            (concat phrasal lexical)))))))

(defn morph-with-recovery [morph-fn input]
  (if (nil? input)
    (exception (str "don't call morph-with-recovery with input=nil.")))
  (let [result (morph-fn input)
        result (if (or (nil? result)
                       (= "" result))
                 (get-in input [:english :english] "")
                 result)
        result (if (or (nil? result)
                       (= "" result))
                 (get-in input [:english] "")
                 result)
        result (if (or (nil? result)
                       (= "" result))
                 (get-in input [:rule] "")
                 result)
        result (if (or (nil? result)
                       (= "" result))
                 (exception
                  (str "r5: " input "/" (nil? input)))
                 result)]
    result))

(defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
  (log/debug (str "add-complement: start: " (show-bolt bolt path morph) "@" path))
  (let [input-spec spec
        from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
        spec (unifyc spec (get-in bolt path))
        immediate-parent (get-in bolt (butlast path))
        complement-candidate-lexemes
        (if (not (= true
                    (get-in bolt (concat path [:phrasal]))))
          (let [cached (if cache
                         (get-lex immediate-parent :comp cache spec))]
            (if cached cached (lazy-seq (flatten (vals lexicon))))))

        complement-pre-check (fn [child parent path-to-child]
                               (let [child-in-bolt (get-in bolt path-to-child)
                                     result (not (fail?
                                                  (unifyc (get-in child [:synsem] :top)
                                                          (get-in child-in-bolt [:synsem] :top))))]
                                 (log/trace (str "add-complement: checking child: " (morph child) "success?:" result))
                                 result))
        filtered-lexical-complements (filter (fn [lexeme]
                                               (complement-pre-check lexeme bolt path))
                                             complement-candidate-lexemes)]
    (filter #(not (fail? %))
            (mapfn (fn [complement]
                    (unify (copy bolt)
                           (path-to-map path
                                        (copy complement))))
                  (let [debug (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                              ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                              "): calling generate-all(" (strip-refs spec) ");"
                                              "input-spec: " input-spec))
                        phrasal-complements (if (and (> max-total-depth total-depth)
                                                     (= true (get-in spec [:phrasal] true)))
                                              (generate-all spec grammar lexicon cache morph (+ depth total-depth)))]
                    (if (lexemes-before-phrases total-depth)
                      (lazy-cat filtered-lexical-complements phrasal-complements)
                      (lazy-cat phrasal-complements filtered-lexical-complements)))))))

(defn path-to-map [path val]
  (let [feat (first path)]
    (if feat
      {feat (path-to-map (rest path) val)}
      val)))

(defn in-case-of-no-phrasal-complements [bolt path run-time from-bolt complement-candidate-lexemes morph]
  ;; No complements could be added to this bolt: Throw an exception or log/warn. debateable about which to do
  ;; in which circumstances.
  (let [log-limit 1000
        log-fn (fn [message] (log/warn message))
        throw-exception-if-no-complements-found false
        message
        (str " add-complement to " (get-in bolt [:rule]) " at path: " path
             " took " run-time " msec, but found neither phrasal nor lexical complements for "
             "'" (morph from-bolt) "'"
             ". Bolt wants phrasal-wise: " (get-in bolt (concat path [:phrasal]))
             ". Desired complement [:synsem] was: "
             (strip-refs (get-in bolt (concat path [:synsem]))) ". "
             (if (= false (get-in bolt (concat path [:phrasal]) false))
               (str
                (count complement-candidate-lexemes) " lexical complement(s) tried were:"
                " "
                (string/join "," (sort (map morph (take log-limit complement-candidate-lexemes))))

                (if (< 0 (- (count complement-candidate-lexemes) log-limit))
                  (str ",.. and "
                       (- (count complement-candidate-lexemes) log-limit) " more."))

                ";     with preds:   "
                (string/join "," (map #(get-in % [:synsem :sem :pred]) (take log-limit complement-candidate-lexemes)))

                ";     fail-paths:   "
                (string/join ","
                             (map #(if
                                       (or true (not (fail? (unifyc (get-in % [:synsem :sem :pred])
                                                                    (get-in bolt (concat path
                                                                                [:synsem :sem :pred]))))))
                                     (str "'" (morph %) "':"
                                          (fail-path (strip-refs %)
                                                     (strip-refs (get-in bolt path)))))
                                  (take log-limit complement-candidate-lexemes)))

                (if (< 0 (- (count complement-candidate-lexemes) log-limit))
                  (str ",.. and "
                       (- (count complement-candidate-lexemes) log-limit) " more.")))))]
    (log-fn message)

    ;; set to true to work on optimizing generation, since this situation of failing to add any
    ;; complements is expensive.
    (if (and throw-exception-if-no-complements-found
             (not (= true (get-in bolt (concat path [:phrasal])))))
      (exception message))))

(defn lexemes-before-phrases [depth]
  "returns true or false: true means generate by adding lexemes first; otherwise, by adding phrases first. Takes depth as an argument, which makes returning true (i.e. lexemes first) increasingly likely as depth increases."
  (if true false
  (if (> max-total-depth 0)
    (let [prob (- 1.0 (/ (- max-total-depth depth) max-total-depth))]
      (> (* 10 prob) (rand-int 10)))
    false)))

(defn show-bolt [bolt path morph]
  (if (nil? bolt)
    (exception (str "don't call show-bolt with bolt=null."))
    (if (not (empty? path))
      (str "[" (get-in bolt [:rule])
           " '" (morph-with-recovery morph bolt) "'"
           (let [head-bolt (get-in bolt [:head])]
             (if (not (nil? head-bolt))
               (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
                 (if (not (nil? rest-str))
                   (str " -> " rest-str)))))
           "]"))))

decrease total depth to study non-laziness of generation


(ns day8.re-frame.trace.app-db
  (:require [reagent.core :as r]
            [clojure.string :as str]
            [devtools.formatters.core :as cljs-devtools]
            [day8.re-frame.trace.localstorage :as localstorage]
            [day8.re-frame.trace.components :as components]))

(defn string->css [css-string]
  "This function converts jsonml css-strings to valid css maps for hiccup.
  Example: 'margin-left:0px;min-height:14px;' converts to
           {:margin-left '0px', :min-height '14px'}"

  (->> (str/split css-string #";")
       (map #(str/split % #":"))
       (reduce (fn [acc [property value]]
                 (assoc acc (keyword property) value)) {})))

(declare jsonml->hiccup)

(defn data-structure [jsonml]
  (let [expanded? (r/atom false)]
    (fn [jsonml]
      [:span
        {:class (str/join " " ["re-frame-trace--object"
                               (when @expanded? "expanded")])}
        [:span {:class "toggle"
                :on-click #(swap! expanded? not)}
           [:button.expansion-button (if @expanded? "▼" "▶")]]
        (jsonml->hiccup (if @expanded?
                          (cljs-devtools/body-api-call
                            (.-object (get jsonml 1))
                            (.-config (get jsonml 1)))
                          (cljs-devtools/header-api-call
                            (.-object (get jsonml 1))
                            (.-config (get jsonml 1)))))])))

(defn jsonml->hiccup
  "JSONML is the format used by Chrome's Custom Object Formatters.
  The spec is at https://docs.google.com/document/d/1FTascZXT9cxfetuPRT2eXPQKXui4nWFivUnS_335T3U/preview.

  JSONML is pretty much Hiccup over JSON. Chrome's implementation of this can
  be found at https://cs.chromium.org/chromium/src/third_party/WebKit/Source/devtools/front_end/object_ui/CustomPreviewComponent.js
  "
  [jsonml]
  (if (number? jsonml)
    jsonml
    (let [[head & args]             jsonml
          tagnames                  #{"div" "span" "ol" "li" "table" "tr" "td"}]
      (cond
        (contains? tagnames head)   (let [[style & children] args]
                                      (into
                                        [(keyword head) {:style (-> (js->clj style)
                                                                    (get "style")
                                                                    (string->css))}]
                                        (map jsonml->hiccup children)))

        (= head "object")           [data-structure jsonml]
        (= jsonml ", ")             " "
        :else jsonml))))

(defn subtree [data title]
  (let [expanded? (r/atom false)]
    (fn [data]
      [:div
        {:class (str/join " " ["re-frame-trace--object"
                               (when @expanded? "expanded")])}
        [:span {:class "toggle"
                :on-click #(swap! expanded? not)}
           [:button.expansion-button (if @expanded? "▼ " "▶ ")]]
        (or title "data")
        [:div {:style {:margin-left 20}}
          (cond
            (and @expanded?
              (or (string? data)
                  (number? data)))  [:div {:style {:margin "10px 0"}} data]
            @expanded?              (jsonml->hiccup (cljs-devtools/header-api-call data)))]])))

(defn render-state  [data]
  (let [subtree-input  (r/atom "")
        subtree-paths  (r/atom (localstorage/get "subtree-paths" #{}))
        input-error    (r/atom false)]
    (add-watch subtree-paths
               :update-localstorage
               (fn [_ _ _ new-state]
                 (localstorage/save! "subtree-paths" new-state)))
    (fn []
      [:div {:style {:flex "1 0 auto" :width "100%" :height "100%" :display "flex" :flex-direction "column"}}
        [:div.panel-content-scrollable {:style {:margin 10}}
          [:div.filter-control-input
            [components/search-input {:placeholder ":path :into :app-state"
                                      :on-save (fn [path]
                                                 (if false ;; TODO check if path exists
                                                   (reset! input-error true)
                                                   (do
                                                     ; (reset! input-error false)
                                                     ;; TODO check if input already wrapped in braces
                                                     (swap! subtree-paths #(into #{(cljs.reader/read-string (str "[" path "]"))} %)))))
                                      :on-change #(reset! subtree-input (.. % -target -value))}]]
                       ; (if @input-error
                       ;   [:div.input-error {:style {:color "red" :margin-top 5}}
                       ;    "Please enter a valid path."])]]

          [:div.subtrees {:style {:margin "20px 0"}}
            (doall
              (map (fn [path]
                     ^{:key path}
                     [:div.subtree-wrapper {:style {:margin "10px 0"}}
                       [:div.subtree
                             [subtree
                               (get-in @data path)
                               [:button.subtree-button {:on-click #(swap! subtree-paths disj path)}
                                 [:span.subtree-button-string
                                   (str path)]]]]])
                @subtree-paths))]
          [subtree @data [:span.label "app-state"]]]])))

(ns day8.re-frame.trace.app-db
  (:require [reagent.core :as r]
            [clojure.string :as str]
            [devtools.formatters.core :as cljs-devtools]
            [day8.re-frame.trace.localstorage :as localstorage]
            [day8.re-frame.trace.components :as components]))

(defn string->css [css-string]
  "This function converts jsonml css-strings to valid css maps for hiccup.
  Example: 'margin-left:0px;min-height:14px;' converts to
           {:margin-left '0px', :min-height '14px'}"

  (->> (str/split css-string #";")
       (map #(str/split % #":"))
       (reduce (fn [acc [property value]]
                 (assoc acc (keyword property) value)) {})))

(def config {:well-known-types #{"cljs.core/Keyword"}

             :render-bools     false
             :render-strings   false
             :render-numbers   false
             :render-keywords  false
             :render-symbols   false
             :render-instances false
             :render-types     false
             :render-functions false
             })

(declare jsonml->hiccup)

(defn data-structure [jsonml]
  (let [expanded? (r/atom false)]
    (fn [jsonml]
      [:span
        {:class (str/join " " ["re-frame-trace--object"
                               (when @expanded? "expanded")])}
        [:span {:class "toggle"
                :on-click #(swap! expanded? not)}
           [:button.expansion-button (if @expanded? "▼" "▶")]]
        (jsonml->hiccup (if @expanded?
                          (cljs-devtools/body-api-call
                            (.-object (get jsonml 1))
                            (.-config (get jsonml 1)))
                          (cljs-devtools/header-api-call
                            (.-object (get jsonml 1))
                            (.-config (get jsonml 1)))))])))

(defn jsonml->hiccup
  "JSONML is the format used by Chrome's Custom Object Formatters.
  The spec is at https://docs.google.com/document/d/1FTascZXT9cxfetuPRT2eXPQKXui4nWFivUnS_335T3U/preview.

  JSONML is pretty much Hiccup over JSON. Chrome's implementation of this can
  be found at https://cs.chromium.org/chromium/src/third_party/WebKit/Source/devtools/front_end/object_ui/CustomPreviewComponent.js
  "
  [jsonml]
  (if (number? jsonml)
    jsonml
    (let [[head & args]             jsonml
          tagnames                  #{"div" "span" "ol" "li" "table" "tr" "td"}]
      (cond
        (contains? tagnames head)   (let [[style & children] args]
                                      (into
                                        [(keyword head) {:style (-> (js->clj style)
                                                                    (get "style")
                                                                    (string->css))}]
                                        (map jsonml->hiccup children)))

        (= head "object")           [data-structure jsonml]
        (= jsonml ", ")             " "
        :else jsonml))))

(defn subtree [data title]
  (let [expanded? (r/atom false)]
    (fn [data]
      [:div
        {:class (str/join " " ["re-frame-trace--object"
                               (when @expanded? "expanded")])}
        [:span {:class "toggle"
                :on-click #(swap! expanded? not)}
           [:button.expansion-button (if @expanded? "▼ " "▶ ")]]
        (or title "data")
        [:div {:style {:margin-left 20}}
          (cond
            (and @expanded?
              (or (string? data)
                  (number? data)))  [:div {:style {:margin "10px 0"}} data]
            @expanded?              (jsonml->hiccup (cljs-devtools/header-api-call data config :extra)))]])))

(defn render-state  [data]
  (let [subtree-input  (r/atom "")
        subtree-paths  (r/atom (localstorage/get "subtree-paths" #{}))
        input-error    (r/atom false)]
    (add-watch subtree-paths
               :update-localstorage
               (fn [_ _ _ new-state]
                 (localstorage/save! "subtree-paths" new-state)))
    (fn []
      [:div {:style {:flex "1 0 auto" :width "100%" :height "100%" :display "flex" :flex-direction "column"}}
        [:div.panel-content-scrollable {:style {:margin 10}}
          [:div.filter-control-input
            [components/search-input {:placeholder ":path :into :app-state"
                                      :on-save (fn [path]
                                                 (if false ;; TODO check if path exists
                                                   (reset! input-error true)
                                                   (do
                                                     ; (reset! input-error false)
                                                     ;; TODO check if input already wrapped in braces
                                                     (swap! subtree-paths #(into #{(cljs.reader/read-string (str "[" path "]"))} %)))))
                                      :on-change #(reset! subtree-input (.. % -target -value))}]]
                       ; (if @input-error
                       ;   [:div.input-error {:style {:color "red" :margin-top 5}}
                       ;    "Please enter a valid path."])]]

          [:div.subtrees {:style {:margin "20px 0"}}
            (doall
              (map (fn [path]
                     ^{:key path}
                     [:div.subtree-wrapper {:style {:margin "10px 0"}}
                       [:div.subtree
                             [subtree
                               (get-in @data path)
                               [:button.subtree-button {:on-click #(swap! subtree-paths disj path)}
                                 [:span.subtree-button-string
                                   (str path)]]]]])
                @subtree-paths))]
          [subtree @data [:span.label "app-db"]]]])))

Rename label to app-db

Rename label to app-db


(ns discuss.communication.main
  "Functions concerning the communication with the remote discussion system."
  (:require [ajax.core :refer [GET POST]]
            [goog.string :refer [htmlEscape]]
            [clojure.walk :refer [keywordize-keys]]
            [discuss.config :as config]
            [discuss.utils.common :as lib]))

;;; Auxiliary functions
(defn make-url
  "Prefix url with host."
  [url]
  (str (:host config/api) url))

(defn token-header
  "Return token header for ajax request if user is logged in."
  []
  (when (lib/logged-in?)
    {"X-Messaging-Token" (lib/get-token)}))

(defn process-response
  "Generic success handler, which sets error handling and returns a cljs-compatible response."
  [response]
  (let [res (lib/json->clj response)
        error (:error res)]
    (lib/loading? false)
    (if (pos? (count error))
      (lib/error-msg! error)
      (do
        (lib/no-error!)
        res))))

;;;; Handlers
(defn error-handler
  "Generic error handler for ajax requests."
  [{:keys [status status-text]}]
  (.log js/console (str "I feel a disturbance in the Force... " status " " status-text))
  (lib/error-msg! (str status " " status-text))
  (lib/loading? false))

(defn success-handler-next-view
  "After the successful ajax call, change the view to the previously saved next view."
  [response]
  (lib/change-to-next-view!)
  (lib/update-all-states! response))

;;;; Calls
(defn ajax-get
  "Make ajax call to dialogue based argumentation system."
  ([url headers handler]
   (lib/no-error!)
   (lib/last-api! url)
   (lib/loading? true)
   (GET (make-url url)
        {:handler       handler
         :headers       (merge (token-header) headers)
         :error-handler error-handler}))
  ([url headers] (ajax-get url headers lib/update-all-states!))
  ([url] (ajax-get url {})))

(defn ajax-get-and-change-view
    "Make ajax call to jump right into the discussion and change to discussion view."
    [url view]
    (lib/next-view! view)
    (ajax-get url {} success-handler-next-view))

(defn process-url-handler
  "React on response after sending a new statement. Reset atom and call newly received url."
  [response]
  (let [res (process-response response)
        url (:url res)]
    (lib/hide-add-form!)
    (lib/update-state-item! :layout :add-type (fn [_] nil))
    (ajax-get url)))

(defn references-handler
  "Called when received a response on the reference-query."
  [response]
  (let [res (process-response response)
        refs (:references res)]
    (lib/update-state-item! :common :references (fn [_] refs))
    (discuss.references.integration/process-references refs)))

;;;; Discussion-related functions
(defn get-conclusion-id
  "Returns statement id to which the newly added statement is referred to.
   Currently this is stored in the data_statement_uid of the first bubble."
  []
  (let [bubble (first (lib/get-bubbles))]
    (:data_statement_uid bubble)))

;;;; POST functions
(defn post-json
  "Wrapper to prepare a POST request. Sending and receiving JSON."
  ([url body handler headers]
   (POST (make-url url)
         {:body            (lib/clj->json body)
          :handler         handler
          :error-handler   error-handler
          :format          :json
          :response-format :json
          :headers         headers
          :keywords?       true}))
  ([url body handler]
   (post-json url body handler {"Content-Type" "application/json"}))
  ([url body]
   (post-json url body process-url-handler {"Content-Type" "application/json"})))

(defn request-references
  "When this app is loaded, request all available references from the external discussion system."
  []
  (let [url (str (:base config/api) (get-in config/api [:get :references]))
        headers {"X-Host" js/location.host
                 "X-Path" js/location.pathname}]
    (ajax-get url headers references-handler)))

(defn post-statement [statement reference add-type]
  (let [url (str (:base config/api) (get-in config/api [:add add-type]))
        headers (merge {"Content-Type" "application/json"} (token-header))
        body {:statement     (htmlEscape statement)
              :reference     (htmlEscape reference)
              :conclusion_id (get-conclusion-id)            ; Relevant for add-start-premise
              :supportive    (get-in @lib/app-state [:discussion :is_supportive])
              :arg_uid       (get-in @lib/app-state [:discussion :arg_uid]) ; For premisses for arguments
              :attack_type   (get-in @lib/app-state [:discussion :attack_type])
              :host          js/location.host
              :path          js/location.pathname
              :issue_id      (get-in @lib/app-state [:issues :uid])
              :slug          (get-in @lib/app-state [:issues :slug])}]
    (post-json url body process-url-handler headers)))

;;;; For preparation
(defn dispatch-add-action
  "Check which action needs to be performed based on the type previously stored in the app-state."
  [statement reference]
  (let [action (get-in @lib/app-state [:layout :add-type])]
    (cond
      (= action :add-start-statement) (post-statement statement reference :add-start-statement)
      (= action :add-start-premise) (post-statement [statement] reference :add-start-premise)
      (= action :add-justify-premise) (post-statement [statement] reference :add-justify-premise)
      :else (println "Action not found:" action))))

(defn prepare-add
  "Save current add-method and show add form."
  [add-type]
  (lib/update-state-item! :layout :add-type (fn [_] add-type))
  (lib/show-add-form!))

(defn item-click
  "Prepare which action has to be done when clicking an item."
  [id url]
  (lib/hide-add-form!)
  (cond
    (= id "item_start_statement") (prepare-add :add-start-statement)
    (= id "item_start_premise") (prepare-add :add-start-premise)
    (= id "item_justify_premise") (prepare-add :add-justify-premise)
    (= url "add") (prepare-add "add")
    (= url "login") (lib/change-view! :login)
    :else (ajax-get url)))

;;;; Get things started!
(defn init!
  "Request initial data from API."
  []
  (let [url (:init config/api)]
    (lib/update-state-item! :layout :add? (fn [_] false))
    (ajax-get-and-change-view url :default)))

(defn init-with-references!
  "Load discussion and initially get reference to include them in the discussion."
  []
  (request-references)
  (init!))

(defn resend-last-api
  "Resends stored url from last api call."
  []
  (ajax-get (lib/get-last-api)))

(ns discuss.communication.main
  "Functions concerning the communication with the remote discussion system."
  (:require [ajax.core :refer [GET POST]]
            [goog.string :refer [htmlEscape]]
            [clojure.walk :refer [keywordize-keys]]
            [discuss.config :as config]
            [discuss.utils.common :as lib]))

;;; Auxiliary functions
(defn make-url
  "Prefix url with host."
  [url]
  (str (:host config/api) url))

(defn token-header
  "Return token header for ajax request if user is logged in."
  []
  (when (lib/logged-in?)
    {"X-Messaging-Token" (lib/get-token)}))

(defn process-response
  "Generic success handler, which sets error handling and returns a cljs-compatible response."
  [response]
  (let [res (lib/json->clj response)
        error (:error res)]
    (lib/loading? false)
    (if (pos? (count error))
      (lib/error-msg! error)
      (do
        (lib/no-error!)
        res))))

;;;; Handlers
(defn error-handler
  "Generic error handler for ajax requests."
  [{:keys [status status-text response]}]
  (cond
    (= 400 status) (lib/error-msg! (:error (:location (first (:errors response))))))
  (.log js/console (str "I feel a disturbance in the Force... " status " " status-text))
  (lib/loading? false))

(defn success-handler-next-view
  "After the successful ajax call, change the view to the previously saved next view."
  [response]
  (lib/change-to-next-view!)
  (lib/update-all-states! response))

;;;; Calls
(defn ajax-get
  "Make ajax call to dialogue based argumentation system."
  ([url headers handler]
   (lib/no-error!)
   (lib/last-api! url)
   (lib/loading? true)
   (GET (make-url url)
        {:handler       handler
         :headers       (merge (token-header) headers)
         :error-handler error-handler}))
  ([url headers] (ajax-get url headers lib/update-all-states!))
  ([url] (ajax-get url {})))

(defn ajax-get-and-change-view
    "Make ajax call to jump right into the discussion and change to discussion view."
    [url view]
    (lib/next-view! view)
    (ajax-get url {} success-handler-next-view))

(defn process-url-handler
  "React on response after sending a new statement. Reset atom and call newly received url."
  [response]
  (let [res (process-response response)
        url (:url res)]
    (lib/hide-add-form!)
    (lib/update-state-item! :layout :add-type (fn [_] nil))
    (ajax-get url)))

(defn references-handler
  "Called when received a response on the reference-query."
  [response]
  (let [res (process-response response)
        refs (:references res)]
    (lib/update-state-item! :common :references (fn [_] refs))
    (discuss.references.integration/process-references refs)))

;;;; Discussion-related functions
(defn get-conclusion-id
  "Returns statement id to which the newly added statement is referred to.
   Currently this is stored in the data_statement_uid of the first bubble."
  []
  (let [bubble (first (lib/get-bubbles))]
    (:data_statement_uid bubble)))

;;;; POST functions
(defn post-json
  "Wrapper to prepare a POST request. Sending and receiving JSON."
  ([url body handler headers]
   (POST (make-url url)
         {:body            (lib/clj->json body)
          :handler         handler
          :error-handler   error-handler
          :format          :json
          :response-format :json
          :headers         headers
          :keywords?       true}))
  ([url body handler]
   (post-json url body handler {"Content-Type" "application/json"}))
  ([url body]
   (post-json url body process-url-handler {"Content-Type" "application/json"})))

(defn request-references
  "When this app is loaded, request all available references from the external discussion system."
  []
  (let [url (str (:base config/api) (get-in config/api [:get :references]))
        headers {"X-Host" js/location.host
                 "X-Path" js/location.pathname}]
    (ajax-get url headers references-handler)))

(defn post-statement [statement reference add-type]
  (let [url (str (:base config/api) (get-in config/api [:add add-type]))
        headers (merge {"Content-Type" "application/json"} (token-header))
        body {:statement     (htmlEscape statement)
              :reference     (htmlEscape reference)
              :conclusion_id (get-conclusion-id)            ; Relevant for add-start-premise
              :supportive    (get-in @lib/app-state [:discussion :is_supportive])
              :arg_uid       (get-in @lib/app-state [:discussion :arg_uid]) ; For premisses for arguments
              :attack_type   (get-in @lib/app-state [:discussion :attack_type])
              :host          js/location.host
              :path          js/location.pathname
              :issue_id      (get-in @lib/app-state [:issues :uid])
              :slug          (get-in @lib/app-state [:issues :slug])}]
    (post-json url body process-url-handler headers)))

;;;; For preparation
(defn dispatch-add-action
  "Check which action needs to be performed based on the type previously stored in the app-state."
  [statement reference]
  (let [action (get-in @lib/app-state [:layout :add-type])]
    (cond
      (= action :add-start-statement) (post-statement statement reference :add-start-statement)
      (= action :add-start-premise) (post-statement [statement] reference :add-start-premise)
      (= action :add-justify-premise) (post-statement [statement] reference :add-justify-premise)
      :else (println "Action not found:" action))))

(defn prepare-add
  "Save current add-method and show add form."
  [add-type]
  (lib/update-state-item! :layout :add-type (fn [_] add-type))
  (lib/show-add-form!))

(defn item-click
  "Prepare which action has to be done when clicking an item."
  [id url]
  (lib/hide-add-form!)
  (cond
    (= id "item_start_statement") (prepare-add :add-start-statement)
    (= id "item_start_premise") (prepare-add :add-start-premise)
    (= id "item_justify_premise") (prepare-add :add-justify-premise)
    (= url "add") (prepare-add "add")
    (= url "login") (lib/change-view! :login)
    :else (ajax-get url)))

;;;; Get things started!
(defn init!
  "Request initial data from API."
  []
  (let [url (:init config/api)]
    (lib/update-state-item! :layout :add? (fn [_] false))
    (ajax-get-and-change-view url :default)))

(defn init-with-references!
  "Load discussion and initially get reference to include them in the discussion."
  []
  (request-references)
  (init!))

(defn resend-last-api
  "Resends stored url from last api call."
  []
  (ajax-get (lib/get-last-api)))

Update error displaying

Update error displaying


(ns gangway.web-test
  (:require [clojure.test :refer :all]
            [clj-http.client :as http]
            [immutant.messaging :as msg]
            [immutant.util]
            [clojure.data.json :as json]
            [gangway.util :as gw-util]
            [gangway.web :as gw-web]))

(def invalid-message
  (json/json-str
   [{:header {:operation :assert
              :entity-id {:task-id 137}
              :entity-type :task}
     :payload {:entity {:id-sk-origin "vlacs"
                        :name "Master the art of addition"
                        :description "This is some sort of description"}}}]))

(def valid-message
  (json/json-str
   [{:header {:operation :assert
              :entity-id {:task-id 17}
              :entity-type :task}
     :payload {:entity {:id-sk-origin "vlacs"
                        :name "Master the art of addition"
                        :version "v3"
                        :description "This is some sort of description"}}}]))

(deftest remote-http-test-malformed
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:headers {"Authorization" "Token T0_V&(1AZ#U1$X3EXQL@K!OJ568G4&3DL55!5MU16E#E6TY%KV!3O1QB&L2!QSXT"}
                 :body invalid-message
                 :throw-exceptions false})]
    (testing "malformed request (missing a required field)"
      (is (= 400 (:status result))))))

(deftest remote-http-test-success
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:headers {"Authorization" "Token T0_V&(1AZ#U1$X3EXQL@K!OJ568G4&3DL55!5MU16E#E6TY%KV!3O1QB&L2!QSXT"}
                 :body valid-message
                 :throw-exceptions false})]
    (testing "successful request"
      (is (= 201 (:status result))))))

(deftest remote-http-test-authentication-incorrect-token
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:headers {"Authorization" "Token thistokenisinvalid"}
                 :body valid-message
                 :throw-exceptions false})]
    (testing "incorrect authentication token"
      (is (= 401 (:status result))))))

(deftest remote-http-test-authentication-no-header
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:body valid-message
                 :throw-exceptions false})]
    (testing "authentication token missing from header"
      (is (= 401 (:status result))))))

(ns gangway.web-test
  (:require [clojure.test :refer :all]
            [clj-http.client :as http]
            [immutant.messaging :as msg]
            [immutant.util]
            [clojure.data.json :as json]
            [galleon]
            [gangway.auth :as gw-auth]
            [gangway.util :as gw-util]
            [gangway.web :as gw-web]))

(def token (:token (gw-auth/add-queue-token! "Testing" 3 (:db-conn galleon/system))))

(def invalid-message
  (json/json-str
   [{:header {:operation :assert
              :entity-id {:task-id 137}
              :entity-type :task}
     :payload {:entity {:id-sk-origin "vlacs"
                        :name "Master the art of addition"
                        :description "This is some sort of description"}}}]))

(def valid-message
  (json/json-str
   [{:header {:operation :assert
              :entity-id {:task-id 17}
              :entity-type :task}
     :payload {:entity {:id-sk-origin "vlacs"
                        :name "Master the art of addition"
                        :version "v3"
                        :description "This is some sort of description"}}}]))

(deftest remote-http-test-malformed
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:headers {"Authorization" (format "Token %s" token)}
                 :body invalid-message
                 :throw-exceptions false})]
    (testing "malformed request (missing a required field)"
      (is (= 400 (:status result))))))

(deftest remote-http-test-success
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:headers {"Authorization" (format "Token %s" token)}
                 :body valid-message
                 :throw-exceptions false})]
    (testing "successful request"
      (is (= 201 (:status result))))))

(deftest remote-http-test-authentication-incorrect-token
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:headers {"Authorization" "Token thisisnotavalidtoken"}
                 :body valid-message
                 :throw-exceptions false})]
    (testing "incorrect authentication token"
      (is (= 401 (:status result))))))

(deftest remote-http-test-authentication-no-header
  (let [result (http/post
                (format "%s/gangway/in/showevidence" (immutant.util/app-uri))
                {:body valid-message
                 :throw-exceptions false})]
    (testing "authentication token missing from header"
      (is (= 401 (:status result))))))

update tests to generate a new token, add it to datomic, and use the generated token


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

(ns beehive.metrics
  (:require [beehive.utils :as utils]
            [beehive.enums :as enums])
  (:import (beehive.java EmptyEnum ToCLJ)
           (net.uncontended.precipice.metrics Metrics Rolling IntervalIterator)
           (net.uncontended.precipice.metrics.counts PartitionedCount
                                                     NoOpCounter
                                                     TotalCounts
                                                     RollingCounts)
           (net.uncontended.precipice.metrics.latency TotalLatency
                                                      NoOpLatency
                                                      ConcurrentHistogram
                                                      PartitionedLatency)
           (java.util.concurrent TimeUnit)
           (java.util Iterator NoSuchElementException)
           (net.uncontended.precipice.metrics.tools Capturer)))

(set! *warn-on-reflection* true)

(defn- counter-to-map [^PartitionedCount counts]
  (persistent!
    (reduce (fn [acc ^ToCLJ e]
              (assoc! acc (.keyword e) (.getCount counts e)))
            (transient {})
            (.getEnumConstants (.getMetricClazz counts)))))

(defn- switcher [^Metrics m]
  ;; TODO: Clarify Precipice Interface
  (if (instance? Capturer m)
    nil
    (counter-to-map m)))

(deftype SingleIterator
  [start-millis iterator-start-millis func ^:unsynchronized-mutable is-realized?]
  Iterator
  (next [this]
    (if is-realized?
      (throw (NoSuchElementException.))
      (do (set! is-realized? true)
          {:start-millis start-millis
           :end-millis iterator-start-millis
           :counts (func)})))
  (hasNext [this]
    (not is-realized?))
  (remove [_]
    (throw (UnsupportedOperationException. "remove"))))

(deftype MetricIterator [iterator-start-millis func ^IntervalIterator iterator]
  Iterator
  (next [this]
    {:start-millis (+ iterator-start-millis
                      (.toMillis TimeUnit/NANOSECONDS (.intervalStart iterator)))
     :end-millis (+ iterator-start-millis
                    (.toMillis TimeUnit/NANOSECONDS (.intervalEnd iterator)))
     :counts (func this)})
  (hasNext [this]
    (.hasNext iterator))
  (remove [_]
    (throw (UnsupportedOperationException. "remove"))))

(defn decorate1 [^Metrics precipice-metrics]
  (let [current-millis (System/currentTimeMillis)]
    (if (instance? Rolling precipice-metrics)
      (->MetricIterator
        current-millis
        counter-to-map
        (.intervals ^Rolling precipice-metrics))
      ;; TODO: Figure out start millis
      (->SingleIterator 0 current-millis switcher false))))

(defprotocol CountsView
  (get-count [this metric]))

(defn- get-metric-count [^PartitionedCount counter metric key->enum]
  (when-let [metric (get key->enum metric)]
    (.getCount counter metric)))

(defn decorate-counts [^Metrics precipice-metrics]
  (let [key->enum (enums/enum-class-to-keyword->enum
                    (.getMetricClazz precipice-metrics))]
    (with-meta
      (reify
        CountsView
        (get-count [this metric]
          (get-metric-count precipice-metrics metric key->enum)))
      {:precipice-metrics precipice-metrics})))

(defn no-op-counts
  ([] (no-op-counts EmptyEnum))
  ([^Class enum-class]
   (decorate-counts (TotalCounts. (NoOpCounter. enum-class)))))

(defn count-metrics [^Class enum-class]
  (if-not (identical? enum-class EmptyEnum)
    (decorate-counts (TotalCounts. enum-class))
    (no-op-counts)))

(defn count-recorder [^Class enum-class]
  )

(defn rolling-count-metrics
  ([enum-class] (rolling-count-metrics enum-class (* 60 15) 1 :seconds))
  ([^Class enum-class slots-to-track resolution time-unit]
   (if-not (identical? enum-class EmptyEnum)
     (let [^TimeUnit time-unit (utils/->time-unit time-unit)
           nanos-per (.toNanos time-unit (long resolution))]
       (decorate-counts
         (RollingCounts. enum-class (int slots-to-track) nanos-per)))
     (no-op-counts))))

(defprotocol LatencyView
  (get-latency [this metric percentile]))

(defn- latency-at-percentile
  [^PartitionedLatency latency-metrics metric percentile key->enum]
  (when-let [enum (get key->enum metric)]
    (.getValueAtPercentile latency-metrics enum percentile)))

(defn- precipice-metrics [enum-class]
  (TotalLatency. (ConcurrentHistogram. enum-class)))

(defn- decorate-latency [^Metrics precipice-metrics]
  (let [key->enum (enums/enum-class-to-keyword->enum
                    (.getMetricClazz precipice-metrics))]
    (with-meta
      (reify
        LatencyView
        (get-latency [this metric percentile]
          (latency-at-percentile precipice-metrics metric percentile key->enum)))
      {:precipice-metrics precipice-metrics})))

(defn no-op-latency-metrics
  ([] (no-op-latency-metrics EmptyEnum))
  ([^Class enum-class]
   (let [precipice-metrics (TotalLatency. (NoOpLatency. enum-class))]
     (decorate-latency precipice-metrics))))

(defn latency-metrics [enum-class]
  (if-not (identical? enum-class EmptyEnum)
    (let [precipice-metrics (precipice-metrics enum-class)]
      (decorate-latency precipice-metrics))
    (no-op-latency-metrics)))

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

(ns beehive.metrics
  (:require [beehive.utils :as utils]
            [beehive.enums :as enums])
  (:import (beehive.java EmptyEnum ToCLJ)
           (net.uncontended.precipice.metrics Metrics Rolling IntervalIterator)
           (net.uncontended.precipice.metrics.counts PartitionedCount
                                                     NoOpCounter
                                                     TotalCounts
                                                     RollingCounts)
           (net.uncontended.precipice.metrics.latency TotalLatency
                                                      NoOpLatency
                                                      ConcurrentHistogram
                                                      PartitionedLatency)
           (java.util.concurrent TimeUnit)
           (java.util Iterator NoSuchElementException)
           (net.uncontended.precipice.metrics.tools Capturer)))

(set! *warn-on-reflection* true)

(defn- counter-to-map [^PartitionedCount counts]
  (persistent!
    (reduce (fn [acc ^ToCLJ e]
              (assoc! acc (.keyword e) (.getCount counts e)))
            (transient {})
            (.getEnumConstants (.getMetricClazz counts)))))

(defn- switcher [^Metrics m]
  ;; TODO: Clarify Precipice Interface
  (if (instance? Capturer m)
    nil
    (counter-to-map m)))

(deftype SingleIterator
  [start-millis iterator-start-millis metrics func ^:unsynchronized-mutable is-realized?]
  Iterator
  (next [this]
    (if is-realized?
      (throw (NoSuchElementException.))
      (do (set! is-realized? true)
          {:start-millis start-millis
           :end-millis iterator-start-millis
           :counts (func metrics)})))
  (hasNext [this]
    (not is-realized?))
  (remove [_]
    (throw (UnsupportedOperationException. "remove"))))

(deftype MetricIterator [iterator-start-millis func ^IntervalIterator iterator]
  Iterator
  (next [this]
    {:start-millis (+ iterator-start-millis
                      (.toMillis TimeUnit/NANOSECONDS (.intervalStart iterator)))
     :end-millis (+ iterator-start-millis
                    (.toMillis TimeUnit/NANOSECONDS (.intervalEnd iterator)))
     :counts (func this)})
  (hasNext [this]
    (.hasNext iterator))
  (remove [_]
    (throw (UnsupportedOperationException. "remove"))))

(defn decorate1 [{:keys [start-millis precipice-metrics]}]
  (let [current-millis (System/currentTimeMillis)]
    (if (instance? Rolling precipice-metrics)
      (->MetricIterator
        current-millis
        counter-to-map
        (.intervals ^Rolling precipice-metrics))
      (->SingleIterator start-millis current-millis precipice-metrics switcher false))))

(defprotocol CountsView
  (get-count [this metric]))

(defn- get-metric-count [^PartitionedCount counter metric key->enum]
  (when-let [metric (get key->enum metric)]
    (.getCount counter metric)))

(defn decorate-counts [^Metrics precipice-metrics]
  (let [key->enum (enums/enum-class-to-keyword->enum
                    (.getMetricClazz precipice-metrics))]
    (with-meta
      (reify
        CountsView
        (get-count [this metric]
          (get-metric-count precipice-metrics metric key->enum)))
      {:precipice-metrics precipice-metrics})))

(defn no-op-counts
  ([] (no-op-counts EmptyEnum))
  ([^Class enum-class]
   (decorate-counts (TotalCounts. (NoOpCounter. enum-class)))))

(defn count-metrics [^Class enum-class]
  (if-not (identical? enum-class EmptyEnum)
    (decorate-counts (TotalCounts. enum-class))
    (no-op-counts)))

(defn count-recorder [^Class enum-class]
  )

(defn rolling-count-metrics
  ([enum-class] (rolling-count-metrics enum-class (* 60 15) 1 :seconds))
  ([^Class enum-class slots-to-track resolution time-unit]
   (if-not (identical? enum-class EmptyEnum)
     (let [^TimeUnit time-unit (utils/->time-unit time-unit)
           nanos-per (.toNanos time-unit (long resolution))]
       (decorate-counts
         (RollingCounts. enum-class (int slots-to-track) nanos-per)))
     (no-op-counts))))

(defprotocol LatencyView
  (get-latency [this metric percentile]))

(defn- latency-at-percentile
  [^PartitionedLatency latency-metrics metric percentile key->enum]
  (when-let [enum (get key->enum metric)]
    (.getValueAtPercentile latency-metrics enum percentile)))

(defn- precipice-metrics [enum-class]
  (TotalLatency. (ConcurrentHistogram. enum-class)))

(defn- decorate-latency [^Metrics precipice-metrics]
  (let [key->enum (enums/enum-class-to-keyword->enum
                    (.getMetricClazz precipice-metrics))]
    (with-meta
      (reify
        LatencyView
        (get-latency [this metric percentile]
          (latency-at-percentile precipice-metrics metric percentile key->enum)))
      {:precipice-metrics precipice-metrics})))

(defn no-op-latency-metrics
  ([] (no-op-latency-metrics EmptyEnum))
  ([^Class enum-class]
   (let [precipice-metrics (TotalLatency. (NoOpLatency. enum-class))]
     (decorate-latency precipice-metrics))))

(defn latency-metrics [enum-class]
  (if-not (identical? enum-class EmptyEnum)
    (let [precipice-metrics (precipice-metrics enum-class)]
      (decorate-latency precipice-metrics))
    (no-op-latency-metrics)))

Work on implementing total metrics iterator


(ns caesium.binding
  (:require [clojure.string :as s])
  (:import [jnr.ffi LibraryLoader]
           [jnr.ffi.annotations In Out Pinned LongLong]
           [jnr.ffi.types size_t]))

(definterface Sodium
  (^int sodium_init [])
  (^String sodium_version_string [])

  (^void randombytes
   [^bytes ^{Pinned {}} buf
    ^long ^{LongLong {}} buflen])

  (^long ^{size_t {}} crypto_secretbox_keybytes [])
  (^long ^{size_t {}} crypto_secretbox_noncebytes [])
  (^long ^{size_t {}} crypto_secretbox_macbytes [])
  (^String ^{size_t {}} crypto_secretbox_primitive[])

  (^long ^{size_t {}} crypto_generichash_bytes_min [])
  (^long ^{size_t {}} crypto_generichash_bytes_max [])
  (^long ^{size_t {}} crypto_generichash_bytes [])
  (^long ^{size_t {}} crypto_generichash_keybytes_min [])
  (^long ^{size_t {}} crypto_generichash_keybytes_max [])
  (^long ^{size_t {}} crypto_generichash_keybytes [])
  (^String crypto_generichash_primitive [])
  (^int crypto_generichash
   [^bytes ^{Pinned {}} buf
    ^long ^{LongLong {}} buflen
    ^bytes ^{Pinned {}} msg
    ^long ^{LongLong {}} msglen
    ^bytes ^{Pinned {}} key
    ^long ^{LongLong {}} keylen])

  ;; TODO: how do I reference a crypto_generichash_state *?

  (^int crypto_hash_sha256_bytes [])
  (^int crypto_hash_sha256
   [^bytes ^{Pinned {}} buf
    ^bytes ^{Pinned {}} msg
    ^long ^{LongLong {}} msglen])

  (^int crypto_hash_sha512_bytes [])
  (^int crypto_hash_sha512
   [^bytes ^{Pinned {}} buf
    ^bytes ^{Pinned {}} msg
    ^long ^{LongLong {}} msglen]))

(def ^Sodium sodium
  (let [loader (LibraryLoader/create Sodium)]
    (.load loader "sodium")))

(assert (#{0 1} (.sodium_init sodium)))

(defn prefix
  "Gets the parts of the current namespace, minus the leading `caesium`."
  []
  (-> *ns* ns-name str (s/split #"\.") rest vec))

(defmacro defconsts
  "Given constant names (syms) in the C pseudo-namespace corresponding
  to the current namespace, call the corresponding libsodium function
  the get the constants and assign them to vars."
  [consts]
  (let [prefix (-> *ns* ns-name str (s/split #"\.") rest vec)]
    `(do
       ~@(for [const consts]
           (let [name (-> const name (s/replace "-" "_") symbol)
                 call (->> name (conj (prefix)) (s/join "_") (str ".") symbol)]
             `(def ~const (~call sodium)))))))

;; int crypto_generichash(unsigned char *out, size_t outlen,
;;                                 const unsigned char *in, unsigned long long inlen,
;;                                 const unsigned char *key, size_t keylen);

;; SODIUM_EXPORT
;; int crypto_generichash_init(crypto_generichash_state *state,
;;                                                      const unsigned char *key,
;;                                                      const size_t keylen, const size_t outlen);

;; SODIUM_EXPORT
;; int crypto_generichash_update(crypto_generichash_state *state,
;;                                                        const unsigned char *in,
;;                                                        unsigned long long inlen);

;; SODIUM_EXPORT
;; int crypto_generichash_final(crypto_generichash_state *state,
;;                                                       unsigned char *out, const size_t outlen);

(ns caesium.binding
  (:require [clojure.string :as s])
  (:import [jnr.ffi LibraryLoader]
           [jnr.ffi.annotations In Out Pinned LongLong]
           [jnr.ffi.types size_t]))

(definterface Sodium
  (^int sodium_init [])
  (^String sodium_version_string [])

  (^void randombytes
   [^bytes ^{Pinned {}} buf
    ^long ^{LongLong {}} buflen])

  (^long ^{size_t {}} crypto_secretbox_keybytes [])
  (^long ^{size_t {}} crypto_secretbox_noncebytes [])
  (^long ^{size_t {}} crypto_secretbox_macbytes [])
  (^String ^{size_t {}} crypto_secretbox_primitive[])

  (^long ^{size_t {}} crypto_generichash_bytes_min [])
  (^long ^{size_t {}} crypto_generichash_bytes_max [])
  (^long ^{size_t {}} crypto_generichash_bytes [])
  (^long ^{size_t {}} crypto_generichash_keybytes_min [])
  (^long ^{size_t {}} crypto_generichash_keybytes_max [])
  (^long ^{size_t {}} crypto_generichash_keybytes [])
  (^String crypto_generichash_primitive [])
  (^int crypto_generichash
   [^bytes ^{Pinned {}} buf
    ^long ^{LongLong {}} buflen
    ^bytes ^{Pinned {}} msg
    ^long ^{LongLong {}} msglen
    ^bytes ^{Pinned {}} key
    ^long ^{LongLong {}} keylen])

  ;; TODO: how do I reference a crypto_generichash_state *?

  (^int crypto_hash_sha256_bytes [])
  (^int crypto_hash_sha256
   [^bytes ^{Pinned {}} buf
    ^bytes ^{Pinned {}} msg
    ^long ^{LongLong {}} msglen])

  (^int crypto_hash_sha512_bytes [])
  (^int crypto_hash_sha512
   [^bytes ^{Pinned {}} buf
    ^bytes ^{Pinned {}} msg
    ^long ^{LongLong {}} msglen]))

(def ^Sodium sodium
  "The sodium library singleton instance."
  (let [loader (LibraryLoader/create Sodium)]
    (.load loader "sodium")))

(assert (#{0 1} (.sodium_init sodium)))

(defn prefix
  "Gets the parts of the current namespace, minus the leading `caesium`."
  []
  (-> *ns* ns-name str (s/split #"\.") rest vec))

(defmacro defconsts
  "Given constant names (syms) in the C pseudo-namespace corresponding
  to the current namespace, call the corresponding libsodium function
  the get the constants and assign them to vars."
  [consts]
  (let [prefix (-> *ns* ns-name str (s/split #"\.") rest vec)]
    `(do
       ~@(for [const consts]
           (let [name (-> const name (s/replace "-" "_") symbol)
                 call (->> name (conj (prefix)) (s/join "_") (str ".") symbol)]
             `(def ~const (~call sodium)))))))

;; int crypto_generichash(unsigned char *out, size_t outlen,
;;                                 const unsigned char *in, unsigned long long inlen,
;;                                 const unsigned char *key, size_t keylen);

;; SODIUM_EXPORT
;; int crypto_generichash_init(crypto_generichash_state *state,
;;                                                      const unsigned char *key,
;;                                                      const size_t keylen, const size_t outlen);

;; SODIUM_EXPORT
;; int crypto_generichash_update(crypto_generichash_state *state,
;;                                                        const unsigned char *in,
;;                                                        unsigned long long inlen);

;; SODIUM_EXPORT
;; int crypto_generichash_final(crypto_generichash_state *state,
;;                                                       unsigned char *out, const size_t outlen);

Document sodium instance

Document sodium instance