(ns frontend.components.build
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [frontend.async :refer [put!]]
            [frontend.datetime :as datetime]
            [frontend.models.container :as container-model]
            [frontend.models.build :as build-model]
            [frontend.models.plan :as plan-model]
            [frontend.models.project :as project-model]
            [frontend.components.build-config :as build-config]
            [frontend.components.build-head :as build-head]
            [frontend.components.build-invites :as build-invites]
            [frontend.components.build-steps :as build-steps]
            [frontend.components.common :as common]
            [frontend.components.project.common :as project-common]
            [frontend.state :as state]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.github :as gh-utils]
            [frontend.utils.vcs-url :as vcs-url]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [sablono.core :as html :refer-macros [html]])
    (:require-macros [frontend.utils :refer [html]]))

(defn report-error [build controls-ch]
  (let [build-id (build-model/id build)
        build-url (:build_url build)]
    (when (:failed build)
      [:div.alert.alert-danger
       (if-not (:infrastructure_fail build)
         [:div.alert-wrap
          "Error! "
          [:a {:href "/docs/troubleshooting"}
           "Check out common problems "]
          "or "
          [:a {:title "Report an error in how Circle ran this build"
               :on-click #(put! controls-ch [:report-build-clicked {:build-url build-url}])}
           "report this issue"]
          " and we'll investigate."]

         [:div
          "Looks like we had a bug in our infrastructure, or that of our providers (generally "
          [:a {:href "https://status.github.com/"} "GitHub"]
          " or "
          [:a {:href "https://status.aws.amazon.com/"} "AWS"]
          ") We should have automatically retried this build. We've been alerted of"
          " the issue and are almost certainly looking into it, please "
          (common/contact-us-inner controls-ch)
          " if you're interested in the cause of the problem."])])))

(defn container-pill [{:keys [container current-container-id build-running?]} owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [container-id (container-model/id container)
             controls-ch (om/get-shared owner [:comms :controls])
             status (container-model/status container build-running?)]
        [:a.container-selector
         {:on-click #(put! controls-ch [:container-selected {:container-id container-id}])
          :class (concat (container-model/status->classes status)
                         (when (= container-id current-container-id) ["active"]))}
         (str (:index container))
         (case status
           :failed (common/ico :fail-light)
           :success (common/ico :pass-light)
           :canceled (common/ico :fail-light)
           :running (common/ico :logo-light)
           :waiting (common/ico :none-light)
           nil)])))))

(defn container-pills [data owner]
  (reify
    om/IRender
    (render [_]
      (let [container-data (:container-data data)
            build-running? (:build-running? data)
            {:keys [containers current-container-id]} container-data
            controls-ch (om/get-shared owner [:comms :controls])
            hide-pills? (or (>= 1 (count containers))
                            (empty? (remove :filler-action (mapcat :actions containers))))]
        (html
         [:div.containers (when hide-pills? {:style {:display "none"}})
          [:div.container-list
           (for [container containers]
             (om/build container-pill
                       {:container container
                        :build-running? build-running?
                        :current-container-id current-container-id}
                       {:react-key (:index container)}))]])))))

(defn show-trial-notice? [plan]
  (and (plan-model/trial? plan)
       (plan-model/trial-over? plan)
       (> 4 (plan-model/days-left-in-trial plan))))

(defn notices [data owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [build-data (:build-data data)
             project-data (:project-data data)
             plan (:plan project-data)
             project (:project project-data)
             build (:build build-data)
             controls-ch (om/get-shared owner [:comms :controls])]
         [:div.row-fluid
          [:div.offset1.span10
           [:div (common/messages (:messages build))]
           (when (empty? (:messages build))
             [:div (report-error build controls-ch)])

           (when (and plan (show-trial-notice? plan))
             (om/build project-common/trial-notice plan))

           (when (and project (project-common/show-enable-notice project))
             (om/build project-common/enable-notice project))

           (when (and project (project-common/show-follow-notice project))
             (om/build project-common/follow-notice project))

           (when (build-model/display-build-invite build)
             (om/build build-invites/build-invites
                       (:invite-data build-data)
                       {:opts {:project-name (vcs-url/project-name (:vcs_url build))}}))

           (when (and (build-model/config-errors? build)
                      (not (:dismiss-config-errors build-data)))
             (om/build build-config/config-errors build))]])))))

(defn build [data owner]
  (reify
    om/IRender
    (render [_]
      (let [build (get-in data state/build-path)
            build-data (get-in data state/build-data-path)
            container-data (get-in data state/container-data-path)
            project-data (get-in data state/project-data-path)
            user (get-in data state/user-path)
            controls-ch (om/get-shared owner [:comms :controls])]
        (html
         [:div#build-log-container
          (if-not build
           [:div
             (om/build common/flashes (get-in data state/error-message-path))
             [:div.loading-spinner common/spinner]]

            [:div
             (om/build build-head/build-head {:build-data (dissoc build-data :container-data)
                                              :project-data project-data
                                              :user user})
             (om/build common/flashes (get-in data state/error-message-path))
             (om/build notices {:build-data (dissoc build-data :container-data)
                                :project-data project-data})
             (om/build container-pills {:container-data container-data
                                        :build-running? (build-model/running? build)})
             (om/build build-steps/container-build-steps container-data)

             (when (< 1 (count (:steps build)))
               [:div (common/messages (:messages build))])])])))))

(ns frontend.components.build
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
            [frontend.async :refer [put!]]
            [frontend.datetime :as datetime]
            [frontend.models.container :as container-model]
            [frontend.models.build :as build-model]
            [frontend.models.plan :as plan-model]
            [frontend.models.project :as project-model]
            [frontend.components.build-config :as build-config]
            [frontend.components.build-head :as build-head]
            [frontend.components.build-invites :as build-invites]
            [frontend.components.build-steps :as build-steps]
            [frontend.components.common :as common]
            [frontend.components.project.common :as project-common]
            [frontend.state :as state]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.github :as gh-utils]
            [frontend.utils.vcs-url :as vcs-url]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [sablono.core :as html :refer-macros [html]])
    (:require-macros [frontend.utils :refer [html]]))

(defn report-error [build controls-ch]
  (let [build-id (build-model/id build)
        build-url (:build_url build)]
    (when (:failed build)
      [:div.alert.alert-danger
       (if-not (:infrastructure_fail build)
         [:div.alert-wrap
          "Error! "
          [:a {:href "/docs/troubleshooting"}
           "Check out common problems "]
          "or "
          [:a {:title "Report an error in how Circle ran this build"
               :on-click #(put! controls-ch [:report-build-clicked {:build-url build-url}])}
           "report this issue"]
          " and we'll investigate."]

         [:div
          "Looks like we had a bug in our infrastructure, or that of our providers (generally "
          [:a {:href "https://status.github.com/"} "GitHub"]
          " or "
          [:a {:href "https://status.aws.amazon.com/"} "AWS"]
          ") We should have automatically retried this build. We've been alerted of"
          " the issue and are almost certainly looking into it, please "
          (common/contact-us-inner controls-ch)
          " if you're interested in the cause of the problem."])])))

(defn container-pill [{:keys [container current-container-id build-running?]} owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [container-id (container-model/id container)
             controls-ch (om/get-shared owner [:comms :controls])
             status (container-model/status container build-running?)]
        [:a.container-selector
         {:on-click #(put! controls-ch [:container-selected {:container-id container-id}])
          :role "button"
          :class (concat (container-model/status->classes status)
                         (when (= container-id current-container-id) ["active"]))}
         (str (:index container))
         (case status
           :failed (common/ico :fail-light)
           :success (common/ico :pass-light)
           :canceled (common/ico :fail-light)
           :running (common/ico :logo-light)
           :waiting (common/ico :none-light)
           nil)])))))

(defn container-pills [data owner]
  (reify
    om/IRender
    (render [_]
      (let [container-data (:container-data data)
            build-running? (:build-running? data)
            {:keys [containers current-container-id]} container-data
            controls-ch (om/get-shared owner [:comms :controls])
            hide-pills? (or (>= 1 (count containers))
                            (empty? (remove :filler-action (mapcat :actions containers))))]
        (html
         [:div.containers (when hide-pills? {:style {:display "none"}})
          [:div.container-list
           (for [container containers]
             (om/build container-pill
                       {:container container
                        :build-running? build-running?
                        :current-container-id current-container-id}
                       {:react-key (:index container)}))]])))))

(defn show-trial-notice? [plan]
  (and (plan-model/trial? plan)
       (plan-model/trial-over? plan)
       (> 4 (plan-model/days-left-in-trial plan))))

(defn notices [data owner]
  (reify
    om/IRender
    (render [_]
      (html
       (let [build-data (:build-data data)
             project-data (:project-data data)
             plan (:plan project-data)
             project (:project project-data)
             build (:build build-data)
             controls-ch (om/get-shared owner [:comms :controls])]
         [:div.row-fluid
          [:div.offset1.span10
           [:div (common/messages (:messages build))]
           (when (empty? (:messages build))
             [:div (report-error build controls-ch)])

           (when (and plan (show-trial-notice? plan))
             (om/build project-common/trial-notice plan))

           (when (and project (project-common/show-enable-notice project))
             (om/build project-common/enable-notice project))

           (when (and project (project-common/show-follow-notice project))
             (om/build project-common/follow-notice project))

           (when (build-model/display-build-invite build)
             (om/build build-invites/build-invites
                       (:invite-data build-data)
                       {:opts {:project-name (vcs-url/project-name (:vcs_url build))}}))

           (when (and (build-model/config-errors? build)
                      (not (:dismiss-config-errors build-data)))
             (om/build build-config/config-errors build))]])))))

(defn build [data owner]
  (reify
    om/IRender
    (render [_]
      (let [build (get-in data state/build-path)
            build-data (get-in data state/build-data-path)
            container-data (get-in data state/container-data-path)
            project-data (get-in data state/project-data-path)
            user (get-in data state/user-path)
            controls-ch (om/get-shared owner [:comms :controls])]
        (html
         [:div#build-log-container
          (if-not build
           [:div
             (om/build common/flashes (get-in data state/error-message-path))
             [:div.loading-spinner common/spinner]]

            [:div
             (om/build build-head/build-head {:build-data (dissoc build-data :container-data)
                                              :project-data project-data
                                              :user user})
             (om/build common/flashes (get-in data state/error-message-path))
             (om/build notices {:build-data (dissoc build-data :container-data)
                                :project-data project-data})
             (om/build container-pills {:container-data container-data
                                        :build-running? (build-model/running? build)})
             (om/build build-steps/container-build-steps container-data)

             (when (< 1 (count (:steps build)))
               [:div (common/messages (:messages build))])])])))))

add button role to fix iOS anchor bug

add button role to fix iOS anchor bug


(ns clj-simple-chart.axis.core
  (:require [clj-simple-chart.point :refer [center-point]]
            [clj-simple-chart.axis.ticks :refer [ticks]]
            [clj-simple-chart.opentype :as opentype]))

(defn translate [x y]
  (str "translate(" x "," y ")"))

(def scale-and-argument (fn [scale v] (:type scale)))

(defmulti frmt scale-and-argument)

(defmethod frmt :ordinal
  [scale v]
  v)

(def axis-font-properties
  {:font-size 14
   :font-name "Roboto Regular"})

(def domain ["Peru" "Iraq" "United States"])

(defn apply-axis-text-style-fn [opts scale d]
  (let [default-fn (fn [x] {})
        f (get scale :axis-text-style-fn default-fn)]
    (merge opts (f d))))

(defn bounding-box-domain [domain]
  (->> domain
       (map (fn [txt] (opentype/get-bounding-box (:font-name axis-font-properties)
                                                 txt
                                                 0
                                                 0
                                                 (:font-size axis-font-properties))))
       (reduce (fn [{ax1 :x1 ax2 :x2 ay1 :y1 ay2 :y2} {bx1 :x1 bx2 :x2 by1 :y1 by2 :y2}]
                 {:x1 (min ax1 bx1)
                  :x2 (max ax2 bx2)
                  :y1 (min ay1 by1)
                  :y2 (max ay2 by2)}))))

(defn domain-max-width [domain]
  (:x2 (bounding-box-domain domain)))

;;;; TODO: How does d3 do this?
(defn number-of-decimals [scale]
  (let [domain (:domain scale)
        domain-diff (Math/abs (apply - domain))]
    (cond (>= domain-diff 8) 0
          (>= domain-diff 1) 1
          :else 2)))

(defmethod frmt :linear
  [scale v]
  (format (str "%." (number-of-decimals scale) "f") v))

(def grid-stroke-opacity 0.25)

(defn render-x-axis [scale sign dy]
  (let [color (get scale :color "#000")
        rng (:range scale)
        neg-sign (* -1 sign)
        sign-char (if (= -1 sign) "-" "")]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M0.5," sign-char "6 V0.5 H" (int (apply max rng)) ".5 V" sign-char "6")}]
     (map (fn [d] [:g {:transform (translate (center-point scale d) 0)}
                   [:line {:stroke color :x1 0.5 :x2 0.5 :y2 (* sign 6)}]
                   (when (:grid scale)
                     [:line {:stroke         color
                             :stroke-opacity grid-stroke-opacity
                             :y2             (* neg-sign (:height scale))
                             :x1             0.5 :x2 0.5}])
                   (opentype/text {:x           0.5
                                   :dy          dy
                                   :y           (* sign 9)
                                   :fill        color
                                   :text-anchor "middle"
                                   :font-size   14}
                                  (frmt scale d))]) (ticks scale))]))

(defn render-y-axis [scale sign text-anchor]
  (let [color (get scale :color "#000")
        sign-char (if (= -1 sign) "-" "")
        neg-sign (* -1 sign)
        rng (:range scale)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M" sign-char "6," (int (apply max rng)) ".5 H0.5 V" (int (apply min rng)) ".5 H" sign-char "6")}]
     (map (fn [d] [:g {:transform (translate 0 (center-point scale d))}
                   [:line {:stroke color :x2 (* sign 6) :y1 0.5 :y2 0.5}]
                   (when (:grid scale)
                     [:line {:stroke         color
                             :stroke-opacity grid-stroke-opacity
                             :x2             (* neg-sign (:width scale))
                             :y1             0.5 :y2 0.5}])
                   (opentype/text {:x           (* sign 9)
                                   :dy          ".32em"
                                   :y           0.5
                                   :text-anchor text-anchor
                                   :font-size   14}
                                  (frmt scale d))]) (ticks scale))]))

(defn render-y-axis-ordinal [scale sign direction]
  (let [color (get scale :color "#000")
        sign-char (if (= -1 sign) "-" "")
        neg-sign (* -1 sign)
        rng (:range scale)
        axis-label-max-width (domain-max-width (:domain scale))
        width (+ 6 axis-label-max-width)]
    (with-meta
      [:g
       [:path {:stroke       color
               :stroke-width "1"
               :fill         "none"
               :d            (str "M" sign-char "3," (int (apply max rng)) ".5 H0.5 V" (int (apply min rng)) ".5 H" sign-char "3")}]
       (map (fn [d] [:g {:transform (translate 0 (center-point scale d))}
                     (opentype/text
                       (apply-axis-text-style-fn {:x         (- (* sign 6)
                                                                (if (= :right direction)
                                                                  0
                                                                  axis-label-max-width))
                                                  :dy        ".32em"
                                                  :y         0.5
                                                  :font-size 14} scale d)
                       (frmt scale d))]) (ticks scale))]
      {direction width})))

(defmulti render-axis (juxt :axis :type :orientation))

(defmethod render-axis [:y :ordinal :left] [scale]
  (render-y-axis-ordinal scale -1 :margin-left))

(defmethod render-axis [:y :ordinal :right] [scale]
  (let [rendered (render-y-axis-ordinal scale 1 :margin-right)]
    (with-meta [:g {:transform (translate (:width scale) 0)} rendered]
               (meta rendered))))

(defmethod render-axis [:y :ordinal :both] [scale]
  (let [ax-left (render-axis (assoc scale :orientation :left))
        ax-right (render-axis (assoc scale :orientation :right))]
    (with-meta [:g ax-left ax-right]
               (merge (meta ax-left) (meta ax-right)))))

;(cond (and (every? string? (:domain scale)) (= :ordinal (:type scale)))
;
;      :else
;      (render-y-axis scale -1 "end")))

;(defmethod render-axis [:y :right] [scale]
;  (let [rendered-axis (render-y-axis scale 1 "start")]
;    (with-meta
;      [:g {:transform (translate (:width scale) 0)} rendered-axis]
;      (meta rendered-axis))))
;
;(defmethod render-axis [:y :both] [scale]
;  [:g
;   (render-axis (-> scale
;                    (assoc :orientation :left)
;                    (dissoc :grid)))
;   (render-axis (assoc scale :orientation :right))])
;
;(defmethod render-axis [:x :bottom] [scale]
;  [:g {:transform (translate 0 (:height scale))}
;   (render-x-axis scale 1 ".71em")])
;
;(defmethod render-axis [:x :top] [scale]
;  [:g {:transform (translate 0 0)}
;   (render-x-axis scale -1 "0em")])
;
;(defmethod render-axis [:x :both] [scale]
;  [:g
;   (render-axis (-> scale
;                    (assoc :orientation :top)
;                    (dissoc :grid)))
;   (render-axis (assoc scale :orientation :bottom))])

(ns clj-simple-chart.axis.core
  (:require [clj-simple-chart.point :refer [center-point]]
            [clj-simple-chart.axis.ticks :refer [ticks]]
            [clj-simple-chart.opentype :as opentype]))

(defn translate [x y]
  (str "translate(" x "," y ")"))

(def scale-and-argument (fn [scale v] (:type scale)))

(defmulti frmt scale-and-argument)

(defmethod frmt :ordinal
  [scale v]
  v)

(def axis-font-properties
  {:font-size 14
   :font-name "Roboto Regular"})

(def domain ["Peru" "Iraq" "United States"])

(defn apply-axis-text-style-fn [opts scale d]
  (let [default-fn (fn [x] {})
        f (get scale :axis-text-style-fn default-fn)]
    (merge opts (f d))))

(defn bounding-box-domain [domain]
  (->> domain
       (map (fn [txt] (opentype/get-bounding-box (:font-name axis-font-properties)
                                                 txt
                                                 0
                                                 0
                                                 (:font-size axis-font-properties))))
       (reduce (fn [{ax1 :x1 ax2 :x2 ay1 :y1 ay2 :y2} {bx1 :x1 bx2 :x2 by1 :y1 by2 :y2}]
                 {:x1 (min ax1 bx1)
                  :x2 (max ax2 bx2)
                  :y1 (min ay1 by1)
                  :y2 (max ay2 by2)}))))

(defn domain-max-width [domain]
  (:x2 (bounding-box-domain domain)))

;;;; TODO: How does d3 do this?
(defn number-of-decimals [scale]
  (let [domain (:domain scale)
        domain-diff (Math/abs (apply - domain))]
    (cond (>= domain-diff 8) 0
          (>= domain-diff 1) 1
          :else 2)))

(defmethod frmt :linear
  [scale v]
  (format (str "%." (number-of-decimals scale) "f") v))

(def grid-stroke-opacity 0.25)

(defn render-x-axis [scale sign dy]
  (let [color (get scale :color "#000")
        rng (:range scale)
        neg-sign (* -1 sign)
        sign-char (if (= -1 sign) "-" "")]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M0.5," sign-char "6 V0.5 H" (int (apply max rng)) ".5 V" sign-char "6")}]
     (map (fn [d] [:g {:transform (translate (center-point scale d) 0)}
                   [:line {:stroke color :x1 0.5 :x2 0.5 :y2 (* sign 6)}]
                   (when (:grid scale)
                     [:line {:stroke         color
                             :stroke-opacity grid-stroke-opacity
                             :y2             (* neg-sign (:height scale))
                             :x1             0.5 :x2 0.5}])
                   (opentype/text {:x           0.5
                                   :dy          dy
                                   :y           (* sign 9)
                                   :fill        color
                                   :text-anchor "middle"
                                   :font-size   14}
                                  (frmt scale d))]) (ticks scale))]))

(defn render-y-axis [scale sign text-anchor]
  (let [color (get scale :color "#000")
        sign-char (if (= -1 sign) "-" "")
        neg-sign (* -1 sign)
        rng (:range scale)]
    [:g
     [:path {:stroke       color
             :stroke-width "1"
             :fill         "none"
             :d            (str "M" sign-char "6," (int (apply max rng)) ".5 H0.5 V" (int (apply min rng)) ".5 H" sign-char "6")}]
     (map (fn [d] [:g {:transform (translate 0 (center-point scale d))}
                   [:line {:stroke color :x2 (* sign 6) :y1 0.5 :y2 0.5}]
                   (when (:grid scale)
                     [:line {:stroke         color
                             :stroke-opacity grid-stroke-opacity
                             :x2             (* neg-sign (:width scale))
                             :y1             0.5 :y2 0.5}])
                   (opentype/text {:x           (* sign 9)
                                   :dy          ".32em"
                                   :y           0.5
                                   :text-anchor text-anchor
                                   :font-size   14}
                                  (frmt scale d))]) (ticks scale))]))

(defn render-y-axis-ordinal [scale sign direction]
  (let [color (get scale :color "#000")
        sign-char (if (= -1 sign) "-" "")
        neg-sign (* -1 sign)
        rng (:range scale)
        axis-label-max-width (domain-max-width (:domain scale))
        width (+ 6 axis-label-max-width)]
    (with-meta
      [:g
       [:path {:stroke       color
               :stroke-width "1"
               :fill         "none"
               :d            (str "M" sign-char "3," (int (apply max rng)) ".5 H0.5 V" (int (apply min rng)) ".5 H" sign-char "3")}]
       (map (fn [d] [:g {:transform (translate 0 (center-point scale d))}
                     (opentype/text
                       (apply-axis-text-style-fn {:x         (- (* sign 6)
                                                                (if (= 1 sign)
                                                                  0
                                                                  axis-label-max-width))
                                                  :dy        ".32em"
                                                  :y         0.5
                                                  :font-size 14} scale d)
                       (frmt scale d))]) (ticks scale))]
      {direction width})))

(defmulti render-axis (juxt :axis :type :orientation))

(defmethod render-axis [:y :ordinal :left] [scale]
  (render-y-axis-ordinal scale -1 :margin-left))

(defmethod render-axis [:y :ordinal :right] [scale]
  (let [rendered (render-y-axis-ordinal scale 1 :margin-right)]
    (with-meta [:g {:transform (translate (:width scale) 0)} rendered]
               (meta rendered))))

(defmethod render-axis [:y :ordinal :both] [scale]
  (let [ax-left (render-axis (assoc scale :orientation :left))
        ax-right (render-axis (assoc scale :orientation :right))]
    (with-meta [:g ax-left ax-right]
               (merge (meta ax-left) (meta ax-right)))))

;(cond (and (every? string? (:domain scale)) (= :ordinal (:type scale)))
;
;      :else
;      (render-y-axis scale -1 "end")))

;(defmethod render-axis [:y :right] [scale]
;  (let [rendered-axis (render-y-axis scale 1 "start")]
;    (with-meta
;      [:g {:transform (translate (:width scale) 0)} rendered-axis]
;      (meta rendered-axis))))
;
;(defmethod render-axis [:y :both] [scale]
;  [:g
;   (render-axis (-> scale
;                    (assoc :orientation :left)
;                    (dissoc :grid)))
;   (render-axis (assoc scale :orientation :right))])
;
;(defmethod render-axis [:x :bottom] [scale]
;  [:g {:transform (translate 0 (:height scale))}
;   (render-x-axis scale 1 ".71em")])
;
;(defmethod render-axis [:x :top] [scale]
;  [:g {:transform (translate 0 0)}
;   (render-x-axis scale -1 "0em")])
;
;(defmethod render-axis [:x :both] [scale]
;  [:g
;   (render-axis (-> scale
;                    (assoc :orientation :top)
;                    (dissoc :grid)))
;   (render-axis (assoc scale :orientation :bottom))])

Fix fix fix...

Fix fix fix...


(ns status-im.components.list.views
  "
  Wrapper for react-native list components.

  (defn render [{:keys [title subtitle]}]
    [item
     [item-icon {:icon :dots_vertical_white}]
     [item-content title subtitle]
     [item-icon {:icon :arrow_right_gray}]])

  [flat-list {:data [{:title  \"\" :subtitle \"\"}] :render-fn render}]

  [section-list {:sections [{:title :key :unik :data {:title  \"\" :subtitle \"\"}}] :render-fn render}]

  or with a per-section `render-fn`

  [section-list {:sections [{:title \"\" :key :unik :render-fn render :data {:title  \"\" :subtitle \"\"}}]}]
  "
  (:require [reagent.core :as r]
            [status-im.components.list.styles :as lst]
            [status-im.components.react :as rn]
            [status-im.components.icons.vector-icons :as vi]
            [status-im.utils.platform :as p]))

(def flat-list-class (rn/get-class "FlatList"))
(def section-list-class (rn/get-class "SectionList"))

(defn item
  ([content] (item nil content))
  ([left-action content] (item left-action content nil))
  ([left-action content right-action]
   [rn/view {:style lst/item}
    [rn/view {:style lst/left-item-wrapper}
     left-action]
    content
    [rn/view {:style lst/right-item-wrapper}
     right-action]]))

(defn touchable-item [handler item]
  [rn/touchable-highlight {:on-press handler}
   item])

(defn item-icon
  [{:keys [icon style icon-opts]}]
  [rn/view {:style style}
   [vi/icon icon (merge icon-opts {:style lst/item-icon})]])

(defn item-image
  ([source] (item-image source nil))
  ([source style]
   [rn/view {:style style}
    [rn/image {:source source
               :style  lst/item-image}]]))

(defn item-content
  ([primary] (item-content primary nil))
  ([primary secondary] (item-content primary secondary nil))
  ([primary secondary extra]
   [rn/view {:style lst/item-text-view}
    [rn/text {:style (if secondary lst/primary-text lst/primary-text-only)} primary]
    (when secondary
      [rn/text {:style lst/secondary-text :ellipsize-mode "middle" :number-of-lines 1} secondary])
    extra]))

(defn- wrap-render-fn [f]
  (fn [data]
    ;; For details on passed data
    ;; https://facebook.github.io/react-native/docs/sectionlist.html#renderitem
    (let [{:keys [item index separators]} (js->clj data :keywordize-keys true)]
      (r/as-element (f (js->clj item) index separators)))))

(defn- separator []
  [rn/view lst/separator])

(defn- section-separator []
  [rn/view lst/section-separator])

(defn base-list-props [render-fn empty-component]
  (merge {:keyExtractor (fn [_ i] i)}
         (when render-fn {:renderItem (wrap-render-fn render-fn)})
         (when p/ios? {:ItemSeparatorComponent (fn [] (r/as-element [separator]))})
         ; TODO(jeluard) Does not work with our current ReactNative version
         (when empty-component {:ListEmptyComponent (r/as-element [empty-component])})))

(defn flat-list
  "A wrapper for FlatList.
   See https://facebook.github.io/react-native/docs/flatlist.html"
  [{:keys [data render-fn empty-component] :as props}]
  {:pre [(sequential? data)]}
  (if (and (empty? data) empty-component)
    ;; TODO(jeluard) remove when native :ListEmptyComponent is supported
    empty-component
    [flat-list-class
     (merge (base-list-props render-fn empty-component)
            {:data (clj->js data)}
            props)]))

(defn- wrap-render-section-header-fn [f]
  (fn [data]
    ;; For details on passed data
    ;; https://facebook.github.io/react-native/docs/sectionlist.html#rendersectionheader
    (let [{:keys [section]} (js->clj data :keywordize-keys true)]
      (r/as-element (f section)))))

(defn- default-render-section-header [{:keys [title]}]
  [rn/text {:style lst/section-header}
   title])

(defn- wrap-per-section-render-fn [props]
  ;; TODO(jeluard) Somehow wrapping `:render-fn` does not work
  (if-let [f (:render-fn props)]
    (assoc (dissoc props :render-fn) :renderItem (wrap-render-fn f))
    props))

(defn section-list
  "A wrapper for SectionList.
   See https://facebook.github.io/react-native/docs/sectionlist.html"
  [{:keys [sections render-fn empty-component render-section-header-fn] :or {render-section-header-fn default-render-section-header} :as props}]
  (if (and (every? #(empty? (:data %)) sections) empty-component)
    empty-component
    [section-list-class
     (merge (base-list-props render-fn empty-component)
            {:sections            (clj->js (map wrap-per-section-render-fn sections))
             :renderSectionHeader (wrap-render-section-header-fn render-section-header-fn)}
            (when p/ios? {:SectionSeparatorComponent (fn [] (r/as-element [section-separator]))})
            props)]))

(ns status-im.components.list.views
  "
  Wrapper for react-native list components.

  (defn render [{:keys [title subtitle]}]
    [item
     [item-icon {:icon :dots_vertical_white}]
     [item-content title subtitle]
     [item-icon {:icon :arrow_right_gray}]])

  [flat-list {:data [{:title  \"\" :subtitle \"\"}] :render-fn render}]

  [section-list {:sections [{:title :key :unik :data {:title  \"\" :subtitle \"\"}}] :render-fn render}]

  or with a per-section `render-fn`

  [section-list {:sections [{:title \"\" :key :unik :render-fn render :data {:title  \"\" :subtitle \"\"}}]}]
  "
  (:require [reagent.core :as r]
            [status-im.components.list.styles :as lst]
            [status-im.components.react :as rn]
            [status-im.components.icons.vector-icons :as vi]
            [status-im.utils.platform :as p]))

(def flat-list-class (rn/get-class "FlatList"))
(def section-list-class (rn/get-class "SectionList"))

(defn item
  ([content] (item nil content))
  ([left-action content] (item left-action content nil))
  ([left-action content right-action]
   [rn/view {:style lst/item}
    [rn/view {:style lst/left-item-wrapper}
     left-action]
    content
    [rn/view {:style lst/right-item-wrapper}
     right-action]]))

(defn touchable-item [handler item]
  [rn/touchable-highlight {:on-press handler}
   item])

(defn item-icon
  [{:keys [icon style icon-opts]}]
  [rn/view {:style style}
   [vi/icon icon (merge icon-opts {:style lst/item-icon})]])

(defn item-image
  ([source] (item-image source nil))
  ([source style]
   [rn/view {:style style}
    [rn/image {:source source
               :style  lst/item-image}]]))

(defn item-content
  ([primary] (item-content primary nil))
  ([primary secondary] (item-content primary secondary nil))
  ([primary secondary extra]
   [rn/view {:style lst/item-text-view}
    [rn/text {:style (if secondary lst/primary-text lst/primary-text-only)} primary]
    (when secondary
      [rn/text {:style lst/secondary-text :ellipsize-mode "middle" :number-of-lines 1} secondary])
    extra]))

(defn- wrap-render-fn [f]
  (fn [data]
    ;; For details on passed data
    ;; https://facebook.github.io/react-native/docs/sectionlist.html#renderitem
    (let [{:keys [item index separators]} (js->clj data :keywordize-keys true)]
      (r/as-element (f (js->clj item) index separators)))))

(defn- separator []
  [rn/view lst/separator])

(defn- section-separator []
  [rn/view lst/section-separator])

(defn base-list-props [render-fn empty-component]
  (merge {:keyExtractor (fn [_ i] i)}
         (when render-fn {:renderItem (wrap-render-fn render-fn)})
         (when p/ios? {:ItemSeparatorComponent (fn [] (r/as-element [separator]))})
         ; TODO(jeluard) Does not work with our current ReactNative version
         (when empty-component {:ListEmptyComponent (r/as-element [empty-component])})))

(defn flat-list
  "A wrapper for FlatList.
   See https://facebook.github.io/react-native/docs/flatlist.html"
  [{:keys [data render-fn empty-component] :as props}]
  {:pre [(or (nil? data)
             (sequential? data))]}
  (if (and (empty? data) empty-component)
    ;; TODO(jeluard) remove when native :ListEmptyComponent is supported
    empty-component
    [flat-list-class
     (merge (base-list-props render-fn empty-component)
            {:data (clj->js data)}
            props)]))

(defn- wrap-render-section-header-fn [f]
  (fn [data]
    ;; For details on passed data
    ;; https://facebook.github.io/react-native/docs/sectionlist.html#rendersectionheader
    (let [{:keys [section]} (js->clj data :keywordize-keys true)]
      (r/as-element (f section)))))

(defn- default-render-section-header [{:keys [title]}]
  [rn/text {:style lst/section-header}
   title])

(defn- wrap-per-section-render-fn [props]
  ;; TODO(jeluard) Somehow wrapping `:render-fn` does not work
  (if-let [f (:render-fn props)]
    (assoc (dissoc props :render-fn) :renderItem (wrap-render-fn f))
    props))

(defn section-list
  "A wrapper for SectionList.
   See https://facebook.github.io/react-native/docs/sectionlist.html"
  [{:keys [sections render-fn empty-component render-section-header-fn] :or {render-section-header-fn default-render-section-header} :as props}]
  (if (and (every? #(empty? (:data %)) sections) empty-component)
    empty-component
    [section-list-class
     (merge (base-list-props render-fn empty-component)
            {:sections            (clj->js (map wrap-per-section-render-fn sections))
             :renderSectionHeader (wrap-render-section-header-fn render-section-header-fn)}
            (when p/ios? {:SectionSeparatorComponent (fn [] (r/as-element [section-separator]))})
            props)]))

Fix precondition for flat-list

Fix precondition for flat-list

The flat-list component handles the nil case but the precondition does
not.

This is currently causing transaction list failures when the list of
unsigned transactions is empty.


(ns app.middleware)

;; re-frame handler middleware

(defn check-and-throw
  "throw an exception if db doesn't match the schema."
  [a-schema db]
  (if-let [problems  (s/check a-schema db)]
    (throw (js/Error. (str "schema check failed: " problems)))))

;; after an event handler has run, this middleware can check that
;; it the value in app-db still correctly matches the schema.
(def check-schema-mw (after (partial check-and-throw db/schema)))

(def ->ls (after db/db->ls!))

(def controls-mw [check-schema-mw
                  ->ls
                  (path :controls)
                  trim-v])

(def channel-mw [check-schema-mw
                 ->ls
                 (path :channels)
                 trim-v])

(ns app.middleware
  (:require [schema.core :as s :include-macros true]
            [app.db :as db]
            [re-frame.core :refer [after path
                                   trim-v debug]]))

;; re-frame handler middleware

(defn check-and-throw
  "throw an exception if db doesn't match the schema."
  [a-schema db]
  (if-let [problems  (s/check a-schema db)]
    (throw (js/Error. (str "schema check failed: " problems)))))

;; after an event handler has run, this middleware can check that
;; it the value in app-db still correctly matches the schema.
(def check-schema-mw (after (partial check-and-throw db/schema)))

(def ->ls (after db/db->ls!))

(def controls-mw [check-schema-mw
                  ->ls
                  (path :controls)
                  trim-v])

(def channel-mw [check-schema-mw
                 ->ls
                 (path :channels)
                 trim-v])

Add missing requies

Add missing requies


(ns obb-api.service
  (:require [io.pedestal.http :as bootstrap]
            [io.pedestal.http.route :as route]
            [io.pedestal.http.body-params :as body-params]
            [io.pedestal.http.route.definition :refer [defroutes]]
            [ring.util.response :as ring-resp]
            [environ.core :refer [env]]
            [obb-api.handlers.index :as index]
            [obb-api.handlers.create-friendly :as create-friendly]
            [obb-api.handlers.show-game :as show-game]
            [obb-api.handlers.deploy-game :as deploy-game]
            [obb-api.handlers.latest-games :as latest-games]
            [obb-api.handlers.play-game :as play-game]
            [obb-api.handlers.auth.verify :as auth-verify]
            [obb-api.interceptors.auth-interceptor :as auth-interceptor]))

(defroutes routes
  [[["/" {:get index/handler}

     ["/auth/verify" {:get auth-verify/handler}
      ^:interceptors [auth-interceptor/parse]]

     ["/player/latest-games" {:get latest-games/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/create/friendly" {:post create-friendly/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/:id/deploy" {:put deploy-game/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/:id/turn" {:put play-game/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/:id" {:get show-game/handler}
      ^:interceptors [auth-interceptor/parse]]

     ["/auth/enforce" {:get auth-verify/enforce}
      ^:interceptors [auth-interceptor/enforce]]]]])

;; Consumed by obb-api.server/create-server
;; See bootstrap/default-interceptors for additional options you can configure
(def service {:env :prod
              ;; You can bring your own non-default interceptors. Make
              ;; sure you include routing and set it up right for
              ;; dev-mode. If you do, many other keys for configuring
              ;; default interceptors will be ignored.
              ;; :bootstrap/interceptors []
              ::bootstrap/routes routes

              ;; Uncomment next line to enable CORS support, add
              ;; string(s) specifying scheme, host and port for
              ;; allowed source(s):
              ;;
              ;; "http://localhost:8080"
              ;;
              ::bootstrap/allowed-origins ["http://orionsbelt.eu"
                                           "http://orionsbelt-battlegrounds.github.io"
                                           "http://localhost:10555"
                                           "http://localhost"]

              ;; Root for resource interceptor that is available by default.
              ::bootstrap/resource-path "/public"

              ;; Either :jetty, :immutant or :tomcat (see comments in project.clj)
              ::bootstrap/type :jetty
              ;;::bootstrap/host "localhost"
              ::bootstrap/port (Integer/parseInt (or (System/getenv "OBB_API_PORT")
                                                     (System/getenv "PORT")
                                                     "8080"))})

(ns obb-api.service
  (:require [io.pedestal.http :as bootstrap]
            [io.pedestal.http.route :as route]
            [io.pedestal.http.body-params :as body-params]
            [io.pedestal.http.route.definition :refer [defroutes]]
            [ring.util.response :as ring-resp]
            [environ.core :refer [env]]
            [obb-api.handlers.index :as index]
            [obb-api.handlers.create-friendly :as create-friendly]
            [obb-api.handlers.show-game :as show-game]
            [obb-api.handlers.deploy-game :as deploy-game]
            [obb-api.handlers.latest-games :as latest-games]
            [obb-api.handlers.play-game :as play-game]
            [obb-api.handlers.auth.verify :as auth-verify]
            [obb-api.interceptors.auth-interceptor :as auth-interceptor]))

(defroutes routes
  [[["/" {:get index/handler}

     ["/auth/verify" {:get auth-verify/handler}
      ^:interceptors [auth-interceptor/parse]]

     ["/player/latest-games" {:get latest-games/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/create/friendly" {:post create-friendly/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/:id/deploy" {:put deploy-game/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/:id/turn" {:put play-game/handler}
      ^:interceptors [auth-interceptor/enforce body-params/body-params]]

     ["/game/:id" {:get show-game/handler}
      ^:interceptors [auth-interceptor/parse]]

     ["/auth/enforce" {:get auth-verify/enforce}
      ^:interceptors [auth-interceptor/enforce]]]]])

;; Consumed by obb-api.server/create-server
;; See bootstrap/default-interceptors for additional options you can configure
(def service {:env :prod
              ;; You can bring your own non-default interceptors. Make
              ;; sure you include routing and set it up right for
              ;; dev-mode. If you do, many other keys for configuring
              ;; default interceptors will be ignored.
              ;; :bootstrap/interceptors []
              ::bootstrap/routes routes

              ;; Uncomment next line to enable CORS support, add
              ;; string(s) specifying scheme, host and port for
              ;; allowed source(s):
              ;;
              ;; "http://localhost:8080"
              ;;
              ::bootstrap/allowed-origins ["http://orionsbelt.eu"
                                           "http://orionsbelt-battlegrounds.github.io"
                                           "http://localhost:10555"
                                           "http://localhost:8080"
                                           "http://localhost"]

              ;; Root for resource interceptor that is available by default.
              ::bootstrap/resource-path "/public"

              ;; Either :jetty, :immutant or :tomcat (see comments in project.clj)
              ::bootstrap/type :jetty
              ;;::bootstrap/host "localhost"
              ::bootstrap/port (Integer/parseInt (or (System/getenv "OBB_API_PORT")
                                                     (System/getenv "PORT")
                                                     "8080"))})

Allow requests from localhost:8080

Allow requests from localhost:8080


(ns babel.generate
  (:refer-clojure :exclude [get-in deref resolve find parents])
  (:require
   [babel.cache :refer [check-index get-head-phrases-of get-lex]]
   [babel.over :as over]
   [babel.stringutils :refer [show-as-tree]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.string :as string]
   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path lazy-shuffle
                                        ref? remove-false remove-top-values-log
                                        strip-refs show-spec unify unifyc)]))
;; during generation, will not search deeper than this:
(def ^:const max-total-depth 5)
(def ^:const mapfn pmap)

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

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

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

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

(defn generate [spec grammar lexicon index morph]
  (cond (or (vector? spec)
            (seq? spec))
        (first (take 1
                     (map (fn [each-spec]
                            (log/info (str "generate: generating from spec: "
                                           (strip-refs each-spec)))
                            (let [expression
                                  (generate each-spec grammar lexicon index morph)]
                              (log/info (str "generate: expression generated for spec:"
                                             (strip-refs each-spec) ":"
                                             "'" (morph expression) "'"))
                              expression))
                          spec)))

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

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

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

(defn generate-all [spec grammar lexicon index morph & [total-depth]]
  (log/debug (str "generate-all: generating from spec: "
                 (strip-refs spec)))
  (let [total-depth (if total-depth total-depth 0)
        add-complements-to-bolts
        (fn [bolts path]
          (log/debug (str "generate-all: "
                          "add-complements-to-bolts@" path ":#bolts(" (count bolts) "):"
                          (string/join ","
                                       (map (fn [bolt]
                                              (show-bolt bolt path morph))
                                            bolts))))
          (mapcat
           #(if (not (= :none (get-in % path :none)))
              (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path)))
              [%])
           bolts))

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

    (if (not (empty? expressions))
      (log/debug (str "generate-all: first expression generated for spec:" (strip-refs spec) " ):"
                     "'" (morph (first expressions)) "'"))
      (log/debug (str "generate-all: no expressions could be generated for spec:" (strip-refs expressions))))
    expressions))

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

(defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
  (log/debug (str "add-complement: " (show-bolt bolt path morph)))
  (let [input-spec spec
        from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
        spec (unifyc spec (get-in bolt path))
        immediate-parent (get-in bolt (butlast path))
        start-time (current-time)
        cached (if cache
                 (get-lex immediate-parent :comp cache spec)
                 (do (log/warn (str "no cache: will go through entire lexicon to find candidate complements."))
                     (reduce concat (vals lexicon))))
        complement-candidate-lexemes (if (not (= true
                                                 (get-in bolt (concat path [:phrasal]))))
                                       (if cached cached (flatten (vals lexicon))))
        complement-pre-check (fn [child parent path-to-child]
                               (let [child-in-bolt (get-in bolt path-to-child)
                                     result (not (fail?
                                                  (unifyc (get-in child [:synsem] :top)
                                                          (get-in child-in-bolt [:synsem] :top))))]
                                 (log/trace (str "add-complement: checking child: " (morph child) "success?:" result))
                                 result))
        filtered-lexical-complements (filter (fn [lexeme]
                                               (complement-pre-check lexeme bolt path))
                                             complement-candidate-lexemes)
        debug (log/debug
               (if (not (empty? filtered-lexical-complements))
                 (str "add-complement: " (show-bolt bolt path morph) ":candidate complement-lexemes:'"
                      (string/join "','" (sort (map morph filtered-lexical-complements))) "'")))]
    (filter (fn [complement]
              (if (fail? complement)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ") FAILED:"
                                  "'" (morph complement) "'"))

                  false)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
                                  "'" (morph complement) "'"))
                  true)))
            (mapfn (fn [complement]
                    (unify (copy bolt)
                           (path-to-map path
                                        (copy complement))))
                  (let [debug (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                              ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                              "): calling generate-all(" (strip-refs spec) ");"
                                              "input-spec: " input-spec))
                        phrasal-complements (if (> max-total-depth total-depth)
                                              (lazy-seq (generate-all spec grammar lexicon cache morph (+ depth total-depth))))]
                    (if (lexemes-before-phrases total-depth)
                      (lazy-cat filtered-lexical-complements phrasal-complements)
                      (lazy-cat phrasal-complements filtered-lexical-complements)))))))

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

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

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

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

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

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

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

(defn lexemes-before-phrases [depth]
  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
  (if (> max-total-depth 0)
    (let [prob (- 1.0 (/ (- max-total-depth depth) max-total-depth))]
      (> (* 10 prob) (rand-int 10))))
  1)

(defn show-bolt [bolt path morph]
  (if (not (empty? path))
    (str (get-in bolt [:rule])
         " '" (morph bolt) "' "
         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
           (if (not (nil? rest-str))
             (str " -> " rest-str))))))

(ns babel.generate
  (:refer-clojure :exclude [get-in deref resolve find parents])
  (:require
   [babel.cache :refer [check-index get-head-phrases-of get-lex]]
   [babel.over :as over]
   [babel.stringutils :refer [show-as-tree]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.string :as string]
   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path lazy-shuffle
                                        ref? remove-false remove-top-values-log
                                        strip-refs show-spec unify unifyc)]))
;; during generation, will not search deeper than this:
(def ^:const max-total-depth 5)
(def ^:const mapfn pmap)

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

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

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

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

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

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

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

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

(defn generate-all [spec grammar lexicon index morph & [total-depth]]
  (log/debug (str "generate-all: generating from spec: "
                 (strip-refs spec)))
  (let [total-depth (if total-depth total-depth 0)
        add-complements-to-bolts
        (fn [bolts path]
          (log/debug (str "generate-all: "
                          "add-complements-to-bolts@" path ":#bolts(" (count bolts) "):"
                          (string/join ","
                                       (map (fn [bolt]
                                              (show-bolt bolt path morph))
                                            bolts))))
          (mapcat
           #(if (not (= :none (get-in % path :none)))
              (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path)))
              [%])
           bolts))

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

    (if (not (empty? expressions))
      (log/debug (str "generate-all: first expression generated for spec:" (strip-refs spec) " ):"
                     "'" (morph (first expressions)) "'"))
      (log/debug (str "generate-all: no expressions could be generated for spec:" (strip-refs expressions))))
    expressions))

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

(defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
  (log/debug (str "add-complement: " (show-bolt bolt path morph)))
  (let [input-spec spec
        from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
        spec (unifyc spec (get-in bolt path))
        immediate-parent (get-in bolt (butlast path))
        start-time (current-time)
        cached (if cache
                 (get-lex immediate-parent :comp cache spec)
                 (do (log/warn (str "no cache: will go through entire lexicon to find candidate complements."))
                     (reduce concat (vals lexicon))))
        complement-candidate-lexemes (if (not (= true
                                                 (get-in bolt (concat path [:phrasal]))))
                                       (if cached cached (flatten (vals lexicon))))
        complement-pre-check (fn [child parent path-to-child]
                               (let [child-in-bolt (get-in bolt path-to-child)
                                     result (not (fail?
                                                  (unifyc (get-in child [:synsem] :top)
                                                          (get-in child-in-bolt [:synsem] :top))))]
                                 (log/trace (str "add-complement: checking child: " (morph child) "success?:" result))
                                 result))
        filtered-lexical-complements (filter (fn [lexeme]
                                               (complement-pre-check lexeme bolt path))
                                             complement-candidate-lexemes)
        debug (log/debug
               (if (not (empty? filtered-lexical-complements))
                 (str "add-complement: " (show-bolt bolt path morph) ":candidate complement-lexemes:'"
                      (string/join "','" (sort (map morph filtered-lexical-complements))) "'")))]
    (filter (fn [complement]
              (if (fail? complement)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ") FAILED:"
                                  "'" (morph complement) "'"))

                  false)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
                                  "'" (morph complement) "'"))
                  true)))
            (mapfn (fn [complement]
                    (unify (copy bolt)
                           (path-to-map path
                                        (copy complement))))
                  (let [debug (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                              ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                              "): calling generate-all(" (strip-refs spec) ");"
                                              "input-spec: " input-spec))
                        phrasal-complements (if (> max-total-depth total-depth)
                                              (lazy-seq (generate-all spec grammar lexicon cache morph (+ depth total-depth))))]
                    (if (lexemes-before-phrases total-depth)
                      (lazy-cat filtered-lexical-complements phrasal-complements)
                      (lazy-cat phrasal-complements filtered-lexical-complements)))))))

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

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

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

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

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

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

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

(defn lexemes-before-phrases [depth]
  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
  (if (> max-total-depth 0)
    (let [prob (- 1.0 (/ (- max-total-depth depth) max-total-depth))]
      (> (* 10 prob) (rand-int 10))))
  1)

(defn show-bolt [bolt path morph]
  (if (not (empty? path))
    (str (get-in bolt [:rule])
         " '" (morph bolt) "' "
         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
           (if (not (nil? rest-str))
             (str " -> " rest-str))))))

fix (generate)'s handling a spec which is a sequence


(ns babel.generate
  (:refer-clojure :exclude [get-in deref resolve find parents])
  (:require
   [babel.cache :refer [check-index get-head-phrases-of get-lex]]
   [babel.over :as over]
   [babel.stringutils :refer [show-as-tree]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.string :as string]
   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path-between lazy-shuffle
                                        ref? remove-false remove-top-values-log
                                        strip-refs show-spec unify unifyc)]))
;; during generation, will not search deeper than this:
(def ^:const max-total-depth 5)

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

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

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

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

(defn generate [spec grammar lexicon index morph]
  (if (empty? grammar)
    (do
      (log/error (str "grammar is empty."))
      (exception (str "grammar is empty."))))
  (first (take 1 (generate-all spec grammar lexicon index morph))))

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

(defn generate-all [spec grammar lexicon index morph & [total-depth]]
  (let [total-depth (if total-depth total-depth 0)
        add-complements-to-bolts
        (fn [bolts path]
          (mapcat
           #(if (not (= :none (get-in % path :none)))
              (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path)))
              [%])
           bolts))]
    (-> (lightning-bolt (lazy-shuffle grammar)
                        lexicon
                        spec 0 index morph total-depth)
        ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
        (add-complements-to-bolts [:head :head :head :comp] )
        (add-complements-to-bolts [:head :head :comp])
        (add-complements-to-bolts [:head :comp])
        (add-complements-to-bolts [:comp]))))

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

(defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
  (log/info (str "add-complement: " (show-bolt bolt path morph)))
  (let [input-spec spec
        from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
        spec (unifyc spec (get-in bolt path))
        immediate-parent (get-in bolt (butlast path))
        start-time (current-time)
        cached (if cache
                 (get-lex immediate-parent :comp cache spec)
                 (do (log/warn (str "no cache: will go through entire lexicon to find candidate complements."))
                     (reduce concat (vals lexicon))))
        complement-candidate-lexemes (if (not (= true
                                                 (get-in bolt (concat path [:phrasal]))))
                                       (if cached cached (flatten (vals lexicon))))
        complement-pre-check (fn [child parent path-to-child]
                               (let [child-in-bolt (get-in bolt path-to-child)]
                                 (and (not (fail?
                                            (unifyc (get-in child [:synsem] :top)
                                                    (get-in child-in-bolt [:synsem] :top)))))))
        filtered-lexical-complements (filter (fn [lexeme]
                                               (complement-pre-check lexeme bolt path))
                                             complement-candidate-lexemes)
        shuffled-candidate-lexical-complements (lazy-shuffle filtered-lexical-complements)]
    (filter (fn [complement]
              (if (fail? complement)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ") FAILED:"
                                  "'" (morph complement) "'"))

                  false)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
                                  "'" (morph complement) "'"))
                  true)))
            (pmap (fn [complement]
                    (unify (copy bolt)
                           (path-to-map path
                                        (copy complement))))
                  (let [debug (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                              ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                              "): calling generate-all(" (strip-refs spec) ");"
                                              "input-spec: " input-spec))
                        phrasal-complements (if (> max-total-depth total-depth)
                                              (generate-all spec grammar lexicon cache morph (+ depth total-depth)))]
                    (if (lexemes-before-phrases total-depth)
                      (lazy-cat filtered-lexical-complements phrasal-complements)
                      (lazy-cat phrasal-complements filtered-lexical-complements)))))))

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

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

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

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

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

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

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

(defn lexemes-before-phrases [depth]
  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
  (let [result (> (rand-int (- 1 depth)) 0)]
    (log/trace (str "lexemes-before-phrases: depth=" depth " => " result))
    result))

(defn show-bolt [bolt path morph]
  (if (not (empty? path))
    (str (get-in bolt [:rule])
         " '" (morph bolt) "' "
         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
           (if (not (nil? rest-str))
             (str " -> " rest-str))))))

(ns babel.generate
  (:refer-clojure :exclude [get-in deref resolve find parents])
  (:require
   [babel.cache :refer [check-index get-head-phrases-of get-lex]]
   [babel.over :as over]
   [babel.stringutils :refer [show-as-tree]]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [clojure.string :as string]
   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path-between lazy-shuffle
                                        ref? remove-false remove-top-values-log
                                        strip-refs show-spec unify unifyc)]))
;; during generation, will not search deeper than this:
(def ^:const max-total-depth 5)
(def ^:const mapfn pmap)

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

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

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

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

(defn generate [spec grammar lexicon index morph]
  (if (empty? grammar)
    (do
      (log/error (str "grammar is empty."))
      (exception (str "grammar is empty."))))
  (first (take 1 (generate-all spec grammar lexicon index morph))))

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

(defn generate-all [spec grammar lexicon index morph & [total-depth]]
  (let [total-depth (if total-depth total-depth 0)
        add-complements-to-bolts
        (fn [bolts path]
          (mapcat
           #(if (not (= :none (get-in % path :none)))
              (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path)))
              [%])
           bolts))]
    (-> (lightning-bolt (lazy-shuffle grammar)
                        lexicon
                        spec 0 index morph total-depth)
        ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
        (add-complements-to-bolts [:head :head :head :comp] )
        (add-complements-to-bolts [:head :head :comp])
        (add-complements-to-bolts [:head :comp])
        (add-complements-to-bolts [:comp]))))

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

(defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
  (log/info (str "add-complement: " (show-bolt bolt path morph)))
  (let [input-spec spec
        from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
        spec (unifyc spec (get-in bolt path))
        immediate-parent (get-in bolt (butlast path))
        start-time (current-time)
        cached (if cache
                 (get-lex immediate-parent :comp cache spec)
                 (do (log/warn (str "no cache: will go through entire lexicon to find candidate complements."))
                     (reduce concat (vals lexicon))))
        complement-candidate-lexemes (if (not (= true
                                                 (get-in bolt (concat path [:phrasal]))))
                                       (if cached cached (flatten (vals lexicon))))
        complement-pre-check (fn [child parent path-to-child]
                               (let [child-in-bolt (get-in bolt path-to-child)]
                                 (and (not (fail?
                                            (unifyc (get-in child [:synsem] :top)
                                                    (get-in child-in-bolt [:synsem] :top)))))))
        filtered-lexical-complements (filter (fn [lexeme]
                                               (complement-pre-check lexeme bolt path))
                                             complement-candidate-lexemes)
        shuffled-candidate-lexical-complements (lazy-shuffle filtered-lexical-complements)]
    (filter (fn [complement]
              (if (fail? complement)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ") FAILED:"
                                  "'" (morph complement) "'"))

                  false)
                (do
                  (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
                                  "'" (morph complement) "'"))
                  true)))
            (mapfn (fn [complement]
                    (unify (copy bolt)
                           (path-to-map path
                                        (copy complement))))
                  (let [debug (log/trace (str "add-complement(depth=" depth ",total-depth=" total-depth
                                              ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                              "): calling generate-all(" (strip-refs spec) ");"
                                              "input-spec: " input-spec))
                        phrasal-complements (if (> max-total-depth total-depth)
                                              (generate-all spec grammar lexicon cache morph (+ depth total-depth)))]
                    (if (lexemes-before-phrases total-depth)
                      (lazy-cat filtered-lexical-complements phrasal-complements)
                      (lazy-cat phrasal-complements filtered-lexical-complements)))))))

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

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

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

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

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

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

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

(defn lexemes-before-phrases [depth]
  ;; takes depth as an argument; make phrases decreasingly likely as depth increases.
  (let [result (> (rand-int (- 1 depth)) 0)]
    (log/trace (str "lexemes-before-phrases: depth=" depth " => " result))
    result))

(defn show-bolt [bolt path morph]
  (if (not (empty? path))
    (str (get-in bolt [:rule])
         " '" (morph bolt) "' "
         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
           (if (not (nil? rest-str))
             (str " -> " rest-str))))))

use mapfn to switch between (map) and (pmap)