(ns babel.generate
  (:refer-clojure :exclude [assoc-in get-in deref resolve find parents])
  (:require
   [babel.index :refer [intersection-with-identity]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.math.combinatorics :as combo]
   [clojure.string :as string]
   [dag_unify.core :refer [assoc-in assoc-in! copy create-path-in
                           dissoc-paths fail-path get-in fail? strip-refs unify unify!]]))

;; during generation, will not decend deeper than this when creating a tree:
;; TODO: should also be possible to override per-language.
(def ^:const max-depth 5)
(def ^:const max-total-depth max-depth)

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

(def ^:const handle-unify-fail #(log/debug %))
(def ^:const throw-exception-on-unify-fail false)

(def ^:const shufflefn
  (fn [x]
    ;; deterministic generation:
;;    x
    ;; nondeterministic generation
    (lazy-seq (shuffle x))

    ))

;; whether to remove [:head] and [:comp] paths from generated trees after generation:
;; for performance.
(def ^:const truncate false)

(declare add-comp-to-bolts)
(declare add-comps-to-bolt)
(declare add-to-bolt-at-path)
(declare candidate-parents)
(declare get-bolts-for)
(declare get-lexemes)
(declare lightning-bolts)
(declare comp-paths)
(declare gen)
(declare show-spec)

(defn generate
  "Return one expression matching spec _spec_ given the model _model_."
  [spec language-model]
  (log/debug (str "(generate) with model named: " (:name language-model)))
  (first (gen spec language-model 0)))

(defn gen
  "Return a lazy sequence of every possible tree given a specification and a model."
  [spec model depth & [from-bolts at-path]]
  (log/debug (str "gen@" depth "; spec=" (show-spec spec)))
  (if (< depth max-depth)
    (let [bolts (or from-bolts
                    (get-bolts-for model spec
                                   depth))]
      (if (not (empty? bolts))
        (lazy-cat
         (let [bolt (first bolts)]
           (or
            (and (= false (get-in bolt [:phrasal] true))
                 ;; This is not a bolt but rather simply a lexical head,
                 ;; so just return a list with this lexical head:
                 [bolt])
            ;; ..otherwise it's a phrase, so return the lazy
            ;; sequence of adding all possible complements at every possible
            ;; position at the bolt.
            (add-comps-to-bolt bolt model
                               (comp-paths depth))))
         (gen spec model depth
               (rest bolts)
               at-path))
        (if (not (= false (get-in spec [:phrasal] true)))
          (gen spec model (+ 1 depth) nil at-path))))))

(defn get-bolts-for [model spec depth]
  (let [result
        ;; TODO: this is an example of obtaining pre-computed bolts
        ;; from a model given a spec and a depth.
        ;; This is a contrived example - should be
        ;; for the model to provide these given a spec and a depth.
        (and (= () (get-in spec [:synsem :subcat]))
             (= :verb (get-in spec [:synsem :cat]))
             (= :present (get-in spec [:synsem :sem :tense]))
             (= true (get-in spec [:synsem :sem :reflexive]))
             (= :perfect (get-in spec [:synsem :sem :aspect]))
             (not (nil? (:reflexive-bolts model))))]
    (cond
      (and (= depth 3) (= result true))
      (shufflefn (->> (:reflexive-bolts model)
                      (map #(unify spec %))
                      (filter #(not (= :fail %)))))
      (= result true) []
      true (lightning-bolts model spec 0 depth))))

(defn lightning-bolts
  [model spec depth max-depth & [use-candidate-parents]]
  ;; Generate 'lightning bolts':
  ;;
  ;;
  ;;   H        H    H
  ;;    \      /      \
  ;;     H    H        H        ...
  ;;    /      \        \
  ;;   H        ..       ..
  ;;    \
  ;;     ..
  ;;
  ;; Each bolt is a tree with only one child per parent: the head child.
  ;; Each head child may be a leaf or
  ;; otherwise has a child with the same two options (leaf or a head child),
  ;; up to the maximum depth.
  (if (< depth max-depth)
    (let [candidate-parents (or use-candidate-parents
                                (->>
                                 (candidate-parents (:grammar model) spec depth)
                                 (map #(unify % spec))
                                 (filter #(not (= :fail %)))
                                 (shufflefn)))]
      (if (not (empty? candidate-parents))
        (let [candidate-parent (first candidate-parents)]
          (lazy-cat
           (if (not (= false (get-in spec [:phrasal] true)))
             (->> (lightning-bolts model
                                   (get-in candidate-parent [:head])
                                   (+ 1 depth)
                                   max-depth)
                  (map (fn [head]
                         (assoc-in candidate-parent [:head] head)))))
           (lightning-bolts model spec depth max-depth (rest candidate-parents))))))
    (shufflefn (get-lexemes model spec))))

(defn add-comps-to-bolt
  "bolt + paths => trees"
  [bolt model comp-paths]
  ;;  (log/debug (str "add-comps-to-bolt: " ((:morph-ps model) bolt) " with this many paths: " (count comp-paths)))
  (if (not (empty? comp-paths))
    (add-comp-to-bolts
     (add-comps-to-bolt bolt model (rest comp-paths))
     (first comp-paths)
     model)
    [bolt]))

(defn add-comp-to-bolts
  "bolts + path => partial trees"
  [bolts path model]
  (if (not (empty? bolts))
    (do
      (log/trace (str "add-comp-to-bolts: path=" (vec path) "; first bolt=" ((:morph-ps model) (first bolts))))
      (lazy-cat
       (let [result
             (add-to-bolt-at-path (first bolts) path model)]
         result)
       (add-comp-to-bolts (rest bolts) path model)))))

(defn comp-paths
  "Find all paths to all complements (both terminal and non-terminal) given a depth. Returned in
   ascending length (shortest first)."
  ;; e.g., a tree of depth 2
  ;; will have the following paths:
  ;;   [:comp] [:head :comp]
  ;;   because it looks like:
  ;;
  ;;   H
  ;;  /=\
  ;; C   H
  ;;    /=\
  ;;   H   C
  ;;
  [depth]
  (cond
    (= depth 0)
    []
    (= depth 1)
    (list [:comp])
    true
    (cons
     (concat (take (- depth 1)
                   (repeatedly (fn [] :head)))
             [:comp])
     (comp-paths (- depth 1)))))

(defn add-to-bolt-at-path
  "bolt + path => partial trees"
  [bolt path model]
  (let [complements (gen (get-in bolt path) model 0 nil path)]
    (if (empty? complements)
      (log/warn (str "(improve grammar): no complements found for: "
                     ((:morph-ps model) bolt)
                     "; spec=" (show-spec
                                (get-in bolt path))))
      (->>
       ;; set of all complements at _path_ for _bolt_:
       complements

       ;; add each member _each_comp_ of this set to _bolt_:
       (map (fn [each-comp]
              (let [result
                    (dag_unify.core/assoc-in bolt path each-comp)]
                (->
                 result
                 ((fn [tree]
                    (if (:default-fn model)
                      ((:default-fn model) tree)
                      tree)))))))))))

(defn candidate-parents
  "find subset of _rules_ for which each member unifies successfully with _spec_; _depth_ is only used for diagnostic logging."
  [rules spec depth]
  (filter #(not (= :fail %))
          (mapfn (fn [rule]
                   (log/trace (str "candidate-parents: testing rule: " (:rule rule) "; depth: " depth))
                   (let [unified (unify spec rule)]
                     (if (= :fail unified)
                       (log/trace (str "candidate parent: " (:rule rule) " failed at:" (fail-path spec rule)))
                       (log/debug (str "candidate parent: " (:rule rule) " spec:" (show-spec spec)
                                       "; depth: " depth)))
                     unified))
                 rules)))

(defn get-lexemes [model spec]
  "Get lexemes matching the spec. Use a model's index if available, where the index is a function that we call with _spec_ to get a set of indices. otherwise use the model's entire lexeme."
  (->>

   (if (= false (get-in spec [:phrasal] false))
     (if-let [index-fn (:index-fn model)]
       (index-fn spec)
       (do
         (log/warn (str "get-lexemes: no index found: using entire lexicon."))
         (flatten (vals
                   (or (:lexicon (:generate model)) (:lexicon model)))))))
   (filter #(or (= false (get-in % [:exception] false))
                (not (= :verb (get-in % [:synsem :cat])))))
   (map #(unify % spec))
   (filter #(not (= :fail %)))))

(defn show-spec [spec]
  (str "cat=" (get-in spec [:synsem :cat])
       (if (get-in spec [:rule])
         (str "; rule=" (strip-refs (get-in spec [:rule]))))
       (if (not (= (get-in spec [:synsem :agr] ::none) ::none))
         (str "; agr=" (strip-refs (get-in spec [:synsem :agr]))))
       (if (get-in spec [:synsem :subcat :1 :cat])
         (str "; subcat1=" (strip-refs (get-in spec [:synsem :subcat :1 :cat]))))
       (if (get-in spec [:synsem :subcat :2 :cat])
         (str "; subcat2=" (strip-refs (get-in spec [:synsem :subcat :2 :cat]))))
       (if (get-in spec [:synsem :subcat :3 :cat])
         (str "; subcat3=" (strip-refs (get-in spec [:synsem :subcat :3 :cat]))))
       (if (not (= (get-in spec [:phrasal] ::none) ::none))
         (str "; phrasal=" (strip-refs (get-in spec [:phrasal]))))))

(ns babel.generate
  (:refer-clojure :exclude [assoc-in get-in deref resolve find parents])
  (:require
   [babel.index :refer [intersection-with-identity]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.math.combinatorics :as combo]
   [clojure.string :as string]
   [dag_unify.core :refer [assoc-in assoc-in! copy create-path-in
                           dissoc-paths fail-path get-in fail? strip-refs unify unify!]]))

;; during generation, will not decend deeper than this when creating a tree:
;; TODO: should also be possible to override per-language.
(def ^:const max-depth 5)
(def ^:const max-total-depth max-depth)

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

(def ^:const handle-unify-fail #(log/debug %))
(def ^:const throw-exception-on-unify-fail false)

(def ^:const shufflefn
  (fn [x]
    ;; deterministic generation:
;;    x
    ;; nondeterministic generation
    (lazy-seq (shuffle x))

    ))

;; whether to remove [:head] and [:comp] paths from generated trees after generation:
;; for performance.
(def ^:const truncate false)

(declare add-comp-to-bolts)
(declare add-comps-to-bolt)
(declare add-to-bolt-at-path)
(declare candidate-parents)
(declare get-bolts-for)
(declare get-lexemes)
(declare lightning-bolts)
(declare comp-paths)
(declare gen)
(declare show-spec)

(defn generate
  "Return one expression matching spec _spec_ given the model _model_."
  [spec language-model]
  (log/debug (str "(generate) with model named: " (:name language-model)))
  (first (gen spec language-model 0)))

(defn gen
  "Return a lazy sequence of every possible tree given a specification and a model."
  [spec model depth & [from-bolts at-path]]
  (log/debug (str "gen@" depth "; spec=" (show-spec spec)))
  (if (< depth max-depth)
    (let [bolts (or from-bolts
                    (get-bolts-for model spec
                                   depth))]
      (if (not (empty? bolts))
        (lazy-cat
         (let [bolt (first bolts)]
           (or
            (and (= false (get-in bolt [:phrasal] true))
                 ;; This is not a bolt but rather simply a lexical head,
                 ;; so just return a list with this lexical head:
                 [bolt])
            ;; ..otherwise it's a phrase, so return the lazy
            ;; sequence of adding all possible complements at every possible
            ;; position at the bolt.
            (add-comps-to-bolt bolt model
                               (comp-paths depth))))
         (gen spec model depth
               (rest bolts)
               at-path))
        (if (not (= false (get-in spec [:phrasal] true)))
          (gen spec model (+ 1 depth) nil at-path))))))

(defn get-bolts-for [model spec depth]
  (let [result
        ;; TODO: this is an example of obtaining pre-computed bolts
        ;; from a model given a spec and a depth.
        ;; This is a contrived example - should be
        ;; for the model to provide these given a spec and a depth.
        (and (= () (get-in spec [:synsem :subcat]))
             (= :verb (get-in spec [:synsem :cat]))
             (= :present (get-in spec [:synsem :sem :tense]))
             (= true (get-in spec [:synsem :sem :reflexive]))
             (= :perfect (get-in spec [:synsem :sem :aspect]))
             (not (nil? (:reflexive-bolts model))))]
    (cond
      (and (= depth 3) (= result true))
      (shufflefn (->> (:reflexive-bolts model)
                      (map #(unify spec %))
                      (filter #(not (= :fail %)))))
      (= result true) []
      true (lightning-bolts model spec 0 depth))))

(defn lightning-bolts
  [model spec depth max-depth & [use-candidate-parents]]
  ;; Generate 'lightning bolts':
  ;;
  ;;
  ;;   H        H    H
  ;;    \      /      \
  ;;     H    H        H        ...
  ;;    /      \        \
  ;;   H        ..       ..
  ;;    \
  ;;     ..
  ;;
  ;; Each bolt is a tree with only one child per parent: the head child.
  ;; Each head child may be a leaf or
  ;; otherwise has a child with the same two options (leaf or a head child),
  ;; up to the maximum depth.
  (if (and (< depth max-depth)
           (not (= false (get-in spec [:phrasal] true))))
    (let [candidate-parents (or use-candidate-parents
                                (->>
                                 (candidate-parents (:grammar model) spec depth)
                                 (map #(unify % spec))
                                 (filter #(not (= :fail %)))
                                 (shufflefn)))]
      (if (not (empty? candidate-parents))
        (let [candidate-parent (first candidate-parents)]
          (lazy-cat
           (->> (lightning-bolts model
                                 (get-in candidate-parent [:head])
                                 (+ 1 depth)
                                 max-depth)
                (map (fn [head]
                       (assoc-in candidate-parent [:head] head))))
           (lightning-bolts model spec depth max-depth (rest candidate-parents))))))
    (shufflefn (get-lexemes model spec))))

(defn add-comps-to-bolt
  "bolt + paths => trees"
  [bolt model comp-paths]
  ;;  (log/debug (str "add-comps-to-bolt: " ((:morph-ps model) bolt) " with this many paths: " (count comp-paths)))
  (if (not (empty? comp-paths))
    (add-comp-to-bolts
     (add-comps-to-bolt bolt model (rest comp-paths))
     (first comp-paths)
     model)
    [bolt]))

(defn add-comp-to-bolts
  "bolts + path => partial trees"
  [bolts path model]
  (if (not (empty? bolts))
    (do
      (log/trace (str "add-comp-to-bolts: path=" (vec path) "; first bolt=" ((:morph-ps model) (first bolts))))
      (lazy-cat
       (let [result
             (add-to-bolt-at-path (first bolts) path model)]
         result)
       (add-comp-to-bolts (rest bolts) path model)))))

(defn comp-paths
  "Find all paths to all complements (both terminal and non-terminal) given a depth. Returned in
   ascending length (shortest first)."
  ;; e.g., a tree of depth 2
  ;; will have the following paths:
  ;;   [:comp] [:head :comp]
  ;;   because it looks like:
  ;;
  ;;   H
  ;;  /=\
  ;; C   H
  ;;    /=\
  ;;   H   C
  ;;
  [depth]
  (cond
    (= depth 0)
    []
    (= depth 1)
    (list [:comp])
    true
    (cons
     (concat (take (- depth 1)
                   (repeatedly (fn [] :head)))
             [:comp])
     (comp-paths (- depth 1)))))

(defn add-to-bolt-at-path
  "bolt + path => partial trees"
  [bolt path model]
  (let [complements (gen (get-in bolt path) model 0 nil path)]
    (if (empty? complements)
      (log/warn (str "(improve grammar): no complements found for: "
                     ((:morph-ps model) bolt)
                     "; spec=" (show-spec
                                (get-in bolt path))))
      (->>
       ;; set of all complements at _path_ for _bolt_:
       complements

       ;; add each member _each_comp_ of this set to _bolt_:
       (map (fn [each-comp]
              (let [result
                    (dag_unify.core/assoc-in bolt path each-comp)]
                (->
                 result
                 ((fn [tree]
                    (if (:default-fn model)
                      ((:default-fn model) tree)
                      tree)))))))))))

(defn candidate-parents
  "find subset of _rules_ for which each member unifies successfully with _spec_; _depth_ is only used for diagnostic logging."
  [rules spec depth]
  (filter #(not (= :fail %))
          (mapfn (fn [rule]
                   (log/trace (str "candidate-parents: testing rule: " (:rule rule) "; depth: " depth))
                   (let [unified (unify spec rule)]
                     (if (= :fail unified)
                       (log/trace (str "candidate parent: " (:rule rule) " failed at:" (fail-path spec rule)))
                       (log/debug (str "candidate parent: " (:rule rule) " spec:" (show-spec spec)
                                       "; depth: " depth)))
                     unified))
                 rules)))

(defn get-lexemes [model spec]
  "Get lexemes matching the spec. Use a model's index if available, where the index is a function that we call with _spec_ to get a set of indices. otherwise use the model's entire lexeme."
  (->>

   (if (= false (get-in spec [:phrasal] false))
     (if-let [index-fn (:index-fn model)]
       (index-fn spec)
       (do
         (log/warn (str "get-lexemes: no index found: using entire lexicon."))
         (flatten (vals
                   (or (:lexicon (:generate model)) (:lexicon model)))))))
   (filter #(or (= false (get-in % [:exception] false))
                (not (= :verb (get-in % [:synsem :cat])))))
   (map #(unify % spec))
   (filter #(not (= :fail %)))))

(defn show-spec [spec]
  (str "cat=" (get-in spec [:synsem :cat])
       (if (get-in spec [:rule])
         (str "; rule=" (strip-refs (get-in spec [:rule]))))
       (if (not (= (get-in spec [:synsem :agr] ::none) ::none))
         (str "; agr=" (strip-refs (get-in spec [:synsem :agr]))))
       (if (get-in spec [:synsem :subcat :1 :cat])
         (str "; subcat1=" (strip-refs (get-in spec [:synsem :subcat :1 :cat]))))
       (if (get-in spec [:synsem :subcat :2 :cat])
         (str "; subcat2=" (strip-refs (get-in spec [:synsem :subcat :2 :cat]))))
       (if (get-in spec [:synsem :subcat :3 :cat])
         (str "; subcat3=" (strip-refs (get-in spec [:synsem :subcat :3 :cat]))))
       (if (not (= (get-in spec [:phrasal] ::none) ::none))
         (str "; phrasal=" (strip-refs (get-in spec [:phrasal]))))))

move :phrasal=true check earlier for efficiency


(ns babel.italiano
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.generate :as generate]
   [babel.italiano.grammar :as grammar]
   [babel.italiano.lexicon :as lex]
   [babel.italiano.morphology :as morph :refer [fo]]
   [babel.generate :as generate]
   [babel.over :as over]
   [babel.parse :as parse]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.repl :refer [doc]]
   [clojure.string :as string]
   [dag_unify.core :refer [fail-path-between get-in strip-refs unifyc]]))

(def medium
  (grammar/medium))

(defonce np-grammar-model (promise))
(defn np-grammar []
  (if (realized? np-grammar-model)
    @np-grammar-model
    @(deliver np-grammar-model (grammar/np-grammar))))

;; can't decide between 'morph' or 'fo' or something other better name.
(defn morph [expr & {:keys [from-language show-notes]
                     :or {from-language nil
                          show-notes true}}]
  ;; modeled after babel.english/morph:
  ;; most arguments are simply discarded for italian.
  (fo expr))

(defn morph-ps [expr & {:keys [from-language show-notes]
                     :or {from-language nil
                          show-notes true}}]
  ;; modeled after babel.english/morph:
  ;; most arguments are simply discarded for italian.
  (parse/fo-ps expr))

(defn fo-ps [expr]
  (parse/fo-ps expr fo))

(defn analyze
  "analyze a word: as opposed to parsing which is multi-word."
  ;; TODO: should take a language model, not a lexicon
  ([surface-form]
   (analyze surface-form (:lexicon medium)))
  ([surface-form lexicon]
   (morph/analyze surface-form lexicon)))

(defn generate
  ([]
   (let [max-total-depth generate/max-depth
         truncate-children true
         model medium]
     (generate {:modified false}
               :max-total-depth max-total-depth
               :truncate-children true
               :model model)))
  ([spec & {:keys [model do-enrich max-total-depth truncate]
            :or {do-enrich true
                 max-total-depth generate/max-depth
                 model medium
                 truncate true}}]
   (log/debug (str "generating with spec: " (strip-refs spec) " with max-total-depth: " max-total-depth))
   (let [result (generate/generate spec model)]
     (if result
       (conj {:surface (fo result)}
             result)))))

(defonce tokenizer #"[ '\n,’».]")

(defn tokenize [input]
  (string/split input tokenizer))

(defn analyze-tokens
  "given a string, generate a list of tokenization hypotheses."
  [string]
  (map #(string/split % tokenizer)
       (morph/replace-over [string])))

(defn over
  "given a parent and 2 children, try to arrange them with the first child on the left and the second child on the right."
  [parent child1 child2]
  (over/over parent child1 child2))

(defn preprocess [input]
  "arbitrary regexp replacements to convert Italian orthography into a parsable whitespace-delimited expression"
  (let [processed
        (string/join
         " "
         (map string/lower-case
              (->
               input
               (string/replace #","   "")
               (string/replace #"\."   "")
               (string/replace #"\s+" " ")
               (string/split #" "))))]
    (log/debug (str "preprocess: " input " -> " processed))
    processed))

(defn parse
  "parse a string in Italian into zero or more (hopefully more) phrase structure trees"

  ([input]
   (let [input (preprocess input)]
     (parse input medium)))

  ([input model]
   (let [model (if (future? model) @model model)
         input (preprocess input)]
     (cond (string? input)
           (map (fn [tokenization]
                  {:tokens tokenization
                   :input input
                   :parses (parse tokenization model input)})
                (analyze-tokens (string/trim input)))

           (or (seq? input) (vector? input))
           (parse/parse input model)

           true
           (str "don't know how to parse input: " (type input)))))

  ([input model original-input]
   (let [input (if (string? input)
                 (preprocess input)
                 input)]
     (cond (string? input)
           (map (fn [tokenization]
                  {:tokens tokenization
                   :parses (parse tokenization model input)})
                (analyze-tokens (string/trim input)))

           (or (seq? input) (vector? input))
           (parse/parse input model :original-input original-input)

           true
           (str "don't know how to parse input: " (type input))))))

(ns babel.italiano
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.generate :as generate]
   [babel.italiano.grammar :as grammar]
   [babel.italiano.lexicon :as lex]
   [babel.italiano.morphology :as morph :refer [fo]]
   [babel.generate :as generate]
   [babel.over :as over]
   [babel.parse :as parse]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.repl :refer [doc]]
   [clojure.string :as string]
   [dag_unify.core :refer [fail-path-between get-in strip-refs unifyc]]))

(defonce medium-model (promise))
(defn medium []
  (if (realized? medium-model)
    @medium-model
    @(deliver medium-model (grammar/medium))))

(defonce np-grammar-model (promise))
(defn np-grammar []
  (if (realized? np-grammar-model)
    @np-grammar-model
    @(deliver np-grammar-model (grammar/np-grammar))))

;; can't decide between 'morph' or 'fo' or something other better name.
(defn morph [expr & {:keys [from-language show-notes]
                     :or {from-language nil
                          show-notes true}}]
  ;; modeled after babel.english/morph:
  ;; most arguments are simply discarded for italian.
  (fo expr))

(defn morph-ps [expr & {:keys [from-language show-notes]
                     :or {from-language nil
                          show-notes true}}]
  ;; modeled after babel.english/morph:
  ;; most arguments are simply discarded for italian.
  (parse/fo-ps expr))

(defn fo-ps [expr]
  (parse/fo-ps expr fo))

(defn analyze
  "analyze a word: as opposed to parsing which is multi-word."
  ;; TODO: should take a language model, not a lexicon
  ([surface-form]
   (analyze surface-form (:lexicon (medium))))
  ([surface-form lexicon]
   (morph/analyze surface-form lexicon)))

(defn generate
  ([]
   (let [max-total-depth generate/max-depth
         truncate-children true
         model (medium)]
     (generate {:modified false}
               :max-total-depth max-total-depth
               :truncate-children true
               :model model)))
  ([spec & {:keys [model do-enrich max-total-depth truncate]
            :or {do-enrich true
                 max-total-depth generate/max-depth
                 model (medium)
                 truncate true}}]
   (log/debug (str "generating with spec: " (strip-refs spec) " with max-total-depth: " max-total-depth))
   (let [result (generate/generate spec model)]
     (if result
       (conj {:surface (fo result)}
             result)))))

(defonce tokenizer #"[ '\n,’».]")

(defn tokenize [input]
  (string/split input tokenizer))

(defn analyze-tokens
  "given a string, generate a list of tokenization hypotheses."
  [string]
  (map #(string/split % tokenizer)
       (morph/replace-over [string])))

(defn over
  "given a parent and 2 children, try to arrange them with the first child on the left and the second child on the right."
  [parent child1 child2]
  (over/over parent child1 child2))

(defn preprocess [input]
  "arbitrary regexp replacements to convert Italian orthography into a parsable whitespace-delimited expression"
  (let [processed
        (string/join
         " "
         (map string/lower-case
              (->
               input
               (string/replace #","   "")
               (string/replace #"\."   "")
               (string/replace #"\s+" " ")
               (string/split #" "))))]
    (log/debug (str "preprocess: " input " -> " processed))
    processed))

(defn parse
  "parse a string in Italian into zero or more (hopefully more) phrase structure trees"

  ([input]
   (let [input (preprocess input)]
     (parse input (medium))))

  ([input model]
   (let [model (if (future? model) @model model)
         input (preprocess input)]
     (cond (string? input)
           (map (fn [tokenization]
                  {:tokens tokenization
                   :input input
                   :parses (parse tokenization model input)})
                (analyze-tokens (string/trim input)))

           (or (seq? input) (vector? input))
           (parse/parse input model)

           true
           (str "don't know how to parse input: " (type input)))))

  ([input model original-input]
   (let [input (if (string? input)
                 (preprocess input)
                 input)]
     (cond (string? input)
           (map (fn [tokenization]
                  {:tokens tokenization
                   :parses (parse tokenization model input)})
                (analyze-tokens (string/trim input)))

           (or (seq? input) (vector? input))
           (parse/parse input model :original-input original-input)

           true
           (str "don't know how to parse input: " (type input))))))

use a promise for babel.italiano/medium

use a promise for babel.italiano/medium


(ns advent.4.core
  (:require [clojure.string :as s]
            [clojure.java.io :as io]))

(defn room-name [room]
  (subs 0 (- (count room) 11)))

(defn sector-id [room]
  (let [length (count room)]
    (subs room (- length 10) (- length 7))))

(defn checksum [room]
  (let [length (count room)]
    (subs room (- length 6) (- length 1))))

(defn calc-checksum [room-name]
  (->> (s/replace room-name "-" "")
       (frequencies)
       (sort-by val)
       (reverse)
       (partition-by val)
       (map #(map first %))
       (map sort)
       (flatten)
       (take 5)
       (s/join)))

(defn sector-value [room]
  (if (= (checksum room) (calc-checksum (room-name room)))
    (Integer. (sector-id room))
    0))

(defn rooms [path]
  (line-seq (io/reader path)))

(reduce + (map sector-value (rooms "././files/day4_input.txt")))

(ns adventofcode.days.day4
  (:require [clojure.string :as s]
            [clojure.java.io :as io]))

(defn room-name [room]
  (subs 0 (- (count room) 11)))

(defn sector-id [room]
  (let [length (count room)]
    (subs room (- length 10) (- length 7))))

(defn checksum [room]
  (let [length (count room)]
    (subs room (- length 6) (- length 1))))

(defn calc-checksum [room-name]
  (->> (s/replace room-name "-" "")
       (frequencies)
       (sort-by val)
       (reverse)
       (partition-by val)
       (map #(map first %))
       (map sort)
       (flatten)
       (take 5)
       (s/join)))

(defn sector-value [room]
  (if (= (checksum room) (calc-checksum (room-name room)))
    (Integer. (sector-id room))
    0))

(defn rooms [path]
  (line-seq (io/reader path)))

(reduce + (map sector-value (rooms "././files/day4_input.txt")))

fix namespace

fix namespace


(ns bencode.decoder
  (:use [bencode.error]))

(defn- digit?
  "Returns whether ch is a digit, e.g., value between 0 and 9."
  [ch]
  (let [i (int ch)]
    (and (>= i 48) (<= i 57))))

(defmulti bdecode-type
  "Dispatches to the proper decoder method according to the first element
of seq."
  (fn [seq _]
    (let [f (first seq)]
      (cond
       (= f \i)   ::int
       (= f \l)   ::seq
       (= f \d)   ::dict
       (digit? f) ::str
       :else      ::unknown))))

(defn- read-digits
  "Reads from seq until a non-digit char is found, and returns an array
with the number's digits at index 0 and the remaining of seq at index 1."
  [seq]
  (loop [data [] rem seq]
    (let [f (first rem)]
      (if (digit? f)
        (recur (conj data f) (rest rem))
        [(apply str data) rem]))))

(defn- invalid-number?
  "Returns whether digits reprents an invalid number according to the spec."
  [digits]
  (or (empty? digits)
      (and (> (count digits) 1) (= \0 (first digits)))))

(defn- bdecode-dict-entry
  "Bdecodes a dictionary entry from sequence seq, where the key and its
corresponding value are concatenated."
  [seq opts]
  (let [[key rem] (bdecode-type seq opts)
        [val rem] (bdecode-type rem opts)]
    [key val rem]))

(defn- dict-key
  "Returns the final dictionary key according to the options defined in
opts."
  [key opts]
  (if (:str-keys? opts)
    key
    (keyword key)))

(defmethod bdecode-type ::unknown [seq opts]
  (error "Unexpected token"))

(defmethod bdecode-type ::str [seq opts]
  (let [[size seq] (read-digits seq)
        len (read-string size)
        text (apply str (take len (rest seq)))]
    (if (> len (count text))
      (error "Unexpected end of string")
      [text (drop (inc len) seq)])))

(defmethod bdecode-type ::int [seq opts]
  (let [number-seq (rest seq)
        sign (#{\- \+} (first number-seq))]
    (if (and (= \- sign) (= \0 (second number-seq)))
      (error "Invalid number expression")
      (let [[digits rem] (read-digits (if sign (rest number-seq) number-seq))]
        (if (or (invalid-number? digits) (not (= \e (first rem))))
          (error "Invalid number expression")
          [(read-string (str sign digits)) (rest rem)])))))

(defmethod bdecode-type ::seq [seq opts]
  (loop [data [] rem (rest seq)]
    (if (= \e (first rem))
      [data (rest rem)]
      (let [[item rem] (bdecode-type rem opts)]
        (recur (conj data item) rem)))))

(defmethod bdecode-type ::dict [seq opts]
  (loop [data (sorted-map) rem (rest seq)]
    (if (= \e (first rem))
      [data (rest rem)]
      (let [[key val rem] (bdecode-dict-entry rem opts)]
        (if (string? key)
          (recur (assoc data (dict-key key opts) val) rem)
          (error "Only strings should be used as dictionary keys"))))))

(defn bdecode
  "Bdecodes the given string."
  [s opts]
  (let [[data rem] (bdecode-type s opts)]
    (if (empty? rem)
      data
      (error "Unexpected trailing data"))))

(ns bencode.decoder
  (:require [clojure [edn :as edn]])
  (:use [bencode.error]))

(defn- digit?
  "Returns whether ch is a digit, e.g., value between 0 and 9."
  [ch]
  (let [i (int ch)]
    (and (>= i 48) (<= i 57))))

(defmulti bdecode-type
  "Dispatches to the proper decoder method according to the first element
of seq."
  (fn [seq _]
    (let [f (first seq)]
      (cond
       (= f \i)   ::int
       (= f \l)   ::seq
       (= f \d)   ::dict
       (digit? f) ::str
       :else      ::unknown))))

(defn- read-digits
  "Reads from seq until a non-digit char is found, and returns an array
with the number's digits at index 0 and the remaining of seq at index 1."
  [seq]
  (loop [data [] rem seq]
    (let [f (first rem)]
      (if (digit? f)
        (recur (conj data f) (rest rem))
        [(apply str data) rem]))))

(defn- invalid-number?
  "Returns whether digits reprents an invalid number according to the spec."
  [digits]
  (or (empty? digits)
      (and (> (count digits) 1) (= \0 (first digits)))))

(defn- bdecode-dict-entry
  "Bdecodes a dictionary entry from sequence seq, where the key and its
corresponding value are concatenated."
  [seq opts]
  (let [[key rem] (bdecode-type seq opts)
        [val rem] (bdecode-type rem opts)]
    [key val rem]))

(defn- dict-key
  "Returns the final dictionary key according to the options defined in
opts."
  [key opts]
  (if (:str-keys? opts)
    key
    (keyword key)))

(defmethod bdecode-type ::unknown [seq opts]
  (error "Unexpected token"))

(defmethod bdecode-type ::str [seq opts]
  (let [[size seq] (read-digits seq)
        len (edn/read-string size)
        text (apply str (take len (rest seq)))]
    (if (> len (count text))
      (error "Unexpected end of string")
      [text (drop (inc len) seq)])))

(defmethod bdecode-type ::int [seq opts]
  (let [number-seq (rest seq)
        sign (#{\- \+} (first number-seq))]
    (if (and (= \- sign) (= \0 (second number-seq)))
      (error "Invalid number expression")
      (let [[digits rem] (read-digits (if sign (rest number-seq) number-seq))]
        (if (or (invalid-number? digits) (not (= \e (first rem))))
          (error "Invalid number expression")
          [(edn/read-string (str sign digits)) (rest rem)])))))

(defmethod bdecode-type ::seq [seq opts]
  (loop [data [] rem (rest seq)]
    (if (= \e (first rem))
      [data (rest rem)]
      (let [[item rem] (bdecode-type rem opts)]
        (recur (conj data item) rem)))))

(defmethod bdecode-type ::dict [seq opts]
  (loop [data (sorted-map) rem (rest seq)]
    (if (= \e (first rem))
      [data (rest rem)]
      (let [[key val rem] (bdecode-dict-entry rem opts)]
        (if (string? key)
          (recur (assoc data (dict-key key opts) val) rem)
          (error "Only strings should be used as dictionary keys"))))))

(defn bdecode
  "Bdecodes the given string."
  [s opts]
  (let [[data rem] (bdecode-type s opts)]
    (if (empty? rem)
      data
      (error "Unexpected trailing data"))))

Use clojure.edn/read-string instead of clojure.core/read-string for security reasons.


(ns leiningen.new.lein-quick-om
  (:require [leiningen.new.templates :refer [renderer name-to-path ->files]]
            [leiningen.core.main :as main]))

(def render (renderer "lein-quick-om"))

(defn lein-quick-om
  "FIXME: write documentation"
  [name]
  (let [data {:name name
              :sanitized (name-to-path name)}]
    (main/info "Generating fresh 'lein new' lein-quick-om project.")
    (->files data
             ["src/{{sanitized}}/core.cljs" (render "core.cljs" data)]
             ["src/{{sanitized}}/devbar.cljs" (render "devbar.cljs" data)]
             ["src/{{sanitized}}/state_viewer.cljs" (render "state_viewer.cljs" data)]
             ["src/{{sanitized}}/ui.cljs" (render "ui.cljs" data)]
             ["src/{{sanitized}}/example_components.cljs" (render "example_components.cljs" data)]
             ["project.clj" (render "project.clj" data)]
             ["Dockerfile" (render "Dockerfile" data)]
             ["Makefile" (render "Makefile" data)]
             [".dockerignore" (render ".dockerignore" data)]
             ["resources/public/index.html" (render "index.html" data)]
             ["resources/public/css/style.css" (render "style.css" data)]
             )))

(ns leiningen.new.lein-quick-om
  (:require [leiningen.new.templates :refer [renderer name-to-path ->files]]
            [leiningen.core.main :as main]))

(def render (renderer "lein-quick-om"))

(defn lein-quick-om
  "FIXME: write documentation"
  [name]
  (let [data {:name name
              :sanitized (name-to-path name)}]
    (main/info "Generating fresh 'lein new' lein-quick-om project.")
    (->files data
             ["src/{{sanitized}}/main.cljs" (render "main.cljs" data)]
             ["src/{{sanitized}}/devbar.cljs" (render "devbar.cljs" data)]
             ["src/{{sanitized}}/state_viewer.cljs" (render "state_viewer.cljs" data)]
             ["src/{{sanitized}}/ui.cljs" (render "ui.cljs" data)]
             ["src/{{sanitized}}/example_components.cljs" (render "example_components.cljs" data)]
             ["project.clj" (render "project.clj" data)]
             ["Dockerfile" (render "Dockerfile" data)]
             ["Makefile" (render "Makefile" data)]
             [".dockerignore" (render ".dockerignore" data)]
             ["resources/public/index.html" (render "index.html" data)]
             ["resources/public/css/style.css" (render "style.css" data)]
             )))

Rename core to main in template code

Rename core to main in template code


(ns vip.data-processor.db.tree-statistics
  (:require [clojure.string :as str]
            [clojure.tools.logging :as log]
            [korma.core :as korma]
            [vip.data-processor.util :as util]
            [vip.data-processor.db.postgres :as postgres]
            [vip.data-processor.db.translations.util :as t-util]))

(defn reported-elements []
  (->> postgres/v5-statistics
       postgres/column-names
       (filter #(str/ends-with? % "_count"))
       (map #(str/replace % #"_count" ""))
       (map t-util/column->xml-elment)))

(defn error-query []
  (let [element-paths (str/join "|" (reported-elements))]
    (str
     "WITH errors AS (SELECT element_type(errors.path) AS element_type,
                         COUNT(errors.severity) AS error_count
                  FROM results r
                  LEFT JOIN xml_tree_validations errors ON r.id = errors.results_id
                  WHERE r.id = ?
                    AND errors.path IS NOT NULL
                  GROUP BY element_type),
       values AS (SELECT element_type(values.path) AS element_type,
                         COUNT(DISTINCT countable_path(values.path)) as value_count
                  FROM results r
                  LEFT JOIN xml_tree_values values ON r.id = values.results_id
                  WHERE r.id = ?
                    AND values.path ~ 'VipObject.0." element-paths ".*'
                    AND values.path IS NOT NULL
                  GROUP BY element_type)
  SELECT coalesce(errors.element_type, values.element_type) AS element,
         coalesce(errors.error_count, 0) as error_count,
         coalesce(values.value_count, 0) as count
  FROM values
  FULL OUTER JOIN errors ON errors.element_type = values.element_type
  WHERE values.element_type IS NOT NULL;")))

(def camel-case-splitter #"(?<!(^|[A-Z]))(?=[A-Z])|(?<!^)(?=[A-Z][a-z])")

(defn camel->snake [s]
  (->> (str/split s camel-case-splitter)
       (str/join "_")
       (str/lower-case)))

(defn complete [row-count error-count]
  (cond
    (> error-count row-count) 0
    (= row-count 0) 100
    :else (-> (/ (- row-count error-count)
                 row-count)
              (* 100)
              float
              Math/round)))

(defn stats-map
  [{:keys [element error_count count]}]
  (let [completion (complete count error_count)]
    {(keyword (str (camel->snake element) "_count")) count
     (keyword (str (camel->snake element) "_errors")) error_count
     (keyword (str (camel->snake element) "_completion")) completion}))

(defn stats
  [{:keys [import-id]}]
  (->> (korma/exec-raw [(error-query) [import-id import-id]] :results)
       (map stats-map)
       (reduce merge)))

(defn store-tree-stats
  [{:keys [import-id] :as ctx}]
  (log/info "Building basic feed stats")
  (korma/insert postgres/v5-statistics
    (korma/values
     (assoc (stats ctx) :results_id import-id)))
  (log/info "Building locality stats")
  (korma/exec-raw
   ["select * from v5_dashboard.feed_localities(?)" [import-id]])
  ctx)

(ns vip.data-processor.db.tree-statistics
  (:require [clojure.string :as str]
            [clojure.tools.logging :as log]
            [korma.core :as korma]
            [vip.data-processor.util :as util]
            [vip.data-processor.db.postgres :as postgres]
            [vip.data-processor.db.translations.util :as t-util]))

(defn reported-elements []
  (->> postgres/v5-statistics
       postgres/column-names
       (filter #(str/ends-with? % "_count"))
       (map #(str/replace % #"_count" ""))
       (map t-util/column->xml-elment)))

(defn error-query []
  (let [element-paths (str/join "|" (reported-elements))]
    (str
     "WITH errors AS (SELECT element_type(errors.path) AS element_type,
                         COUNT(errors.severity) AS error_count
                  FROM results r
                  LEFT JOIN xml_tree_validations errors ON r.id = errors.results_id
                  WHERE r.id = ?
                    AND errors.path IS NOT NULL
                  GROUP BY element_type),
       values AS (SELECT element_type(values.path) AS element_type,
                         COUNT(DISTINCT countable_path(values.path)) as value_count
                  FROM results r
                  LEFT JOIN xml_tree_values values ON r.id = values.results_id
                  WHERE r.id = ?
                    AND values.path ~ 'VipObject.0." element-paths ".*'
                    AND values.path IS NOT NULL
                  GROUP BY element_type)
  SELECT coalesce(errors.element_type, values.element_type) AS element,
         coalesce(errors.error_count, 0) as error_count,
         coalesce(values.value_count, 0) as count
  FROM values
  FULL OUTER JOIN errors ON errors.element_type = values.element_type;")))

(def camel-case-splitter #"(?<!(^|[A-Z]))(?=[A-Z])|(?<!^)(?=[A-Z][a-z])")

(defn camel->snake [s]
  (->> (str/split s camel-case-splitter)
       (str/join "_")
       (str/lower-case)))

(defn complete [row-count error-count]
  (cond
    (> error-count row-count) 0
    (= row-count 0) 100
    :else (-> (/ (- row-count error-count)
                 row-count)
              (* 100)
              float
              Math/round)))

(defn stats-map
  [{:keys [element error_count count]}]
  (let [completion (complete count error_count)]
    {(keyword (str (camel->snake element) "_count")) count
     (keyword (str (camel->snake element) "_errors")) error_count
     (keyword (str (camel->snake element) "_completion")) completion}))

(defn stats
  [{:keys [import-id]}]
  (->> (korma/exec-raw [(error-query) [import-id import-id]] :results)
       (map stats-map)
       (reduce merge)))

(defn store-tree-stats
  [{:keys [import-id] :as ctx}]
  (log/info "Building basic feed stats")
  (korma/insert postgres/v5-statistics
    (korma/values
     (assoc (stats ctx) :results_id import-id)))
  (log/info "Building locality stats")
  (korma/exec-raw
   ["select * from v5_dashboard.feed_localities(?)" [import-id]])
  ctx)

remove where clause to fix missing election/source


(ns buildviz.go-api
  (:require [clojure.string :as string]
            [clojure.tools.logging :as log]
            [cheshire.core :as j]
            [clj-http.client :as client]
            [clj-time.core :as t]
            [clj-time.format :as tf]
            [clj-time.coerce :as tc]))

(import com.fasterxml.jackson.core.JsonParseException)

(defn- absolute-url-for [go-url relativeUrl]
  (string/join [go-url relativeUrl]))

(defn- get-json [go-url relative-url-template & url-params]
  (let [relative-url (apply format relative-url-template url-params)
        response (client/get (absolute-url-for go-url relative-url))]
    (j/parse-string (:body response) true)))

(defn- get-plain [go-url relative-url-template & url-params]
  (let [relative-url (apply format relative-url-template url-params)
        response (client/get (absolute-url-for go-url relative-url))]
    (:body response)))

;; /properties/%pipeline/%pipeline_run/%stage/%stage_run/%job

(defn- handle-missing-start-time-when-cancelled [build-start-time build-end-time]
  (if (nil? build-start-time)
    build-end-time
    build-start-time))

(defn- build-times [start-time end-time]
  (if-not (nil? end-time)
    {:start (handle-missing-start-time-when-cancelled start-time end-time)
     :end end-time}
    {}))

(defn- parse-datetime [property-map key]
  (tc/to-long (tf/parse (get property-map key))))

(defn- parse-build-properties [properties]
  (let [lines (string/split properties #"\n")
        keys (string/split (first lines) #",")
        values (string/split (second lines) #",")
        property-map (zipmap keys values)
        result (get property-map "cruise_job_result")]
    (when-not (= "Unknown" result)
      (let [start-time (parse-datetime property-map "cruise_timestamp_04_building")
            end-time (parse-datetime property-map "cruise_timestamp_06_completed")
            actual-stage-run (get property-map "cruise_stage_counter")
            outcome (if (= "Passed" result) "pass" "fail")]
        (assoc (build-times start-time end-time)
               :outcome outcome
               :actual-stage-run actual-stage-run)))))

(defn build-for [go-url
                 {pipeline-name :pipelineName
                  pipeline-run :pipelineRun
                  stage-name :stageName
                  stage-run :stageRun
                  job-name :jobName}]
  (let [build-properties (get-plain go-url
                                    "/properties/%s/%s/%s/%s/%s"
                                    pipeline-name pipeline-run stage-name stage-run job-name)]
    (parse-build-properties build-properties)))

;; /api/stages/%pipeline/%stage/history

(defn- get-stage-instances [go-url pipeline stage-name offset]
  (let [stage-history (get-json go-url "/api/stages/%s/%s/history/%s" pipeline stage-name offset)
        stage-instances (:stages stage-history)]
    (if (empty? stage-instances)
      []
      (let [next-offset (+ offset (count stage-instances))]
        (concat stage-instances
                (lazy-seq (get-stage-instances go-url pipeline stage-name next-offset)))))))

(defn get-stage-history [go-url pipeline stage]
  (get-stage-instances go-url pipeline stage 0))

;; /api/pipelines/%pipelines/instance/%run

(defn- revision->input [{modifications :modifications material :material}]
  (let [{revision :revision} (first modifications)
        source_id (:id material)]
    {:revision revision
     :source_id source_id}))

(defn get-inputs-for-pipeline-run [go-url pipeline-name run]
  (let [pipeline-instance (get-json go-url "/api/pipelines/%s/instance/%s" pipeline-name run)
        revisions (:material_revisions (:build_cause pipeline-instance))]
    (map revision->input revisions)))

;; /api/config/pipeline_groups

(defn- stages-for-pipeline [{pipeline-name :name stages :stages}]
  (->> stages
       (map :name)
       (map #(assoc {}
                    :stage %
                    :pipeline pipeline-name))))

(defn- stages-for-pipeline-group [{group-name :name pipelines :pipelines}]
  (->> pipelines
       (mapcat stages-for-pipeline)
       (map #(assoc % :group group-name))))

(defn get-stages [go-url]
  (let [pipeline-groups (get-json go-url "/api/config/pipeline_groups")]
    (mapcat stages-for-pipeline-group pipeline-groups)))

;; /files/%pipeline/%run/%stage/%run/%job.json

(defn- looks-like-xml? [file-name]
  (.endsWith file-name "xml"))

(defn- filter-xml-files [file-node]
  (if (contains? file-node :files)
    (mapcat filter-xml-files (:files file-node))
    (if (looks-like-xml? (:name file-node))
      (list (:url file-node))
      [])))

(defn- make-file-url-path-only [url]
  ;; Transform to path-only url so basic auth as provided by the user can be used.
  ;; Also works around broken Go domain setup
  (string/replace url
                  #"https?://[^/]+(/.+?)?/files/"
                  "/files/"))

(defn- try-get-artifact-tree [go-url
                              {pipeline-name :pipelineName
                              pipeline-run :pipelineRun
                              stage-name :stageName
                              stage-run :stageRun
                              job-name :jobName}]
  (let [artifacts-url (format "/files/%s/%s/%s/%s/%s.json" pipeline-name pipeline-run stage-name stage-run job-name)]
    (try
      (doall (get-json go-url artifacts-url))
      (catch JsonParseException e
        (log/errorf e "Unable to parse artifact list for %s" artifacts-url))
      (catch Exception e
        (if-let [data (ex-data e)]
          (log/errorf "Unable to get artifact list from %s (status %s): %s"
                      artifacts-url (:status data) (:body data))
          (log/errorf e "Unable to get artifact list from %s" artifacts-url))))))

(defn- xml-artifacts-for-job-run [go-url job-instance]
  (let [file-tree (try-get-artifact-tree go-url job-instance)]
    (map make-file-url-path-only
         (mapcat filter-xml-files file-tree))))

(defn get-junit-xml [go-url job-instance]
  (when-let [xml-file-url (first (xml-artifacts-for-job-run go-url job-instance))]
    (log/info (format "Reading test results from %s" xml-file-url))
    (:body (get-plain go-url xml-file-url))))

(ns buildviz.go-api
  (:require [clojure.string :as string]
            [clojure.tools.logging :as log]
            [cheshire.core :as j]
            [clj-http.client :as client]
            [clj-time.core :as t]
            [clj-time.format :as tf]
            [clj-time.coerce :as tc]))

(import com.fasterxml.jackson.core.JsonParseException)

(defn- absolute-url-for [go-url relativeUrl]
  (string/join [go-url relativeUrl]))

(defn- get-json [go-url relative-url-template & url-params]
  (let [relative-url (apply format relative-url-template url-params)
        response (client/get (absolute-url-for go-url relative-url))]
    (j/parse-string (:body response) true)))

(defn- get-plain [go-url relative-url-template & url-params]
  (let [relative-url (apply format relative-url-template url-params)
        response (client/get (absolute-url-for go-url relative-url))]
    (:body response)))

;; /properties/%pipeline/%pipeline_run/%stage/%stage_run/%job

(defn- handle-missing-start-time-when-cancelled [build-start-time build-end-time]
  (if (nil? build-start-time)
    build-end-time
    build-start-time))

(defn- build-times [start-time end-time]
  (if-not (nil? end-time)
    {:start (handle-missing-start-time-when-cancelled start-time end-time)
     :end end-time}
    {}))

(defn- parse-datetime [property-map key]
  (tc/to-long (tf/parse (get property-map key))))

(defn- parse-build-properties [properties]
  (let [lines (string/split properties #"\n")
        keys (string/split (first lines) #",")
        values (string/split (second lines) #",")
        property-map (zipmap keys values)
        result (get property-map "cruise_job_result")]
    (when-not (= "Unknown" result)
      (let [start-time (parse-datetime property-map "cruise_timestamp_04_building")
            end-time (parse-datetime property-map "cruise_timestamp_06_completed")
            actual-stage-run (get property-map "cruise_stage_counter")
            outcome (if (= "Passed" result) "pass" "fail")]
        (assoc (build-times start-time end-time)
               :outcome outcome
               :actual-stage-run actual-stage-run)))))

(defn build-for [go-url
                 {pipeline-name :pipelineName
                  pipeline-run :pipelineRun
                  stage-name :stageName
                  stage-run :stageRun
                  job-name :jobName}]
  (let [build-properties (get-plain go-url
                                    "/properties/%s/%s/%s/%s/%s"
                                    pipeline-name pipeline-run stage-name stage-run job-name)]
    (parse-build-properties build-properties)))

;; /api/stages/%pipeline/%stage/history

(defn- get-stage-instances [go-url pipeline stage-name offset]
  (let [stage-history (get-json go-url "/api/stages/%s/%s/history/%s" pipeline stage-name offset)
        stage-instances (:stages stage-history)]
    (if (empty? stage-instances)
      []
      (let [next-offset (+ offset (count stage-instances))]
        (concat stage-instances
                (lazy-seq (get-stage-instances go-url pipeline stage-name next-offset)))))))

(defn get-stage-history [go-url pipeline stage]
  (get-stage-instances go-url pipeline stage 0))

;; /api/pipelines/%pipelines/instance/%run

(defn- revision->input [{modifications :modifications material :material}]
  (let [{revision :revision} (first modifications)
        source_id (:id material)]
    {:revision revision
     :source_id source_id}))

(defn get-inputs-for-pipeline-run [go-url pipeline-name run]
  (let [pipeline-instance (get-json go-url "/api/pipelines/%s/instance/%s" pipeline-name run)
        revisions (:material_revisions (:build_cause pipeline-instance))]
    (map revision->input revisions)))

;; /api/config/pipeline_groups

(defn- stages-for-pipeline [{pipeline-name :name stages :stages}]
  (->> stages
       (map :name)
       (map #(assoc {}
                    :stage %
                    :pipeline pipeline-name))))

(defn- stages-for-pipeline-group [{group-name :name pipelines :pipelines}]
  (->> pipelines
       (mapcat stages-for-pipeline)
       (map #(assoc % :group group-name))))

(defn get-stages [go-url]
  (let [pipeline-groups (get-json go-url "/api/config/pipeline_groups")]
    (mapcat stages-for-pipeline-group pipeline-groups)))

;; /files/%pipeline/%run/%stage/%run/%job.json

(defn- looks-like-xml? [file-name]
  (.endsWith file-name "xml"))

(defn- filter-xml-files [file-node]
  (if (contains? file-node :files)
    (mapcat filter-xml-files (:files file-node))
    (if (looks-like-xml? (:name file-node))
      (list (:url file-node))
      [])))

(defn- make-file-url-path-only [url]
  ;; Transform to path-only url so basic auth as provided by the user can be used.
  ;; Also works around broken Go domain setup
  (string/replace url
                  #"https?://[^/]+(/.+?)?/files/"
                  "/files/"))

(defn- try-get-artifact-tree [go-url
                              {pipeline-name :pipelineName
                              pipeline-run :pipelineRun
                              stage-name :stageName
                              stage-run :stageRun
                              job-name :jobName}]
  (let [artifacts-url (format "/files/%s/%s/%s/%s/%s.json" pipeline-name pipeline-run stage-name stage-run job-name)]
    (try
      (doall (get-json go-url artifacts-url))
      (catch JsonParseException e
        (log/errorf e "Unable to parse artifact list for %s" artifacts-url))
      (catch Exception e
        (if-let [data (ex-data e)]
          (log/errorf "Unable to get artifact list from %s (status %s): %s"
                      artifacts-url (:status data) (:body data))
          (log/errorf e "Unable to get artifact list from %s" artifacts-url))))))

(defn- xml-artifacts-for-job-run [go-url job-instance]
  (let [file-tree (try-get-artifact-tree go-url job-instance)]
    (map make-file-url-path-only
         (mapcat filter-xml-files file-tree))))

(defn get-junit-xml [go-url job-instance]
  (when-let [xml-file-url (first (xml-artifacts-for-job-run go-url job-instance))]
    (log/info (format "Reading test results from %s" xml-file-url))
    (get-plain go-url xml-file-url)))

Fix test result retrieval broken in 268bcb79a650


(ns cheshire.custom
  "Methods used for extending JSON generation to different Java classes.
  Has the same public API as core.clj so they can be swapped in and out."
  (:use [cheshire.factory])
  (:require [cheshire.core :as core])
  (:import (java.io BufferedWriter ByteArrayOutputStream StringWriter)
           (java.util Date SimpleTimeZone)
           (java.text SimpleDateFormat)
           (java.sql Timestamp)
           (com.fasterxml.jackson.dataformat.smile SmileFactory)
           (com.fasterxml.jackson.core JsonFactory JsonGenerator
                                       JsonGenerator$Feature
                                       JsonGenerationException JsonParser)))

;; date format rebound for custom encoding
(def ^{:dynamic true :private true} *date-format*)

;; pre-allocated exception for fast-failing core attempt for custom encoding
(def ^{:private true} core-failure (JsonGenerationException.
                                    "Cannot custom JSON encode object"))

(defprotocol JSONable
  (to-json [t jg]))

(defn ^String encode*
  ([obj]
     (encode* obj nil))
  ([obj opt-map]
     (binding [*date-format* (or (:date-format opt-map) default-date-format)]
       (let [sw (StringWriter.)
             generator (.createJsonGenerator
                        ^JsonFactory (or *json-factory* json-factory) sw)]
         (when (:pretty opt-map)
           (.useDefaultPrettyPrinter generator))
         (when (:escape-non-ascii opt-map)
           (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
         (if obj
           (to-json obj generator)
           (.writeNull generator))
         (.flush generator)
         (.toString sw)))))

(defn ^String encode
  ([obj]
     (encode obj nil))
  ([obj opt-map]
     (try
       (core/encode obj (merge opt-map {:ex core-failure}))
       (catch JsonGenerationException _
         (encode* obj opt-map)))))

(defn ^String encode-stream*
  ([obj ^BufferedWriter w]
     (encode-stream* obj w nil))
  ([obj ^BufferedWriter w opt-map]
     (binding [*date-format* (or (:date-format opt-map) default-date-format)]
       (let [generator (.createJsonGenerator
                        ^JsonFactory (or *json-factory* json-factory) w)]
         (when (:pretty opt-map)
           (.useDefaultPrettyPrinter generator))
         (when (:escape-non-ascii opt-map)
           (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
         (to-json obj generator)
         (.flush generator)
         w))))

(defn ^String encode-stream
  ([obj ^BufferedWriter w]
     (encode-stream obj w nil))
  ([obj ^BufferedWriter w opt-map]
     (try
       (core/encode-stream obj w (merge opt-map {:ex core-failure}))
       (catch JsonGenerationException _
         (encode-stream* obj opt-map)))))

(defn encode-smile*
  ([obj]
     (encode-smile* obj nil))
  ([obj opt-map]
     (binding [*date-format* (or (:date-format opt-map) default-date-format)]
       (let [baos (ByteArrayOutputStream.)
             generator (.createJsonGenerator ^SmileFactory
                                             (or *smile-factory* smile-factory)
                                             baos)]
         (to-json obj generator)
         (.flush generator)
         (.toByteArray baos)))))

(defn encode-smile
  ([obj]
     (encode-smile* obj nil))
  ([obj opt-map]
     (try
       (core/encode-smile obj (merge opt-map {:ex core-failure}))
       (catch JsonGenerationException _
         (encode-smile* obj opt-map)))))

;; there are no differences in parsing, but these are here to make
;; this a self-contained namespace if desired
(def parse core/decode)
(def parse-string core/decode)
(def parse-stream core/decode-stream)
(def parse-smile core/decode-smile)
(def parsed-seq core/parsed-seq)
(def decode core/parse-string)
(def decode-stream parse-stream)
(def decode-smile parse-smile)

;; aliases for encoding
(def generate-string encode)
(def generate-string* encode*)
(def generate-stream encode-stream)
(def generate-stream* encode-stream*)
(def generate-smile encode-smile)
(def generate-smile* encode-smile*)

;; Generic encoders, these can be used by someone writing a custom
;; encoder if so desired, after transforming an arbitrary data
;; structure into a clojure one, these can just be called.
(defn encode-nil
  "Encode null to the json generator."
  [_ ^JsonGenerator jg]
  (.writeNull jg))

(defn encode-str
  "Encode a string to the json generator."
  [^String s ^JsonGenerator jg]
  (.writeString jg (str s)))

(defn encode-number
  "Encode anything implementing java.lang.Number to the json generator."
  [^java.lang.Number n ^JsonGenerator jg]
  (.writeNumber jg n))

(defn encode-long
  "Encode anything implementing java.lang.Number to the json generator."
  [^Long n ^JsonGenerator jg]
  (.writeNumber jg (long n)))

(defn encode-int
  "Encode anything implementing java.lang.Number to the json generator."
  [n ^JsonGenerator jg]
  (.writeNumber jg (long n)))

(defn encode-ratio
  "Encode a clojure.lang.Ratio to the json generator."
  [^clojure.lang.Ratio n ^JsonGenerator jg]
  (.writeNumber jg (double n)))

(defn encode-seq
  "Encode a seq to the json generator."
  [s ^JsonGenerator jg]
  (.writeStartArray jg)
  (doseq [i s]
    (to-json i jg))
  (.writeEndArray jg))

(defn encode-date
  "Encode a date object to the json generator."
  [^Date d ^JsonGenerator jg]
  (let [sdf (SimpleDateFormat. *date-format*)]
    (.setTimeZone sdf (SimpleTimeZone. 0 "UTC"))
    (.writeString jg (.format sdf d))))

(defn encode-bool
  "Encode a Boolean object to the json generator."
  [^Boolean b ^JsonGenerator jg]
  (.writeBoolean jg b))

(defn encode-named
  "Encode a keyword to the json generator."
  [^clojure.lang.Keyword k ^JsonGenerator jg]
  (.writeString jg (if-let [ns (namespace k)]
                     (str ns "/" (name k))
                     (name k))))

(defn encode-map
  "Encode a clojure map to the json generator."
  [^clojure.lang.IPersistentMap m ^JsonGenerator jg]
  (.writeStartObject jg)
  (doseq [[k v] m]
    (.writeFieldName jg (if (instance? clojure.lang.Keyword k)
                          (name k)
                          (str k)))
    (to-json v jg))
  (.writeEndObject jg))

(defn encode-symbol
  "Encode a clojure symbol to the json generator."
  [^clojure.lang.Symbol s ^JsonGenerator jg]
  (.writeString jg (str s)))

;; extended implementations for clojure datastructures
(extend nil
  JSONable
  {:to-json encode-nil})

(extend java.lang.String
  JSONable
  {:to-json encode-str})

;; This is lame, thanks for changing all the BigIntegers to BigInts
;; in 1.3 clojure/core :-/
(when (not= {:major 1 :minor 2} (select-keys *clojure-version* [:major :minor]))
  ;; Use Class/forName so it only resolves if it's running on clojure 1.3
  (extend (Class/forName "clojure.lang.BigInt")
    JSONable
    {:to-json (fn encode-bigint
                [^java.lang.Number n ^JsonGenerator jg]
                (.writeNumber jg ^java.math.BigInteger (.toBigInteger n)))}))

(extend clojure.lang.Ratio
  JSONable
  {:to-json encode-ratio})

(extend Long
  JSONable
  {:to-json encode-long})

(extend Short
  JSONable
  {:to-json encode-int})

(extend Byte
  JSONable
  {:to-json encode-int})

(extend java.lang.Number
  JSONable
  {:to-json encode-number})

(extend clojure.lang.ISeq
  JSONable
  {:to-json encode-seq})

(extend clojure.lang.IPersistentVector
  JSONable
  {:to-json encode-seq})

(extend clojure.lang.IPersistentSet
  JSONable
  {:to-json encode-seq})

(extend clojure.lang.IPersistentList
  JSONable
  {:to-json encode-seq})

(extend java.util.Date
  JSONable
  {:to-json encode-date})

(extend java.sql.Timestamp
  JSONable
  {:to-json #(encode-date (Date. (.getTime ^java.sql.Timestamp %1)) %2)})

(extend java.util.UUID
  JSONable
  {:to-json encode-str})

(extend java.lang.Boolean
  JSONable
  {:to-json encode-bool})

(extend clojure.lang.Keyword
  JSONable
  {:to-json encode-named})

(extend clojure.lang.IPersistentMap
  JSONable
  {:to-json encode-map})

(extend clojure.lang.Symbol
  JSONable
  {:to-json encode-symbol})

(extend clojure.lang.Associative
  JSONable
  {:to-json encode-map})
;; Utility methods to add and remove encoders
(defn add-encoder
  "Provide an encoder for a type not handled by Cheshire.

   ex. (add-encoder java.net.URL encode-string)

   See encode-str, encode-map, etc, in the cheshire.custom
   namespace for encoder examples."
  [cls encoder]
  (extend cls
    JSONable
    {:to-json encoder}))

(defn remove-encoder [cls]
  "Remove encoder for a given type.

   ex. (remove-encoder java.net.URL)"
  (alter-var-root #'JSONable #(assoc % :impls (dissoc (:impls %) cls)))
  (clojure.core/-reset-methods JSONable))

(ns cheshire.custom
  "Methods used for extending JSON generation to different Java classes.
  Has the same public API as core.clj so they can be swapped in and out."
  (:use [cheshire.factory])
  (:require [cheshire.core :as core])
  (:import (java.io BufferedWriter ByteArrayOutputStream StringWriter)
           (java.util Date SimpleTimeZone)
           (java.text SimpleDateFormat)
           (java.sql Timestamp)
           (com.fasterxml.jackson.dataformat.smile SmileFactory)
           (com.fasterxml.jackson.core JsonFactory JsonGenerator
                                       JsonGenerator$Feature
                                       JsonGenerationException JsonParser)))

;; date format rebound for custom encoding
(def ^{:dynamic true :private true} *date-format*)

;; pre-allocated exception for fast-failing core attempt for custom encoding
(def ^{:private true} core-failure (JsonGenerationException.
                                    "Cannot custom JSON encode object"))

(defprotocol JSONable
  (to-json [t jg]))

(defn ^String encode*
  ([obj]
     (encode* obj nil))
  ([obj opt-map]
     (binding [*date-format* (or (:date-format opt-map) default-date-format)]
       (let [sw (StringWriter.)
             generator (.createJsonGenerator
                        ^JsonFactory (or *json-factory* json-factory) sw)]
         (when (:pretty opt-map)
           (.useDefaultPrettyPrinter generator))
         (when (:escape-non-ascii opt-map)
           (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
         (if obj
           (to-json obj generator)
           (.writeNull generator))
         (.flush generator)
         (.toString sw)))))

(defn ^String encode
  ([obj]
     (encode obj nil))
  ([obj opt-map]
     (try
       (core/encode obj (merge opt-map {:ex core-failure}))
       (catch JsonGenerationException _
         (encode* obj opt-map)))))

(defn ^String encode-stream*
  ([obj ^BufferedWriter w]
     (encode-stream* obj w nil))
  ([obj ^BufferedWriter w opt-map]
     (binding [*date-format* (or (:date-format opt-map) default-date-format)]
       (let [generator (.createJsonGenerator
                        ^JsonFactory (or *json-factory* json-factory) w)]
         (when (:pretty opt-map)
           (.useDefaultPrettyPrinter generator))
         (when (:escape-non-ascii opt-map)
           (.enable generator JsonGenerator$Feature/ESCAPE_NON_ASCII))
         (to-json obj generator)
         (.flush generator)
         w))))

(defn ^String encode-stream
  ([obj ^BufferedWriter w]
     (encode-stream obj w nil))
  ([obj ^BufferedWriter w opt-map]
     (try
       (core/encode-stream obj w (merge opt-map {:ex core-failure}))
       (catch JsonGenerationException _
         (encode-stream* obj opt-map)))))

(defn encode-smile*
  ([obj]
     (encode-smile* obj nil))
  ([obj opt-map]
     (binding [*date-format* (or (:date-format opt-map) default-date-format)]
       (let [baos (ByteArrayOutputStream.)
             generator (.createJsonGenerator ^SmileFactory
                                             (or *smile-factory* smile-factory)
                                             baos)]
         (to-json obj generator)
         (.flush generator)
         (.toByteArray baos)))))

(defn encode-smile
  ([obj]
     (encode-smile* obj nil))
  ([obj opt-map]
     (try
       (core/encode-smile obj (merge opt-map {:ex core-failure}))
       (catch JsonGenerationException _
         (encode-smile* obj opt-map)))))

;; there are no differences in parsing, but these are here to make
;; this a self-contained namespace if desired
(def parse core/decode)
(def parse-string core/decode)
(def parse-stream core/decode-stream)
(def parse-smile core/decode-smile)
(def parsed-seq core/parsed-seq)
(def decode core/parse-string)
(def decode-stream parse-stream)
(def decode-smile parse-smile)

;; aliases for encoding
(def generate-string encode)
(def generate-string* encode*)
(def generate-stream encode-stream)
(def generate-stream* encode-stream*)
(def generate-smile encode-smile)
(def generate-smile* encode-smile*)

;; Generic encoders, these can be used by someone writing a custom
;; encoder if so desired, after transforming an arbitrary data
;; structure into a clojure one, these can just be called.
(defn encode-nil
  "Encode null to the json generator."
  [_ ^JsonGenerator jg]
  (.writeNull jg))

(defn encode-str
  "Encode a string to the json generator."
  [^String s ^JsonGenerator jg]
  (.writeString jg (str s)))

(defn encode-number
  "Encode anything implementing java.lang.Number to the json generator."
  [^java.lang.Number n ^JsonGenerator jg]
  (.writeNumber jg n))

(defn encode-long
  "Encode anything implementing java.lang.Number to the json generator."
  [^Long n ^JsonGenerator jg]
  (.writeNumber jg (long n)))

(defn encode-int
  "Encode anything implementing java.lang.Number to the json generator."
  [n ^JsonGenerator jg]
  (.writeNumber jg (long n)))

(defn encode-ratio
  "Encode a clojure.lang.Ratio to the json generator."
  [^clojure.lang.Ratio n ^JsonGenerator jg]
  (.writeNumber jg (double n)))

(defn encode-seq
  "Encode a seq to the json generator."
  [s ^JsonGenerator jg]
  (.writeStartArray jg)
  (doseq [i s]
    (to-json i jg))
  (.writeEndArray jg))

(defn encode-date
  "Encode a date object to the json generator."
  [^Date d ^JsonGenerator jg]
  (let [sdf (SimpleDateFormat. *date-format*)]
    (.setTimeZone sdf (SimpleTimeZone. 0 "UTC"))
    (.writeString jg (.format sdf d))))

(defn encode-bool
  "Encode a Boolean object to the json generator."
  [^Boolean b ^JsonGenerator jg]
  (.writeBoolean jg b))

(defn encode-named
  "Encode a keyword to the json generator."
  [^clojure.lang.Keyword k ^JsonGenerator jg]
  (.writeString jg (if-let [ns (namespace k)]
                     (str ns "/" (name k))
                     (name k))))

(defn encode-map
  "Encode a clojure map to the json generator."
  [^clojure.lang.IPersistentMap m ^JsonGenerator jg]
  (.writeStartObject jg)
  (doseq [[k v] m]
    (.writeFieldName jg (if (instance? clojure.lang.Keyword k)
                          (if-let [ns (namespace k)]
                            (str ns "/" (name k))
                            (name k))
                          (str k)))
    (to-json v jg))
  (.writeEndObject jg))

(defn encode-symbol
  "Encode a clojure symbol to the json generator."
  [^clojure.lang.Symbol s ^JsonGenerator jg]
  (.writeString jg (str s)))

;; extended implementations for clojure datastructures
(extend nil
  JSONable
  {:to-json encode-nil})

(extend java.lang.String
  JSONable
  {:to-json encode-str})

;; This is lame, thanks for changing all the BigIntegers to BigInts
;; in 1.3 clojure/core :-/
(when (not= {:major 1 :minor 2} (select-keys *clojure-version* [:major :minor]))
  ;; Use Class/forName so it only resolves if it's running on clojure 1.3
  (extend (Class/forName "clojure.lang.BigInt")
    JSONable
    {:to-json (fn encode-bigint
                [^java.lang.Number n ^JsonGenerator jg]
                (.writeNumber jg ^java.math.BigInteger (.toBigInteger n)))}))

(extend clojure.lang.Ratio
  JSONable
  {:to-json encode-ratio})

(extend Long
  JSONable
  {:to-json encode-long})

(extend Short
  JSONable
  {:to-json encode-int})

(extend Byte
  JSONable
  {:to-json encode-int})

(extend java.lang.Number
  JSONable
  {:to-json encode-number})

(extend clojure.lang.ISeq
  JSONable
  {:to-json encode-seq})

(extend clojure.lang.IPersistentVector
  JSONable
  {:to-json encode-seq})

(extend clojure.lang.IPersistentSet
  JSONable
  {:to-json encode-seq})

(extend clojure.lang.IPersistentList
  JSONable
  {:to-json encode-seq})

(extend java.util.Date
  JSONable
  {:to-json encode-date})

(extend java.sql.Timestamp
  JSONable
  {:to-json #(encode-date (Date. (.getTime ^java.sql.Timestamp %1)) %2)})

(extend java.util.UUID
  JSONable
  {:to-json encode-str})

(extend java.lang.Boolean
  JSONable
  {:to-json encode-bool})

(extend clojure.lang.Keyword
  JSONable
  {:to-json encode-named})

(extend clojure.lang.IPersistentMap
  JSONable
  {:to-json encode-map})

(extend clojure.lang.Symbol
  JSONable
  {:to-json encode-symbol})

(extend clojure.lang.Associative
  JSONable
  {:to-json encode-map})
;; Utility methods to add and remove encoders
(defn add-encoder
  "Provide an encoder for a type not handled by Cheshire.

   ex. (add-encoder java.net.URL encode-string)

   See encode-str, encode-map, etc, in the cheshire.custom
   namespace for encoder examples."
  [cls encoder]
  (extend cls
    JSONable
    {:to-json encoder}))

(defn remove-encoder [cls]
  "Remove encoder for a given type.

   ex. (remove-encoder java.net.URL)"
  (alter-var-root #'JSONable #(assoc % :impls (dissoc (:impls %) cls)))
  (clojure.core/-reset-methods JSONable))

fix namespaced keywords for custom encoding


(ns clojush.globals)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The values of the names defined here tend to remain constant over all runs.
;; Those not starting with "global-" are used in a variety of places and therefore
;; it is easiest to keep them global. The names starting with "global-"
;; are bound to atoms for which values may be set by arguments to pushgp;
;; see the definition of push-argmap in args.clj for more information on these.

(def push-types '(:exec :code :integer :float :boolean :char :string :zip
                  :vector_integer :vector_float :vector_boolean :vector_string
                  :input :output :auxiliary :tag :return :environment :genome))
;; The list of stacks used by the Push interpreter

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used by instructions to keep computed values within limits or when using random
;; instructions.

(def max-number-magnitude 1000000000000)
;; Used by keep-number-reasonable as the maximum size of any integer or float

(def min-number-magnitude 1.0E-10)
;; Used by keep-number-reasonable as the minimum magnitude of any float

(def max-string-length 5000)
;; Used by string instructions to ensure that strings don't get too large

(def max-vector-length 5000)
;; Used by vector instructions to ensure that vectors don't get too large

(def min-random-integer -10)
;; The minumum value created by the integer_rand instruction

(def max-random-integer 10)
;; The maximum value created by the integer_rand instruction

(def min-random-float -1.0)
;; The minumum value created by the float_rand instruction

(def max-random-float 1.0)
;; The maximum value created by the float_rand instruction

(def min-random-string-length 1)
;; The minimum length of string created by the string_rand instruction

(def max-random-string-length 10)
;; The maximum length of string created by the string_rand instruction

(def max-points-in-random-expressions 50)
;; The maximum length of code created by the code_rand instruction

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used in many places and difficult to make fully functional

(def evaluations-count (atom 0))
;; Used to count the number of times GP evaluates an individual

(def point-evaluations-count (atom 0))
;; Used to count the number of instructions that have been executed

(def timer-atom (atom 0))
;; Used for timing of different parts of PushGP

(def timing-map (atom {:initialization 0 :reproduction 0 :report 0 :fitness 0 :other 0}))
;; Used for timing of different parts of pushgp

(def solution-rates (atom (repeat 0)))
;; Used in historically-assessed hardness

(def elitegroups (atom ()))
;; Used for elitegroup lexicase selection (will only work if lexicase-selection is off)

(def epsilons-for-epsilon-lexicase (atom ()))
;; Used in epsilon lexicase. Only calculated once per population

(def selection-counts (atom {}))
;; Used to store the number of selections for each individual, indexed by UUIDs

(def min-age (atom 0))
(def max-age (atom 0))
;; Used for age-mediated-parent-selection

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The globals below may be reset by arguments to pushgp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by Push instructions and therefore must be global

(def global-atom-generators (atom ()))
;; The instructions and literals that may be used in Push programs.

(def global-max-points (atom 100))
;; The maximum size of a Push program. Also, the maximum size of code that can appear on
;; the exec or code stacks.

(def global-tag-limit (atom 10000))
;; The size of the tag space

(def global-epigenetic-markers (atom [:close]))
;; A vector of the epigenetic markers that should be used in the individuals. Implemented
;; options include: :close, :silent

(def global-close-parens-probabilities (atom [0.772 0.206 0.021 0.001]))
;; A vector of the probabilities for the number of parens ending at that position. See
;; random-closes in clojush.random

(def global-silent-instruction-probability (atom 0.2))
;; If :silent is used as an epigenetic-marker, this is the probability of random
;; instructions having :silent be true

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by run-push (and functions it calls), and must be global
;; since run-push is called by the problem-specifc error functions

(def global-top-level-push-code (atom false))
;; When true, run-push will push the program's code onto the code stack prior to running

(def global-top-level-pop-code (atom false))
;; When true, run-push will pop the code stack after running the program

(def global-evalpush-limit (atom 150))
;; The number of Push instructions that can be evaluated before stopping evaluation

(def global-evalpush-time-limit (atom 0))
;; The time in nanoseconds that a program can evaluate before stopping, 0 means no time limit

(def global-pop-when-tagging (atom true))
;; When true, tagging instructions will pop the exec stack when tagging; otherwise, the exec
;; stack is not popped

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by some problem-specific error functions, and must therefore
;; be global

(def global-parent-selection (atom :lexicase))
;; The type of parent selection used

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This atom is used to convey information to clojush.pushgp.visualize, but it cannot be
;; defined there because it must always be available to clojush.pushgp.report, and we don't
;; want to :require clojush.pushgp.visualize there unless :visualize is true, since doing so
;; will require quil.core, which will launch the quil sketch.

(def viz-data-atom (atom {}))

(ns clojush.globals)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The values of the names defined here tend to remain constant over all runs.
;; Those not starting with "global-" are used in a variety of places and therefore
;; it is easiest to keep them global. The names starting with "global-"
;; are bound to atoms for which values may be set by arguments to pushgp;
;; see the definition of push-argmap in args.clj for more information on these.

(def push-types '(:exec :code :integer :float :boolean :char :string :zip
                  :vector_integer :vector_float :vector_boolean :vector_string
                  :input :output :auxiliary :tag :return :environment :genome
                  :gtm))
;; The list of stacks and non-stack storage types used by the Push interpreter

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used by instructions to keep computed values within limits or when using random
;; instructions.

(def max-number-magnitude 1000000000000)
;; Used by keep-number-reasonable as the maximum size of any integer or float

(def min-number-magnitude 1.0E-10)
;; Used by keep-number-reasonable as the minimum magnitude of any float

(def max-string-length 5000)
;; Used by string instructions to ensure that strings don't get too large

(def max-vector-length 5000)
;; Used by vector instructions to ensure that vectors don't get too large

(def min-random-integer -10)
;; The minumum value created by the integer_rand instruction

(def max-random-integer 10)
;; The maximum value created by the integer_rand instruction

(def min-random-float -1.0)
;; The minumum value created by the float_rand instruction

(def max-random-float 1.0)
;; The maximum value created by the float_rand instruction

(def min-random-string-length 1)
;; The minimum length of string created by the string_rand instruction

(def max-random-string-length 10)
;; The maximum length of string created by the string_rand instruction

(def max-points-in-random-expressions 50)
;; The maximum length of code created by the code_rand instruction

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used in many places and difficult to make fully functional

(def evaluations-count (atom 0))
;; Used to count the number of times GP evaluates an individual

(def point-evaluations-count (atom 0))
;; Used to count the number of instructions that have been executed

(def timer-atom (atom 0))
;; Used for timing of different parts of PushGP

(def timing-map (atom {:initialization 0 :reproduction 0 :report 0 :fitness 0 :other 0}))
;; Used for timing of different parts of pushgp

(def solution-rates (atom (repeat 0)))
;; Used in historically-assessed hardness

(def elitegroups (atom ()))
;; Used for elitegroup lexicase selection (will only work if lexicase-selection is off)

(def epsilons-for-epsilon-lexicase (atom ()))
;; Used in epsilon lexicase. Only calculated once per population

(def selection-counts (atom {}))
;; Used to store the number of selections for each individual, indexed by UUIDs

(def min-age (atom 0))
(def max-age (atom 0))
;; Used for age-mediated-parent-selection

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The globals below may be reset by arguments to pushgp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by Push instructions and therefore must be global

(def global-atom-generators (atom ()))
;; The instructions and literals that may be used in Push programs.

(def global-max-points (atom 100))
;; The maximum size of a Push program. Also, the maximum size of code that can appear on
;; the exec or code stacks.

(def global-tag-limit (atom 10000))
;; The size of the tag space

(def global-epigenetic-markers (atom [:close]))
;; A vector of the epigenetic markers that should be used in the individuals. Implemented
;; options include: :close, :silent

(def global-close-parens-probabilities (atom [0.772 0.206 0.021 0.001]))
;; A vector of the probabilities for the number of parens ending at that position. See
;; random-closes in clojush.random

(def global-silent-instruction-probability (atom 0.2))
;; If :silent is used as an epigenetic-marker, this is the probability of random
;; instructions having :silent be true

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by run-push (and functions it calls), and must be global
;; since run-push is called by the problem-specifc error functions

(def global-top-level-push-code (atom false))
;; When true, run-push will push the program's code onto the code stack prior to running

(def global-top-level-pop-code (atom false))
;; When true, run-push will pop the code stack after running the program

(def global-evalpush-limit (atom 150))
;; The number of Push instructions that can be evaluated before stopping evaluation

(def global-evalpush-time-limit (atom 0))
;; The time in nanoseconds that a program can evaluate before stopping, 0 means no time limit

(def global-pop-when-tagging (atom true))
;; When true, tagging instructions will pop the exec stack when tagging; otherwise, the exec
;; stack is not popped

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by some problem-specific error functions, and must therefore
;; be global

(def global-parent-selection (atom :lexicase))
;; The type of parent selection used

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This atom is used to convey information to clojush.pushgp.visualize, but it cannot be
;; defined there because it must always be available to clojush.pushgp.report, and we don't
;; want to :require clojush.pushgp.visualize there unless :visualize is true, since doing so
;; will require quil.core, which will launch the quil sketch.

(def viz-data-atom (atom {}))

Add :gtm to push-types

Add :gtm to push-types


(ns clojush.globals)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   globals
;; The values def'ed here tend to remain constant over all runs. The atoms
;; not starting with "global-" are used in a variety of places and therefore
;; it is easiest to keep them global. The atoms starting with "global-"
;; may change depending on arguments to pushgp.
;;
;; Most of the values and atoms in this file are those that are used by Push
;; instructions; all others, with few exceptions, should be defined in push-argmap
;; in args.clj and should be passed to whatever functions use them as arguments.

;; push-types is the list of stacks used by the Push interpreter
(def push-types '(:exec :code :integer :float :boolean :char :string :zip
                        :vector_integer :vector_float :vector_boolean :vector_string
                        :input :output :auxiliary
                        :tag :return :environment :genome)) ;; Stack types

;; These definitions are used by instructions to keep computed values within limits
;; or when using random instructions.
(def max-number-magnitude 1000000000000) ;; Used by keep-number-reasonable as the maximum size of any integer or float
(def min-number-magnitude 1.0E-10) ;; Used by keep-number-reasonable as the minimum magnitude of any float
(def max-string-length 5000) ;; Used by string instructions to ensure that strings don't get too large
(def max-vector-length 5000) ;; Used by vector instructions to ensure that vectors don't get too large
(def min-random-integer -10) ;; The minumum value created by the integer_rand instruction
(def max-random-integer 10) ;; The maximum value created by the integer_rand instruction
(def min-random-float -1.0) ;; The minumum value created by the float_rand instruction
(def max-random-float 1.0) ;; The maximum value created by the float_rand instruction
(def min-random-string-length 1) ;; The minimum length of string created by the string_rand instruction
(def max-random-string-length 10) ;; The maximum length of string created by the string_rand instruction
(def max-points-in-random-expressions 50) ;; The maximum length of code created by the code_rand instruction

;; These atoms are used in different places and are therefore difficult to make fully functional
(def evaluations-count (atom 0)) ;; Used to count the number of times GP evaluates an individual
(def point-evaluations-count (atom 0)) ;; Used to count the number of instructions that have been executed
(def timer-atom (atom 0)) ;; Used for timing of different parts of PushGP
(def timing-map (atom {:initialization 0 :reproduction 0 :report 0 :fitness 0 :other 0}))  ;; Used for timing of different parts of pushgp
(def solution-rates (atom (repeat 0))) ;; Used in historically-assessed hardness
(def elitegroups (atom ())) ;; Used for elitegroup lexicase selection (will only work if lexicase-selection is off)
(def epsilons-for-epsilon-lexicase (atom ())) ;; Used in epsilon lexicase. Only calculated once per population
(def population-behaviors (atom ())) ;; Used to store the behaviors of the population for use in tracking behavioral diversity
(def selection-counts (atom {})) ;; Used to store the number of selections for each individual, indexed by UUIDs

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The globals below may be reset by arguments to pushgp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; These definitions are used by Push instructions and therefore must be global
(def global-atom-generators (atom ())) ;; The instructions and literals that may be used in Push programs.
(def global-max-points (atom 100)) ;; The maximum size of a Push program. Also, the maximum size of code that can appear on the exec or code stacks.
(def global-tag-limit (atom 10000)) ;; The size of the tag space
(def global-epigenetic-markers (atom [:close])) ;; A vector of the epigenetic markers that should be used in the individuals. Implemented options include: :close, :silent
(def global-close-parens-probabilities (atom [0.772 0.206 0.021 0.001])) ;; A vector of the probabilities for the number of parens ending at that position. See random-closes in clojush.random
(def global-silent-instruction-probability (atom 0.2)) ;; If :silent is used as an epigenetic-marker, this is the probability of random instructions having :silent be true

;; These definitions are used by run-push (and functions it calls), and must be global since run-push is called by the problem-specifc error functions
(def global-top-level-push-code (atom false)) ;; When true, run-push will push the program's code onto the code stack prior to running
(def global-top-level-pop-code (atom false)) ;; When true, run-push will pop the code stack after running the program
(def global-evalpush-limit (atom 150)) ;; The number of Push instructions that can be evaluated before stopping evaluation
(def global-evalpush-time-limit (atom 0)) ;; The time in nanoseconds that a program can evaluate before stopping, 0 means no time limit
(def global-pop-when-tagging (atom true)) ;; When true, tagging instructions will pop the exec stack when tagging; otherwise, the exec stack is not popped

;; These definitions are used by some problem-specific error functions, and must therefore be global
(def global-parent-selection (atom :lexicase)) ;; The type of parent selection used
(def global-print-behavioral-diversity (atom false)) ;; When true, reports will print the behavioral diversity of the population

(ns clojush.globals)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   globals
;; The values def'ed here tend to remain constant over all runs. The atoms
;; not starting with "global-" are used in a variety of places and therefore
;; it is easiest to keep them global. The atoms starting with "global-"
;; may change depending on arguments to pushgp.
;;
;; Most of the values and atoms in this file are those that are used by Push
;; instructions; all others, with few exceptions, should be defined in push-argmap
;; in args.clj and should be passed to whatever functions use them as arguments.

(def push-types '(:exec :code :integer :float :boolean :char :string :zip
                        :vector_integer :vector_float :vector_boolean :vector_string
                        :input :output :auxiliary :tag :return :environment :genome))
;; The list of stacks used by the Push interpreter

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used by instructions to keep computed values within limits or when using random
;; instructions.

(def max-number-magnitude 1000000000000)
;; Used by keep-number-reasonable as the maximum size of any integer or float

(def min-number-magnitude 1.0E-10)
;; Used by keep-number-reasonable as the minimum magnitude of any float

(def max-string-length 5000)
;; Used by string instructions to ensure that strings don't get too large

(def max-vector-length 5000)
;; Used by vector instructions to ensure that vectors don't get too large

(def min-random-integer -10)
;; The minumum value created by the integer_rand instruction

(def max-random-integer 10)
;; The maximum value created by the integer_rand instruction

(def min-random-float -1.0)
;; The minumum value created by the float_rand instruction

(def max-random-float 1.0)
;; The maximum value created by the float_rand instruction

(def min-random-string-length 1)
;; The minimum length of string created by the string_rand instruction

(def max-random-string-length 10)
;; The maximum length of string created by the string_rand instruction

(def max-points-in-random-expressions 50)
;; The maximum length of code created by the code_rand instruction

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used in many places and difficult to make fully functional

(def evaluations-count (atom 0))
;; Used to count the number of times GP evaluates an individual

(def point-evaluations-count (atom 0))
;; Used to count the number of instructions that have been executed

(def timer-atom (atom 0))
;; Used for timing of different parts of PushGP

(def timing-map (atom {:initialization 0 :reproduction 0 :report 0 :fitness 0 :other 0}))
;; Used for timing of different parts of pushgp

(def solution-rates (atom (repeat 0)))
;; Used in historically-assessed hardness

(def elitegroups (atom ()))
;; Used for elitegroup lexicase selection (will only work if lexicase-selection is off)

(def epsilons-for-epsilon-lexicase (atom ()))
;; Used in epsilon lexicase. Only calculated once per population

(def population-behaviors (atom ()))
;; Used to store the behaviors of the population for use in tracking behavioral diversity

(def selection-counts (atom {}))
;; Used to store the number of selections for each individual, indexed by UUIDs

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The globals below may be reset by arguments to pushgp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by Push instructions and therefore must be global

(def global-atom-generators (atom ()))
;; The instructions and literals that may be used in Push programs.

(def global-max-points (atom 100))
;; The maximum size of a Push program. Also, the maximum size of code that can appear on
;; the exec or code stacks.

(def global-tag-limit (atom 10000))
;; The size of the tag space

(def global-epigenetic-markers (atom [:close]))
;; A vector of the epigenetic markers that should be used in the individuals. Implemented
;; options include: :close, :silent

(def global-close-parens-probabilities (atom [0.772 0.206 0.021 0.001]))
;; A vector of the probabilities for the number of parens ending at that position. See
;; random-closes in clojush.random

(def global-silent-instruction-probability (atom 0.2))
;; If :silent is used as an epigenetic-marker, this is the probability of random
;; instructions having :silent be true

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by run-push (and functions it calls), and must be global
;; since run-push is called by the problem-specifc error functions

(def global-top-level-push-code (atom false))
;; When true, run-push will push the program's code onto the code stack prior to running

(def global-top-level-pop-code (atom false))
;; When true, run-push will pop the code stack after running the program

(def global-evalpush-limit (atom 150))
;; The number of Push instructions that can be evaluated before stopping evaluation

(def global-evalpush-time-limit (atom 0))
;; The time in nanoseconds that a program can evaluate before stopping, 0 means no time limit

(def global-pop-when-tagging (atom true))
;; When true, tagging instructions will pop the exec stack when tagging; otherwise, the exec
;; stack is not popped

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; These definitions are used by some problem-specific error functions, and must therefore
;; be global

(def global-parent-selection (atom :lexicase))
;; The type of parent selection used

(def global-print-behavioral-diversity (atom false))
;; When true, reports will print the behavioral diversity of the population

Reformat and tweak docs.

Reformat and tweak docs.