(ns overtone.sc.machinery.ugen.metadata.envgen
  (:use [overtone.sc.machinery.ugen common check]))

(def specs
     [
      {:name "Done",
       :args [{:name "src"
               :doc "ugen to monitor"}]

       :rates #{:kr}
       :doc "Outputs a one when the src ugen (typically an envelope) has
             finished"}

      {:name "FreeSelf",
       :args [{:name "in"
               :doc "input signal"}]

       :rates #{:kr}
       :check (nth-input-stream? 0)
       :doc "Free the enclosing synth when triggered"}

      {:name "PauseSelf",
       :args [{:name "in"
               :doc "input signal"}]

       :rates #{:kr}
       :check (nth-input-stream? 0)
       :doc "Pause the enclosing synth when triggered"}

      {:name "FreeSelfWhenDone",
       :args [{:name "src"
               :doc "the ugen to check for done"}]

       :rates #{:kr}
       :doc "Free the enclosing synth when the src ugen
             finishes (e.g. env-gen, play-buf, linen...)" }

      {:name "PauseSelfWhenDone",
       :args [{:name "src"
               :doc "the ugen to check for done"}]

       :rates #{:kr}
       :doc "Pause the enclosing synth when the src ugen
             finishes (e.g. env-gen, play-buf, linen...)" }

      {:name "Pause",
       :args [{:name "gate"
               :doc "when gate is 0,  node is paused, when 1 it runs"}

              {:name "id"
               :doc "node to be paused"}]

       :rates #{:kr}
       :doc "Pause a specified node when triggered"}

      {:name "Free",
       :args [{:name "trig"
               :doc "when triggered, frees node"}

              {:name "id"
               :doc "node to be freed"}]

       :rates #{:kr}
       :doc "Free the specified node when triggered"}

      {:name "EnvGen",
       :args [{:name "envelope"
               :doc "an Array of Controls."
               :mode :append-sequence }

              {:name "gate",
               :default 1.0
               :doc "this triggers the envelope and holds it open while
                     > 0. If the Env is fixed-length (e.g. Env.linen,
                     Env.perc), the gate argument is used as a simple
                     trigger. If it is an sustaining envelope (e.g. Env.adsr,
                     Env.asr), the envelope is held open until the gate
                     becomes 0, at which point is released."}

              {:name "level-scale",
               :default 1.0
               :doc "scales the levels of the breakpoints."}

              {:name "level-bias",
               :default 0.0
               :doc "offsets the levels of the breakpoints."}

              {:name "time-scale",
               :default 1.0
               :doc "scales the durations of the segments."}

              {:name "action",
               :default 0
               :doc "an integer representing an action to be executed
                     when the env is finished playing. This can be used
                     to free the enclosing synth, etc." }]

       :doc "envelope generator, interpolates across a path of control
             points over time, see the overtone.sc.envelope functions to
             generate the control points array

             Note:

             The actual minimum duration of a segment is not zero, but
             one sample step for audio rate and one block for control
             rate. This may result in asynchronicity when in two
             envelopes of different number of levels, the envelope times
             add up to the same total duration. Similarly, when
             modulating times, the new time is only updated at the end
             of the current segment - this may lead to asynchronicity of
             two envelopes with modulated times."
       :default-rate :kr}
               ;(let [envec (TODO turn env object into vector)]

      {:name "Linen",
       :args [{:name "gate",
               :default 1.0
               :doc "Input trigger"}

              {:name "attack-time",
               :default 0.01
               :doc "Time taken to rise to susLevel in seconds"}

              {:name "sus-level",
               :default 1.0
               :doc "Level to hold the envelope at until gate is triggered"}

              {:name "release-time",
               :default 1.0
               :doc "Time to fall from susLevel back to 0 after the gate has been triggered"}

              {:name "action", :default 0 :doc "done action"}],

       :rates #{:kr}
       :doc "A linear envelope generator, rises to susLevel over
             attackTime seconds and after the gate goes non-positive
             falls over releaseTime to finally perform an option
             doneAction"}

      ;; TODO figure out what an IEnvGen is and write init
      {:name "IEnvGen"
       :args [{:name
               "ienvelope"
               :doc "an InterplEnv (this is static for the life of the UGen)"}

              {:name "index"
               :doc "a point to access within the InterplEnv"}]

       :doc "Plays back break point envelopes from the index point."
;;       :init (fn [rate [env & args] spec])
       }])

(ns overtone.sc.machinery.ugen.metadata.envgen
  (:use [overtone.sc.machinery.ugen common check]))

(def specs
     [
      {:name "Done",
       :args [{:name "src"
               :doc "ugen to monitor"}]

       :rates #{:kr}
       :doc "Outputs a one when the src ugen (typically an envelope) has
             finished"}

      {:name "FreeSelf",
       :args [{:name "in"
               :doc "input signal"}]

       :rates #{:kr}
       :check (nth-input-stream? 0)
       :doc "Free the enclosing synth when triggered"}

      {:name "PauseSelf",
       :args [{:name "in"
               :doc "input signal"}]

       :rates #{:kr}
       :check (nth-input-stream? 0)
       :doc "Pause the enclosing synth when triggered"}

      {:name "FreeSelfWhenDone",
       :args [{:name "src"
               :doc "the ugen to check for done"}]

       :rates #{:kr}
       :doc "Free the enclosing synth when the src ugen
             finishes (e.g. env-gen, play-buf, linen...)" }

      {:name "PauseSelfWhenDone",
       :args [{:name "src"
               :doc "the ugen to check for done"}]

       :rates #{:kr}
       :doc "Pause the enclosing synth when the src ugen
             finishes (e.g. env-gen, play-buf, linen...)" }

      {:name "Pause",
       :args [{:name "gate"
               :doc "when gate is 0,  node is paused, when 1 it runs"}

              {:name "id"
               :doc "node to be paused"}]

       :rates #{:kr}
       :doc "Pause a specified node when triggered"}

      {:name "Free",
       :args [{:name "trig"
               :doc "when triggered, frees node"}

              {:name "id"
               :doc "node to be freed"}]

       :rates #{:kr}
       :doc "Free the specified node when triggered"}

      {:name "EnvGen",
       :args [{:name "envelope"
               :doc "an Array of Controls."
               :mode :append-sequence }

              {:name "gate",
               :default 1.0
               :doc "this triggers the envelope and holds it open while
               > 0. If the Env is fixed-length (e.g. perc), the gate
               argument is used as a simple trigger. If it is an
               sustaining envelope (e.g. adsr, asr), the envelope is
               held open until the gate becomes 0, at which point is
               released." }

              {:name "level-scale",
               :default 1.0
               :doc "scales the levels of the breakpoints."}

              {:name "level-bias",
               :default 0.0
               :doc "offsets the levels of the breakpoints."}

              {:name "time-scale",
               :default 1.0
               :doc "scales the durations of the segments."}

              {:name "action",
               :default 0
               :doc "an integer representing an action to be executed
                     when the env is finished playing. This can be used
                     to free the enclosing synth, etc." }]

       :doc "envelope generator, interpolates across a path of control
             points over time, see the overtone.sc.envelope functions to
             generate the control points array

             Note:

             The actual minimum duration of a segment is not zero, but
             one sample step for audio rate and one block for control
             rate. This may result in asynchronicity when in two
             envelopes of different number of levels, the envelope times
             add up to the same total duration. Similarly, when
             modulating times, the new time is only updated at the end
             of the current segment - this may lead to asynchronicity of
             two envelopes with modulated times."
       :default-rate :kr}
               ;(let [envec (TODO turn env object into vector)]

      {:name "Linen",
       :args [{:name "gate",
               :default 1.0
               :doc "Input trigger"}

              {:name "attack-time",
               :default 0.01
               :doc "Time taken to rise to susLevel in seconds"}

              {:name "sus-level",
               :default 1.0
               :doc "Level to hold the envelope at until gate is triggered"}

              {:name "release-time",
               :default 1.0
               :doc "Time to fall from susLevel back to 0 after the gate has been triggered"}

              {:name "action", :default 0 :doc "done action"}],

       :rates #{:kr}
       :doc "A linear envelope generator, rises to sus-level over
             attack-time seconds and after the gate goes non-positive
             falls over release-time to finally perform the (optional)
             action"}

      ;; TODO figure out what an IEnvGen is and write init
      {:name "IEnvGen"
       :args [{:name
               "ienvelope"
               :doc "an InterplEnv (this is static for the life of the UGen)"}

              {:name "index"
               :doc "a point to access within the InterplEnv"}]

       :doc "Plays back break point envelopes from the index point."
;;       :init (fn [rate [env & args] spec])
       }])

fix up camelcase names in envgen metadata


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.main.ui.workspace.sidebar.drawtools
  (:require [sablono.core :as html :refer-macros [html]]
            [lentes.core :as l]
            [uxbox.util.i18n :refer (tr)]
            [uxbox.util.router :as r]
            [uxbox.util.rstore :as rs]
            [uxbox.util.data :refer (read-string)]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.util.dom :as dom]
            [uxbox.main.state :as st]
            [uxbox.main.library :as library]
            [uxbox.main.data.workspace :as dw]
            [uxbox.main.ui.workspace.base :as wb]
            [uxbox.main.ui.icons :as i]))

;; --- Refs

(def ^:private drawing-shape
  "A focused vision of the drawing property
  of the workspace status. This avoids
  rerender the whole toolbox on each workspace
  change."
  (-> (l/in [:workspace :drawing])
      (l/derive st/state)))

;; --- Constants

(def +draw-tool-rect+
  {:type :rect
   :name "Rect"
   :stroke "#000000"})

(def +draw-tool-circle+
  {:type :circle
   :name "Circle"})

(def +draw-tool-line+
  {:type :line
   :name "Line"
   :stroke-type :solid
   :stroke "#000000"})

(def +draw-tool-path+
  {:type :path
   :name "Path"
   :stroke-type :solid
   :stroke "#000000"
   :stroke-width 2
   :fill "#000000"
   :fill-opacity 0
   ;; :close? true
   :points []})

(def +draw-tool-text+
  {:type :text
   :name "Text"
   :content "Hello world"})

(def +draw-tools+
  {:rect
   {:icon i/box
    :help (tr "ds.help.rect")
    :shape +draw-tool-rect+
    :priority 1}
   :circle
   {:icon i/circle
    :help (tr "ds.help.circle")
    :shape +draw-tool-circle+
    :priority 2}
   :line
   {:icon i/line
    :help (tr "ds.help.line")
    :shape +draw-tool-line+
    :priority 3}
   :text
   {:icon i/text
    :help (tr "ds.help.text")
    :shape +draw-tool-text+
    :priority 4}
   :path
   {:icon i/curve
    :help (tr "ds.help.path")
    :shape +draw-tool-path+
    :priority 5}})

;; --- Draw Toolbox (Component)

(defn- select-for-draw
  [shape]
  (rs/emit! (dw/select-for-drawing shape)))

(mx/defc draw-toolbox
  {:mixins [mx/static mx/reactive]}
  [own]
  (let [workspace (mx/react wb/workspace-ref)
        drawing (mx/react drawing-shape)
        close #(rs/emit! (dw/toggle-flag :drawtools))
        tools (->> (into [] +draw-tools+)
                   (sort-by (comp :priority second)))]
    [:div#form-tools.tool-window.drawing-tools
     [:div.tool-window-bar
      [:div.tool-window-icon i/window]
      [:span (tr "ds.draw-tools")]
      [:div.tool-window-close {:on-click close} i/close]]
     [:div.tool-window-content
      (for [[key props] tools
            :let [selected? (= drawing (:shape props))]]
        [:div.tool-btn.tooltip.tooltip-hover
         {:alt (:help props)
          :class (when selected? "selected")
          :key (name key)
          :on-click (partial select-for-draw (:shape props))}
         (:icon props)])]]))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

(ns uxbox.main.ui.workspace.sidebar.drawtools
  (:require [sablono.core :as html :refer-macros [html]]
            [lentes.core :as l]
            [uxbox.util.i18n :refer (tr)]
            [uxbox.util.router :as r]
            [uxbox.util.rstore :as rs]
            [uxbox.util.data :refer (read-string)]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.util.dom :as dom]
            [uxbox.main.state :as st]
            [uxbox.main.library :as library]
            [uxbox.main.data.workspace :as dw]
            [uxbox.main.ui.workspace.base :as wb]
            [uxbox.main.ui.icons :as i]))

;; --- Refs

(def ^:private drawing-shape
  "A focused vision of the drawing property
  of the workspace status. This avoids
  rerender the whole toolbox on each workspace
  change."
  (-> (l/in [:workspace :drawing])
      (l/derive st/state)))

;; --- Constants

(def +draw-tool-rect+
  {:type :rect
   :name "Rect"
   :stroke "#000000"})

(def +draw-tool-circle+
  {:type :circle
   :name "Circle"})

(def +draw-tool-line+
  {:type :line
   :name "Line"
   :stroke-type :solid
   :stroke "#000000"})

(def +draw-tool-path+
  {:type :path
   :name "Path"
   :stroke-type :solid
   :stroke "#000000"
   :stroke-width 2
   :fill "#000000"
   :fill-opacity 0
   ;; :close? true
   :points []})

(def +draw-tool-text+
  {:type :text
   :name "Text"
   :content "Hello world"})

(def +draw-tools+
  [{:icon i/box
    :help (tr "ds.help.rect")
    :shape +draw-tool-rect+
    :priority 1}
   {:icon i/circle
    :help (tr "ds.help.circle")
    :shape +draw-tool-circle+
    :priority 2}
   {:icon i/line
    :help (tr "ds.help.line")
    :shape +draw-tool-line+
    :priority 3}
   {:icon i/text
    :help (tr "ds.help.text")
    :shape +draw-tool-text+
    :priority 4}
   {:icon i/curve
    :help (tr "ds.help.path")
    :shape +draw-tool-path+
    :priority 5}
   {:icon i/pencil
    :help (tr "ds.help.path")
    :shape (assoc +draw-tool-path+ :free true)
    :priority 6}])

;; --- Draw Toolbox (Component)

(defn- select-for-draw
  [shape]
  (rs/emit! (dw/select-for-drawing shape)))

(mx/defc draw-toolbox
  {:mixins [mx/static mx/reactive]}
  [own]
  (let [workspace (mx/react wb/workspace-ref)
        drawing (mx/react drawing-shape)
        close #(rs/emit! (dw/toggle-flag :drawtools))
        tools (->> (into [] +draw-tools+)
                   (sort-by (comp :priority second)))]
    [:div#form-tools.tool-window.drawing-tools
     [:div.tool-window-bar
      [:div.tool-window-icon i/window]
      [:span (tr "ds.draw-tools")]
      [:div.tool-window-close {:on-click close} i/close]]
     [:div.tool-window-content
      (for [[i props] (map-indexed vector tools)
            :let [selected? (= drawing (:shape props))]]
        [:div.tool-btn.tooltip.tooltip-hover
         {:alt (:help props)
          :class (when selected? "selected")
          :key (str i)
          :on-click (partial select-for-draw (:shape props))}
         (:icon props)])]]))

Simplify drawtools sidebar main data structure.


(defn digit [n base]
  (if (< n base) (list n)
    (cons (rem n base) (digit (quot n base) base))))

(defn isPanlindrome? [n]
  (let [num-digit (digit n 10)]
    (= num-digit (reverse num-digit))))

(defn prod [lst]
  (for [i lst, j lst]
       (* i j)))

(println (apply max (filter isPanlindrome? (prod (range 100 1000)))))

(defn digit [base n]
  (if (< n base) (list n)
    (cons (rem n base) (digit base (quot n base)))))

(def digit10 (partial digit 10))

(defn isPanlindrome? [n]
  (let [num-digit (digit10 n)]
    (= num-digit (reverse num-digit))))

(defn prod [lst]
  (for [i lst, j lst]
       (* i j)))

(println (apply max (filter isPanlindrome? (prod (range 100 1000)))))

update 004.clj using partial

update 004.clj using partial


(ns taoensso.carmine.locks
  "Alpha - subject to change.
  Distributed lock implementation for Carmine based on work by Ronen Narkis
  and Josiah Carlson.

  Redis keys:
    * carmine:lock:<lock-name> -> ttl str, lock owner's UUID

  Ref. http://goo.gl/5UalQ for implementation details."
  (:require [taoensso.carmine       :as car]
            [taoensso.carmine.utils :as utils]
            [taoensso.timbre        :as timbre]))

(utils/defonce* config "Alpha - subject to change."
  (atom {:conns {:pool (car/make-conn-pool)
                 :spec (car/make-conn-spec)}
         ;; :defaults {:lock-timeout-ms 2000
         ;;            :wait-timeout-ms 500}
         }))

(defn set-config! [[k & ks] val] (swap! config assoc-in (cons k ks) val))

(defmacro ^:private wcar
  [& body]
  `(let [{pool# :pool spec# :spec} (:conns @config)]
     (car/with-conn pool# spec# ~@body)))

;;(def ^:private lkey (memoize (car/make-keyfn "carmine" "lock")))
(defn- lkey [lock-name] (str "carmine:lock:" (name lock-name)))

(defn acquire-lock
  "Attempts to acquire a distributed lock, returning owner's UUID iff successful."
  [lock-name lock-timeout-ms wait-timeout-ms]
  (let [max-udt (+ wait-timeout-ms (System/currentTimeMillis))
        uuid    (str (java.util.UUID/randomUUID))]
    (wcar ; Hold one connection for all attempts
     (loop []
       (when (> max-udt (System/currentTimeMillis))
         (if (-> (car/lua-script
                  "if redis.call('setnx', _:lkey, _:uuid) == 1 then
                    redis.call('pexpire', _:lkey, _:lock-timeout-ms)
                    return 1
                  elseif redis.call('ttl', _:lkey) < 0 then
                    redis.call('pexpire', _:lkey, _:lock-timeout-ms)
                  end
                  return 0"
                  {:lkey            (lkey lock-name)}
                  {:uuid            uuid
                   :lock-timeout-ms lock-timeout-ms})
                 car/parse-bool car/with-replies)
           (car/return uuid)
           (do (Thread/sleep 1) (recur))))))))

(comment (acquire-lock "my-lock" 2000 500))

(defn release-lock
  "Attempts to release a distributed lock, returning true iff successful."
  [lock-name owner-uuid]
  (-> (car/lua-script
       "if redis.call('get', _:lkey) == _:uuid then
         redis.call('del', _:lkey)
         return 1
       else
         return 0
       end"
       {:lkey (lkey lock-name)}
       {:uuid owner-uuid})
      car/parse-bool wcar))

(comment
  (when-let [uuid (acquire-lock "my-lock" 2000 500)]
    [(Thread/sleep 100)
     (release-lock "my-lock" uuid)
     (release-lock "my-lock" uuid)]))

(defn have-lock?
  [lock-name owner-uuid]
  (-> (car/lua-script
       "if redis.call('get', _:lkey) == _:uuid then
         return 1
       else
         return 0
       end"
       {:lkey (lkey lock-name)}
       {:uuid owner-uuid})
      car/parse-bool wcar))

(comment
  (when-let [uuid (acquire-lock "my-lock" 2000 500)]
    [(Thread/sleep 100)
     (have-lock? "my-lock" uuid)
     (Thread/sleep 2000)
     (have-lock? "my-lock" uuid)]))

(defmacro with-lock
  "Attempts to acquire a distributed lock, executing body and then releasing
  lock when successful. Returns {:result <body's result>} on successful release,
  or nil if the lock could not be acquired. If the lock is successfully acquired
  but expires before being released, throws an exception."
  [lock-name & [lock-timeout-ms wait-timeout-ms & body]]
  `(when-let [uuid# (acquire-lock ~lock-name ~lock-timeout-ms ~wait-timeout-ms)]
     (try
       {:result (do ~@body)} ; Wrapped to distinguish nil body result
       (catch Throwable t# (throw t#))
       (finally
        (when-not (release-lock ~lock-name uuid#)
          (throw (RuntimeException. (str "Lock expired before it was released: "
                                         ~lock-name))))))))

(comment
  (timbre/set-level! :debug)
  (with-lock "my-lock" 2000 500 (Thread/sleep 1000) "foo!")  ; {:result "foo!"}
  (with-lock "my-lock" 2000 500 (Thread/sleep 1000) (/ 1 0)) ; ex
  (with-lock "my-lock" 2000 500 (Thread/sleep 2500) "foo!")  ; ex
  (do (future (with-lock "my-lock" 2000 500  (Thread/sleep 1000) (println "foo!")))
      (future (with-lock "my-lock" 2000 500  (Thread/sleep 1000) (println "bar!")))
      (future (with-lock "my-lock" 2000 2000 (Thread/sleep 1000) (println "baz!")))))

(defn- release-all-locks! []
  (when-let [lkeys (seq (wcar (car/keys (lkey "*"))))]
    (wcar (apply car/del lkeys))))

(comment (release-all-locks!))

(ns taoensso.carmine.locks
  "Alpha - subject to change.
  Distributed lock implementation for Carmine based on work by Ronen Narkis
  and Josiah Carlson.

  Redis keys:
    * carmine:lock:<lock-name> -> ttl str, lock owner's UUID

  Ref. http://goo.gl/5UalQ for implementation details."
  (:require [taoensso.carmine       :as car]
            [taoensso.carmine.utils :as utils]
            [taoensso.timbre        :as timbre]))

(utils/defonce* config "Alpha - subject to change."
  (atom {:conns {:pool (car/make-conn-pool)
                 :spec (car/make-conn-spec)}
         ;; :defaults {:lock-timeout-ms 2000
         ;;            :wait-timeout-ms 500}
         }))

(defn set-config! [[k & ks] val] (swap! config assoc-in (cons k ks) val))

(defmacro ^:private wcar
  [& body]
  `(let [{pool# :pool spec# :spec} (:conns @config)]
     (car/with-conn pool# spec# ~@body)))

;;(def ^:private lkey (memoize (car/make-keyfn "carmine" "lock")))
(defn- lkey [lock-name] (str "carmine:lock:" (name lock-name)))

(defn acquire-lock
  "Attempts to acquire a distributed lock, returning owner's UUID iff successful."
  [lock-name lock-timeout-ms wait-timeout-ms]
  (let [max-udt (+ wait-timeout-ms (System/currentTimeMillis))
        uuid    (str (java.util.UUID/randomUUID))]
    (wcar ; Hold one connection for all attempts
     (loop []
       (when (> max-udt (System/currentTimeMillis))
         (if (-> (car/lua-script
                  "if redis.call('setnx', _:lkey, _:uuid) == 1 then
                    redis.call('pexpire', _:lkey, _:lock-timeout-ms)
                    return 1
                  else
                    return 0
                  end"
                  {:lkey            (lkey lock-name)}
                  {:uuid            uuid
                   :lock-timeout-ms lock-timeout-ms})
                 car/parse-bool car/with-replies)
           (car/return uuid)
           (do (Thread/sleep 1) (recur))))))))

(comment (acquire-lock "my-lock" 2000 500))

(defn release-lock
  "Attempts to release a distributed lock, returning true iff successful."
  [lock-name owner-uuid]
  (-> (car/lua-script
       "if redis.call('get', _:lkey) == _:uuid then
         redis.call('del', _:lkey)
         return 1
       else
         return 0
       end"
       {:lkey (lkey lock-name)}
       {:uuid owner-uuid})
      car/parse-bool wcar))

(comment
  (when-let [uuid (acquire-lock "my-lock" 2000 500)]
    [(Thread/sleep 100)
     (release-lock "my-lock" uuid)
     (release-lock "my-lock" uuid)]))

(defn have-lock?
  [lock-name owner-uuid]
  (-> (car/lua-script
       "if redis.call('get', _:lkey) == _:uuid then
         return 1
       else
         return 0
       end"
       {:lkey (lkey lock-name)}
       {:uuid owner-uuid})
      car/parse-bool wcar))

(comment
  (when-let [uuid (acquire-lock "my-lock" 2000 500)]
    [(Thread/sleep 100)
     (have-lock? "my-lock" uuid)
     (Thread/sleep 2000)
     (have-lock? "my-lock" uuid)]))

(defmacro with-lock
  "Attempts to acquire a distributed lock, executing body and then releasing
  lock when successful. Returns {:result <body's result>} on successful release,
  or nil if the lock could not be acquired. If the lock is successfully acquired
  but expires before being released, throws an exception."
  [lock-name lock-timeout-ms wait-timeout-ms & body]
  `(when-let [uuid# (acquire-lock ~lock-name ~lock-timeout-ms ~wait-timeout-ms)]
     (try
       {:result (do ~@body)} ; Wrapped to distinguish nil body result
       (catch Throwable t# (throw t#))
       (finally
        (when-not (release-lock ~lock-name uuid#)
          (throw (RuntimeException. (str "Lock expired before it was released: "
                                         ~lock-name))))))))

(comment
  (timbre/set-level! :debug)
  (with-lock "my-lock" 2000 500 (Thread/sleep 1000) "foo!")  ; {:result "foo!"}
  (with-lock "my-lock" 2000 500 (Thread/sleep 1000) (/ 1 0)) ; ex
  (with-lock "my-lock" 2000 500 (Thread/sleep 2500) "foo!")  ; ex
  (do (future (with-lock "my-lock" 2000 500  (Thread/sleep 1000) (println "foo!")))
      (future (with-lock "my-lock" 2000 500  (Thread/sleep 1000) (println "bar!")))
      (future (with-lock "my-lock" 2000 2000 (Thread/sleep 1000) (println "baz!")))))

(defn- release-all-locks! []
  (when-let [lkeys (seq (wcar (car/keys (lkey "*"))))]
    (wcar (apply car/del lkeys))))

(comment (release-all-locks!))

remove unnecessary `pexpire` fallback

Locks: remove unnecessary `pexpire` fallback


(ns carbonite.serializer
  (:require [clojure.string :as s])
  (:import [carbonite ClojureMapSerializer RatioSerializer
            ClojureReaderSerializer PrintDupSerializer StringSeqSerializer
            ClojureVecSerializer ClojureSetSerializer ClojureSeqSerializer]
           [com.twitter.chill.java  RegexSerializer SqlDateSerializer
            SqlTimeSerializer TimestampSerializer URISerializer UUIDSerializer]
           [com.esotericsoftware.kryo Kryo]
           [com.esotericsoftware.kryo.io Input Output]
           [java.util UUID]
           [java.util.regex Pattern]
           [java.sql Time Timestamp]
           [clojure.lang Keyword Symbol PersistentArrayMap
            PersistentHashMap MapEntry PersistentStructMap
            PersistentVector PersistentHashSet Ratio ArraySeq
            Cons PersistentList PersistentList$EmptyList Var
            LazySeq IteratorSeq StringSeq]))

(defn clj-print
  "Use the Clojure pr-str to print an object into the Output using
  pr-str."
  [^Output output obj]
  (.writeString output (pr-str obj)))

(defn clj-print-dup
  "Use the Clojure pr-str to print an object into the buffer using
   pr-str w/ *print-dup* bound to true."
  [output obj]
  (binding [*print-dup* true]
    (clj-print output obj)))

(defn clj-read
  "Use the Clojure read-string to read an object from a buffer."
  [^Input input]
  (read-string (.readString input)))

(defn print-collection
  [^Kryo registry ^Output output coll]
  (.writeInt output (count coll) true)
  (doseq [x coll]
    (.writeClassAndObject registry output x)))

(defn read-seq
  [^Kryo registry ^Input input]
  (let [len (.readInt input true)]
    (->> (repeatedly len #(.readClassAndObject registry input))
         (apply list))))

(defn mk-collection-reader [init-coll]
  ;; TODO: Accept Kryo and Input
  (fn [^Kryo registry ^Input input]
    (loop [remaining (.readInt input true)
           data      (transient init-coll)]
      (if (zero? remaining)
        (persistent! data)
        (recur (dec remaining)
               (conj! data (.readClassAndObject registry input)))))))

(def read-vector (mk-collection-reader []))
(def read-set    (mk-collection-reader #{}))

(defn write-map
  "Write an associative data structure to Kryo's buffer. Write entry
   count as an int, then serialize alternating key/value pairs."
  [^Kryo registry ^Output output m]
  (.writeInt output (count m) true)
  (doseq [[k v] m]
    (.writeClassAndObject registry output k)
    (.writeClassAndObject registry output v)))

(defn read-map
  "Read a map from Kryo's buffer.  Read entry count, then deserialize alternating
   key/value pairs.  Transients are used for performance."
  [^Kryo registry ^Input input]
  (doall
   (loop [remaining (.readInt input true)
          data      (transient {})]
     (if (zero? remaining)
       (persistent! data)
       (recur (dec remaining)
              (assoc! data
                      (.readClassAndObject registry input)
                      (.readClassAndObject registry input)))))))

(defn write-string-seq [^Output output string-seq]
  (.writeString output (s/join string-seq)))

(defn read-string-seq [^Input input]
  (seq (.readString input)))

(def ^{:doc "Define a map of Clojure primitives and their serializers
  to install."}
  clojure-primitives
  (let [prims (array-map
               Keyword (ClojureReaderSerializer.)
               Symbol  (ClojureReaderSerializer.)
               Ratio   (RatioSerializer.)
               Var     (PrintDupSerializer.))]
    (if-let [big-int (try (Class/forName "clojure.lang.BigInt")
                          (catch ClassNotFoundException _))]
      (assoc prims big-int (ClojureReaderSerializer.))
      prims)))

(def java-primitives
  (array-map
   Timestamp     (TimestampSerializer.)
   java.sql.Date (SqlDateSerializer.)
   java.sql.Time (SqlTimeSerializer.)
   java.net.URI  (URISerializer.)
   Pattern       (RegexSerializer.)
   UUID          (UUIDSerializer.)))

(def clojure-collections
  (concat
   ;; collections where we can use transients for perf
   [[PersistentVector (ClojureVecSerializer.)]
    [PersistentHashSet (ClojureSetSerializer.)]
    [MapEntry (ClojureVecSerializer.)]]

   ;; list/seq collections
   (map #(vector % (ClojureSeqSerializer.))
        [Cons PersistentList$EmptyList PersistentList
         LazySeq IteratorSeq ArraySeq])

   ;; other seqs
   [[StringSeq (StringSeqSerializer.)]]

   ;; maps - use transients for perf
   (map #(vector % (ClojureMapSerializer.))
        [PersistentArrayMap PersistentHashMap PersistentStructMap])))

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

(ns carbonite.serializer
  (:require [clojure.string :as s])
  (:import [carbonite ClojureMapSerializer RatioSerializer
            ClojureReaderSerializer PrintDupSerializer StringSeqSerializer
            ClojureVecSerializer ClojureSetSerializer ClojureSeqSerializer]
           [com.twitter.chill.java  RegexSerializer SqlDateSerializer
            SqlTimeSerializer TimestampSerializer URISerializer UUIDSerializer]
           [com.esotericsoftware.kryo Kryo]
           [com.esotericsoftware.kryo.io Input Output]
           [java.util UUID]
           [java.util.regex Pattern]
           [java.sql Time Timestamp]
           [clojure.lang Keyword Symbol PersistentArrayMap
            PersistentHashMap MapEntry PersistentStructMap
            PersistentVector PersistentHashSet Ratio ArraySeq
            Cons PersistentList PersistentList$EmptyList Var
            LazySeq IteratorSeq StringSeq PersistentVector$ChunkedSeq]))

(defn clj-print
  "Use the Clojure pr-str to print an object into the Output using
  pr-str."
  [^Output output obj]
  (.writeString output (pr-str obj)))

(defn clj-print-dup
  "Use the Clojure pr-str to print an object into the buffer using
   pr-str w/ *print-dup* bound to true."
  [output obj]
  (binding [*print-dup* true]
    (clj-print output obj)))

(defn clj-read
  "Use the Clojure read-string to read an object from a buffer."
  [^Input input]
  (read-string (.readString input)))

(defn print-collection
  [^Kryo registry ^Output output coll]
  (.writeInt output (count coll) true)
  (doseq [x coll]
    (.writeClassAndObject registry output x)))

(defn read-seq
  [^Kryo registry ^Input input]
  (let [len (.readInt input true)]
    (->> (repeatedly len #(.readClassAndObject registry input))
         (apply list))))

(defn mk-collection-reader [init-coll]
  ;; TODO: Accept Kryo and Input
  (fn [^Kryo registry ^Input input]
    (loop [remaining (.readInt input true)
           data      (transient init-coll)]
      (if (zero? remaining)
        (persistent! data)
        (recur (dec remaining)
               (conj! data (.readClassAndObject registry input)))))))

(def read-vector (mk-collection-reader []))
(def read-set    (mk-collection-reader #{}))

(defn write-map
  "Write an associative data structure to Kryo's buffer. Write entry
   count as an int, then serialize alternating key/value pairs."
  [^Kryo registry ^Output output m]
  (.writeInt output (count m) true)
  (doseq [[k v] m]
    (.writeClassAndObject registry output k)
    (.writeClassAndObject registry output v)))

(defn read-map
  "Read a map from Kryo's buffer.  Read entry count, then deserialize alternating
   key/value pairs.  Transients are used for performance."
  [^Kryo registry ^Input input]
  (doall
   (loop [remaining (.readInt input true)
          data      (transient {})]
     (if (zero? remaining)
       (persistent! data)
       (recur (dec remaining)
              (assoc! data
                      (.readClassAndObject registry input)
                      (.readClassAndObject registry input)))))))

(defn write-string-seq [^Output output string-seq]
  (.writeString output (s/join string-seq)))

(defn read-string-seq [^Input input]
  (seq (.readString input)))

(def ^{:doc "Define a map of Clojure primitives and their serializers
  to install."}
  clojure-primitives
  (let [prims (array-map
               Keyword (ClojureReaderSerializer.)
               Symbol  (ClojureReaderSerializer.)
               Ratio   (RatioSerializer.)
               Var     (PrintDupSerializer.))]
    (if-let [big-int (try (Class/forName "clojure.lang.BigInt")
                          (catch ClassNotFoundException _))]
      (assoc prims big-int (ClojureReaderSerializer.))
      prims)))

(def java-primitives
  (array-map
   Timestamp     (TimestampSerializer.)
   java.sql.Date (SqlDateSerializer.)
   java.sql.Time (SqlTimeSerializer.)
   java.net.URI  (URISerializer.)
   Pattern       (RegexSerializer.)
   UUID          (UUIDSerializer.)))

(def clojure-collections
  (concat
   ;; collections where we can use transients for perf
   [[PersistentVector (ClojureVecSerializer.)]
    [PersistentHashSet (ClojureSetSerializer.)]
    [MapEntry (ClojureVecSerializer.)]]

   ;; list/seq collections
   (map #(vector % (ClojureSeqSerializer.))
        [Cons PersistentList$EmptyList PersistentList
         LazySeq IteratorSeq ArraySeq
         PersistentVector$ChunkedSeq])

   ;; other seqs
   [[StringSeq (StringSeqSerializer.)]]

   ;; maps - use transients for perf
   (map #(vector % (ClojureMapSerializer.))
        [PersistentArrayMap PersistentHashMap PersistentStructMap])))

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

add PersistentVector$ChunkedSeq serializer


(ns sparqlab.routes.home
  (:require [sparqlab.layout :as layout]
            [sparqlab.sparql :as sparql]
            [sparqlab.store :refer [select-query]]
            [sparqlab.prefixes :as prefix]
            [sparqlab.util :refer [query-file?]]
            [compojure.core :refer [context defroutes GET POST]]
            [clojure.tools.logging :as log]
            [ring.util.http-response :as response]
            [markdown.core :refer [md-to-html-string]]
            [selmer.filters :refer [add-filter!]]
            [clojure.string :as string]))

(add-filter! :markdown (fn [s] [:safe (md-to-html-string s)]))

(def a-year
  "One year in seconds"
  (* 60 60 24 365))

(def cookie-ns
  "sparqlab-exercise-")

(defn set-cookie
  [response k value & {:as data}]
  (assoc-in response
            [:cookies k]
            (merge {:max-age a-year
                    :path "/"}
                   data
                   {:value value})))

(defn mark-exercise-as-done
  [response id]
  (set-cookie response
              (str cookie-ns id)
              true))

(defn mark-exercises-as-done
  [exercises exercises-done]
  (map (fn [{:keys [id]
             :as exercise}]
         (if (exercises-done id)
           (assoc exercise :done true)
           exercise))
       exercises))

(defn get-exercise
  [id]
  (-> "get_exercise"
      (sparql/sparql-template {:exercise (prefix/exercise id)})
      select-query
      first
      sparql/->plain-literals))

(defn get-prerequisites
  [id]
  (->> (sparql/sparql-template "get_prerequisites" {:exercise (prefix/exercise id)})
       select-query
       (map sparql/->plain-literals)))

(defn get-exercises
  []
  (->> "get_exercises"
       sparql/sparql-template
       select-query
       (map sparql/->plain-literals)))

(defn get-exercises-done
  [request]
  (->> (:cookies request)
       (filter (every-pred (comp #(string/starts-with? % cookie-ns) key)
                           (comp (partial = "true") :value val)))
       (map (comp #(subs % (count cookie-ns)) key))
       (into #{})))

(defn get-namespace-prefixes
  []
  (->> "get_namespace_prefixes"
       sparql/sparql-template
       select-query
       (map (fn [{{prefix "@value"} :prefix
                  {nspace "@id"} :namespace}]
              {:prefix prefix
               :namespace nspace}))))

(defn home-page
  [request]
  (let [exercises-done (get-exercises-done request)]
    (layout/render "home.html" {:exercises (mark-exercises-as-done (get-exercises) exercises-done)})))

(defn evaluate-exercise
  [{{query "query"} :form-params}
   id]
  (let [{canonical-query :query
         :as exercise} (get-exercise id)
        verdict (sparql/evaluate-exercise canonical-query query)]
    (cond-> (layout/render "evaluation.html" (merge exercise verdict))
      (:equal? verdict) (mark-exercise-as-done id))))

(defn search-exercises
  [search-term]
  (->> (sparql/sparql-template "find_exercises" {:search-term search-term})
       select-query
       (map sparql/->plain-literals)))

(defn show-exercise
  [id]
  (let [exercise (get-exercise id)
        prerequisites (get-prerequisites id)]
    (layout/render "exercise.html" (assoc exercise :prerequisites prerequisites))))

(defn sparql-endpoint
  []
  (layout/render "endpoint.html"))

(defn about-page
  []
  (layout/render "about.html"))

(defn data-page
  []
  (let [prefixes (get-namespace-prefixes)]
    (layout/render "data.html" {:prefixes prefixes})))

(defn search-results
  [search-term]
  (let [exercises-found (search-exercises search-term)]
    (layout/render "search_results.html" {:search-term search-term
                                          :exercises exercises-found})))

(defroutes home-routes
  (GET "/" request (home-page request))
  (context "/exercise" []
           (GET "/show/:id" [id] (show-exercise id))
           (POST "/evaluate/:id" [id :as request] (evaluate-exercise request id)))
  (GET "/endpoint" [] (sparql-endpoint))
  (GET "/data" [] (data-page))
  (GET "/about" [] (about-page))
  (GET "/search" {{search-term :q} :params} (search-results search-term)))

(ns sparqlab.routes.home
  (:require [sparqlab.layout :as layout]
            [sparqlab.sparql :as sparql]
            [sparqlab.store :refer [select-query]]
            [sparqlab.prefixes :as prefix]
            [sparqlab.util :refer [query-file?]]
            [compojure.core :refer [context defroutes GET POST]]
            [clojure.tools.logging :as log]
            [ring.util.http-response :as response]
            [markdown.core :refer [md-to-html-string]]
            [selmer.filters :refer [add-filter!]]
            [clojure.string :as string]))

(add-filter! :markdown (fn [s] [:safe (md-to-html-string s)]))

(add-filter! :dec dec)

(def a-year
  "One year in seconds"
  (* 60 60 24 365))

(def cookie-ns
  "sparqlab-exercise-")

(defn set-cookie
  [response k value & {:as data}]
  (assoc-in response
            [:cookies k]
            (merge {:max-age a-year
                    :path "/"}
                   data
                   {:value value})))

(defn mark-exercise-as-done
  [response id]
  (set-cookie response
              (str cookie-ns id)
              true))

(defn mark-exercises-as-done
  [exercises exercises-done]
  (map (fn [{:keys [id]
             :as exercise}]
         (if (exercises-done id)
           (assoc exercise :done true)
           exercise))
       exercises))

(defn get-exercise
  [id]
  (-> "get_exercise"
      (sparql/sparql-template {:exercise (prefix/exercise id)})
      select-query
      first
      sparql/->plain-literals))

(defn get-prerequisites
  [id]
  (->> (sparql/sparql-template "get_prerequisites" {:exercise (prefix/exercise id)})
       select-query
       (map sparql/->plain-literals)))

(defn get-exercises
  []
  (->> "get_exercises"
       sparql/sparql-template
       select-query
       (map sparql/->plain-literals)))

(defn get-exercises-done
  [request]
  (->> (:cookies request)
       (filter (every-pred (comp #(string/starts-with? % cookie-ns) key)
                           (comp (partial = "true") :value val)))
       (map (comp #(subs % (count cookie-ns)) key))
       (into #{})))

(defn get-namespace-prefixes
  []
  (->> "get_namespace_prefixes"
       sparql/sparql-template
       select-query
       (map (fn [{{prefix "@value"} :prefix
                  {nspace "@id"} :namespace}]
              {:prefix prefix
               :namespace nspace}))))

(defn home-page
  [request]
  (let [exercises-done (get-exercises-done request)]
    (layout/render "home.html" {:exercises (mark-exercises-as-done (get-exercises) exercises-done)})))

(defn evaluate-exercise
  [{{query "query"} :form-params}
   id]
  (let [{canonical-query :query
         :as exercise} (get-exercise id)
        verdict (sparql/evaluate-exercise canonical-query query)]
    (cond-> (layout/render "evaluation.html" (merge exercise verdict))
      (:equal? verdict) (mark-exercise-as-done id))))

(defn search-exercises
  [search-term]
  (->> (sparql/sparql-template "find_exercises" {:search-term search-term})
       select-query
       (map sparql/->plain-literals)))

(defn show-exercise
  [id]
  (let [exercise (get-exercise id)
        prerequisites (get-prerequisites id)]
    (layout/render "exercise.html" (assoc exercise :prerequisites prerequisites))))

(defn sparql-endpoint
  []
  (layout/render "endpoint.html"))

(defn about-page
  []
  (layout/render "about.html"))

(defn data-page
  []
  (let [prefixes (get-namespace-prefixes)]
    (layout/render "data.html" {:prefixes prefixes})))

(defn search-results
  [search-term]
  (let [exercises-found (search-exercises search-term)]
    (layout/render "search_results.html" {:search-term search-term
                                          :exercises exercises-found})))

(defroutes home-routes
  (GET "/" request (home-page request))
  (context "/exercise" []
           (GET "/show/:id" [id] (show-exercise id))
           (POST "/evaluate/:id" [id :as request] (evaluate-exercise request id)))
  (GET "/endpoint" [] (sparql-endpoint))
  (GET "/data" [] (data-page))
  (GET "/about" [] (about-page))
  (GET "/search" {{search-term :q} :params} (search-results search-term)))

Add dec filter to Selmer

Add dec filter to Selmer


(ns just-married.views
  (:require
   [re-frame.core :as re-frame :refer [dispatch subscribe]]
   [just-married.language :refer [lang-selection]]
   [just-married.payment-views :as payment-views]
   [just-married.countdown :as countdown]
   [just-married.settings :as settings]))

(def SECTIONS
  [["story" "Our Story"]
   ["find-us" "Find us"]
   ["rvsp" "RVSP"]
   ;; ["share" "Share Your Memories"]
   ["accomodation" "Accomodation"]
   ["contacts" "Contacts"]])

;; this is quite bootstrap specific in a way
;; would be good to extract even further
(defn navbar
  []
  (let [current-language (subscribe [:current-language])]
    (fn []
      [:nav {:class "navbar navbar-dark bg-primary"}
       [:div {:class "container-fluid"}
        [:div {:class "navbar-header"}
         [:a {:class "navbar-brand" :href "#"} "Home" ]]

        (into
         [:ul {:class "nav navbar-nav"}]
         (for [s SECTIONS]
           [:li [:a {:href (str "#" (first s))} (second s)]]))

        [:ul {:class "nav navbar-right"}
         [:div {:class "bfh-selectbox bfh-languages"
                :data-language "en_GB"
                :data-available "en_GB,it_IT"
                :data-flags true}
          [:input {:type "hidden" :value ""}]]]]])))

(defn story
  []
  [:div {:id "story" :class "section"}
   [:div {:class "names"} "Andrea Crotti & Enrica Verrucci"]
   [:div {:class "find-us"}
    [:a {:href "#find-us"} (-> settings/PLACES :parco :name)]]

   [:div {:class "date"} "27th May, 2018"]
   [:div {:id "countdown"} (countdown/countdown-component)]])

(defn find-us
  []
  [:div {:id "find-us" :class "section"}
   [:div
    [:a
     {:href (-> settings/PLACES :parco :url)}
     (-> settings/PLACES :parco :name)]]

   [:div {:id "map"} "Map here"]])

(defn gifts
  []
  [:div {:id "gifts" :class "section"}
   [:div {:id "amazon-wish-list"}
    [:a {:href settings/AMAZON-WISH-LIST} "Amazon wish list"]]])

(defn rvsp
  []
  [:div {:id "rvsp" :class "section"}
   [:input {:type "text"
            :placeholder "Your name"
            :class "form-control"
            :on-change #(dispatch [:name (-> % .-target .-value)])}]

   [:input {:type "email"
            :placeholder "Your email address"
            :class "form-control"
            :on-change #(dispatch [:email (-> % .-target .-value)])}]

   ;; add something about dietary requirements here if possible
   [:button {:id "confirm-coming"
             :class "btn btn-success btn-medium"
             :on-click #(dispatch [:coming])}
    "Pleasure to join you!"]

   [:button {:id "confirm-not-coming"
             :class "btn btn-danger btn-medium"
             :on-click #(dispatch [:not-coming])}
    "Sadly can't join you!"]

   #_[:div {:class "g-recaptcha"
          :data-sitekey settings/RECAPTCHA-KEY}]])

;; devtools does not seem to be set up correctly
;; since it doesn't find hints.js for example
;; (log "hello")

;; should dispatch the right language also here of course
(defn add-to-calendar
  []
  (let [current-language (subscribe [:current-language])]
    (js/console.log "current language is now " current-language)
    (fn []
      [:div {:id "add-to-calendar"}
       [:a {:target "_blank"
            :href (get settings/WEDDING-DAY :en)}

        ;; actually use current language
        (condp = :en
          :en "Add to Calendar"
          :it "Aggiungi al calendario")

        [:img {:src settings/GOOGLE-CALENDAR-IMG}]]])))

(defn main-panel
  []
  (fn []
    [:g
     [navbar]
     [lang-selection]
     [add-to-calendar]
     ;; lang selection could be moved into the header potentially?
     [story]
     [find-us]
     [gifts]
     [rvsp]]))

(ns just-married.views
  (:require
   [re-frame.core :as re-frame :refer [dispatch subscribe]]
   [just-married.language :refer [lang-selection]]
   [just-married.payment-views :as payment-views]
   [just-married.countdown :as countdown]
   [just-married.settings :as settings]))

(def SECTIONS
  [["story" "Our Story"]
   ["find-us" "Find us"]
   ["rvsp" "RVSP"]
   ;; ["share" "Share Your Memories"]
   ["accomodation" "Accomodation"]
   ["contacts" "Contacts"]])

;; this is quite bootstrap specific in a way
;; would be good to extract even further
(defn navbar
  []
  (let [current-language (subscribe [:current-language])]
    (fn []
      [:nav {:class "navbar navbar-dark bg-primary"}
       [:div {:class "container-fluid"}
        [:div {:class "navbar-header"}
         [:a {:class "navbar-brand" :href "#"} "Home" ]]

        (into
         [:ul {:class "nav navbar-nav"}]
         (for [[href name] SECTIONS]
           [:li [:a {:href (str "#" href)} name]]))

        [:ul {:class "nav navbar-right"}
         (lang-selection current-language)]]])))

(defn story
  []
  [:div {:id "story" :class "section"}
   [:div {:class "names"} "Andrea Crotti & Enrica Verrucci"]
   [:div {:class "find-us"}
    [:a {:href "#find-us"} (-> settings/PLACES :parco :name)]]

   [:div {:class "date"} "27th May, 2018"]
   [:div {:id "countdown"} (countdown/countdown-component)]])

(defn find-us
  []
  [:div {:id "find-us" :class "section"}
   [:div
    [:a
     {:href (-> settings/PLACES :parco :url)}
     (-> settings/PLACES :parco :name)]]

   [:div {:id "map"} "Map here"]])

(defn gifts
  []
  [:div {:id "gifts" :class "section"}
   [:div {:id "amazon-wish-list"}
    [:a {:href settings/AMAZON-WISH-LIST} "Amazon wish list"]]])

(defn rvsp
  []
  [:div {:id "rvsp" :class "section"}
   [:input {:type "text"
            :placeholder "Your name"
            :class "form-control"
            :on-change #(dispatch [:name (-> % .-target .-value)])}]

   [:input {:type "email"
            :placeholder "Your email address"
            :class "form-control"
            :on-change #(dispatch [:email (-> % .-target .-value)])}]

   ;; add something about dietary requirements here if possible
   [:button {:id "confirm-coming"
             :class "btn btn-success btn-medium"
             :on-click #(dispatch [:coming])}
    "Pleasure to join you!"]

   [:button {:id "confirm-not-coming"
             :class "btn btn-danger btn-medium"
             :on-click #(dispatch [:not-coming])}
    "Sadly can't join you!"]

   #_[:div {:class "g-recaptcha"
          :data-sitekey settings/RECAPTCHA-KEY}]])

;; devtools does not seem to be set up correctly
;; since it doesn't find hints.js for example
;; (log "hello")

;; should dispatch the right language also here of course
(defn add-to-calendar
  []
  (let [current-language (subscribe [:current-language])]
    (js/console.log "current language is now " current-language)
    (fn []
      [:div {:id "add-to-calendar"}
       [:a {:target "_blank"
            :href (get settings/WEDDING-DAY :en)}

        ;; actually use current language
        (condp = :en
          :en "Add to Calendar"
          :it "Aggiungi al calendario")

        [:img {:src settings/GOOGLE-CALENDAR-IMG}]]])))

(defn main-panel
  []
  (fn []
    [:g
     [navbar]
     [add-to-calendar]
     ;; lang selection could be moved into the header potentially?
     [story]
     [find-us]
     [gifts]
     [rvsp]]))

choose language on top

choose language on top


(ns cmr.search.services.xslt
  "Provides functions for invoking xsl on metadata."
  (:require [clojure.java.io :as io]
            [cmr.common.cache :as cache])
  (:import javax.xml.transform.TransformerFactory
           java.io.StringReader
           java.io.StringWriter
           javax.xml.transform.stream.StreamSource
           javax.xml.transform.stream.StreamResult))

(def xsl-transformer-cache-name
  :xsl-transformers)

(defn context->xsl-transformer-cache
  [context]
  (get-in context [:system :caches xsl-transformer-cache-name]))

(defn- xsl->transformer
  "Returns the xsl transformer for the given xsl file"
  [xsl]
  (let [xsl-resource (new StreamSource (io/file xsl))
        factory (TransformerFactory/newInstance)]
    (.newTransformer factory xsl-resource)))

(defn transform
  "Transforms the given xml by appling the given xsl"
  [context xml xsl]
  (let [transformer (cache/cache-lookup
                      (context->xsl-transformer-cache context) xsl #(xsl->transformer xsl))
        source (new StreamSource (new StringReader xml))
        result (new StreamResult (new StringWriter))]
    (.transform transformer source result)
    (.toString (.getWriter result))))

(ns cmr.search.services.xslt
  "Provides functions for invoking xsl on metadata."
  (:require [clojure.java.io :as io]
            [cmr.common.cache :as cache])
  (:import javax.xml.transform.TransformerFactory
           java.io.StringReader
           java.io.StringWriter
           javax.xml.transform.stream.StreamSource
           javax.xml.transform.stream.StreamResult
           javax.xml.transform.Templates))

(def xsl-transformer-cache-name
  "This is the name of the cache to use for XSLT transformer templates. Templates are thread
  safe but transformer instances are not.
  http://www.onjava.com/pub/a/onjava/excerpt/java_xslt_ch5/?page=9"
  :xsl-transformer-templates)

(defn context->xsl-transformer-cache
  [context]
  (get-in context [:system :caches xsl-transformer-cache-name]))

(defn- xsl->transformer-template
  "Returns the xsl transformer template for the given xsl file"
  [xsl]
  (let [xsl-resource (new StreamSource (io/file xsl))
        factory (TransformerFactory/newInstance)]
    (.newTemplates factory xsl-resource)))

(defn transform
  "Transforms the given xml by appling the given xsl"
  [context xml xsl]
  (let [^Templates template (cache/cache-lookup
                              (context->xsl-transformer-cache context)
                              xsl
                              #(xsl->transformer-template xsl))
        transformer (.newTransformer template)
        source (new StreamSource (new StringReader xml))
        result (new StreamResult (new StringWriter))]
    (.transform transformer source result)
    (.toString (.getWriter result))))

Fix concurrency issue when processing XSLT. Saxon XSLT transformers are not thread safe.


(defproject kafka-clj "3.6.4-SNAPSHOT"
  :description "fast kafka library implemented in clojure"
  :url "https://github.com/gerritjvv/kafka-fast"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}

  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]

  :global-vars {*warn-on-reflection* true
               *assert* true}

  ;:main kafka-clj.app
  :scm {:name "git"
         :url "https://github.com/gerritjvv/kafka-fast.git"}
  :java-source-paths ["java"]
  :jvm-opts ["-Xmx3g"]
  :plugins [
         [lein-rpm "0.0.5"] [lein-midje "3.1.1"] [lein-marginalia "0.7.1"]
	       [lein-cloverage "1.0.2"]
         [lein-kibit "0.0.8"] [no-man-is-an-island/lein-eclipse "2.0.0"]
           ]
  :test-paths ["test" "test-java"]
  :dependencies [
                 [org.clojars.runa/conjure "2.1.3" :scope "test"]

                 [com.taoensso/carmine "2.7.0" :exclusions [org.clojure/clojure]]
                 [redis.clients/jedis "2.6.2"]
                 [org.redisson/redisson "1.2.1"]
                 [org.apache.commons/commons-pool2 "2.2"]
                 [com.alexkasko.unsafe/unsafe-tools "1.4.4"]

                 [org.mapdb/mapdb "1.0.6"]
                 [midje "1.6.3" :scope "test"]
                 [org.clojure/tools.trace "0.7.6"]
                 [org.xerial.snappy/snappy-java "1.1.1.6"]

                 [pjson "0.2.7"]
                 [net.jpountz.lz4/lz4 "1.3.0"]
                 [org.clojure/tools.logging "0.3.1"]
                 [clj-tcp "0.4.9"]
                 [fmap-clojure "LATEST" :exclusions [org.clojure/tools.logging]]
                 [fun-utils "0.5.8-SNAPSHOT" :exclusions [org.clojure/tools.logging]]
                 [clj-tuple "0.1.7"]
                 [thread-load "0.2.0-SNAPSHOT" :exclusions [org.clojure/clojure]]
                 [com.codahale.metrics/metrics-core "3.0.1"]
                 [metrics-clojure "2.5.1"]
                 [org.clojure/core.async "0.2.374"]
                 [com.stuartsierra/component "0.2.2"]

                 [org.openjdk.jol/jol-core "0.4"]

                 [org.clojure/clojure "1.6.0" :scope "provided"]
                 [org.apache.zookeeper/zookeeper "3.4.6" :scope "provided"
                  :exclusions [io.netty/netty]]
                 [org.apache.kafka/kafka_2.10 "0.8.1.1" :scope "provided"
                  :exclusions [io.netty/netty]]
                 [redis.embedded/embedded-redis "0.3" :scope "provided"]
                 ])

(defproject kafka-clj "3.6.4-SNAPSHOT"
  :description "fast kafka library implemented in clojure"
  :url "https://github.com/gerritjvv/kafka-fast"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}

  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]

  :global-vars {*warn-on-reflection* true
               *assert* true}

  ;:main kafka-clj.app
  :scm {:name "git"
         :url "https://github.com/gerritjvv/kafka-fast.git"}
  :java-source-paths ["java"]
  :jvm-opts ["-Xmx3g"]
  :plugins [
         [lein-rpm "0.0.5"] [lein-midje "3.1.1"] [lein-marginalia "0.7.1"]
	       [lein-cloverage "1.0.2"]
         [lein-kibit "0.0.8"] [no-man-is-an-island/lein-eclipse "2.0.0"]
           ]
  :test-paths ["test" "test-java"]
  :dependencies [
                 [org.clojars.runa/conjure "2.1.3" :scope "test"]

                 [com.taoensso/carmine "2.7.0" :exclusions [org.clojure/clojure]]
                 [redis.clients/jedis "2.6.2"]
                 [org.redisson/redisson "1.2.1"]
                 [org.apache.commons/commons-pool2 "2.2"]
                 [com.alexkasko.unsafe/unsafe-tools "1.4.4"]

                 [org.mapdb/mapdb "1.0.6"]
                 [midje "1.6.3" :scope "test"]
                 [org.clojure/tools.trace "0.7.6"]
                 [org.xerial.snappy/snappy-java "1.1.1.6"]

                 [pjson "0.2.7"]
                 [net.jpountz.lz4/lz4 "1.3.0"]
                 [org.clojure/tools.logging "0.3.1"]
                 [clj-tcp "0.4.9"]
                 ;[fmap-clojure "LATEST" :exclusions [org.clojure/tools.logging]]
                 [fun-utils "0.6.1" :exclusions [org.clojure/tools.logging]]
                 [clj-tuple "0.2.2"]
                 ;[thread-load "0.2.0-SNAPSHOT" :exclusions [org.clojure/clojure]]
                 [com.codahale.metrics/metrics-core "3.0.1"]
                 [metrics-clojure "2.5.1"]
                 [org.clojure/core.async "0.2.374"]
                 [com.stuartsierra/component "0.2.2"]

                 [org.openjdk.jol/jol-core "0.4"]

                 [org.clojure/clojure "1.8.0" :scope "provided"]
                 [org.apache.zookeeper/zookeeper "3.4.6" :scope "provided"
                  :exclusions [io.netty/netty]]
                 [org.apache.kafka/kafka_2.10 "0.8.1.1" :scope "provided"
                  :exclusions [io.netty/netty]]
                 [redis.embedded/embedded-redis "0.3" :scope "provided"]
                 ])

update library versions

update library versions


(ns babel.index
  (:refer-clojure :exclude [get-in resolve find parents])
  (:require
   ;; TODO: comment is misleading in that we never call core/get-in from this file.
   ;; TODO: alphabetize
   [clojure.string :as string]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [dag_unify.core :refer [fail? dissoc-paths get-in label-of
                           remove-top-values-log strip-refs
                           unifyc]]))

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

(def head-index {})
(def comp-index {})
(declare show-spec)

(declare spec-to-phrases)

;; TODO: remove: not used anymore.
;; TODO: diagnostic function that is too specific currently (e.g. refers to ':english').
(defn check-index [index]
  (if (not (= :top (get-in (first (:head (get index "nbar"))) [:english :agr :number])))
    (throw (exception (str "CHECK INDEX FAILED! " (get index "nbar"))))))

;; TODO: remove: not used anymore.
(defn build-lex-sch-index [phrases lexicon all-phrases]
  "Build a mapping of phrases onto subsets of the lexicon. The two values (subsets of the lexicon) to be
   generated for each key (phrase) are:
   1. the subset of the lexicon that can be the head of this phrase.
   2. the subset of the lexicon that can be the complement of this phrase.

   End result is a set of phrase => {:comp subset-of-lexicon
                                     :head subset-of-lexicon}."
  (log/debug (str "build-lex-sch-index: lexicon size: " (count lexicon)))
  (log/debug (str "build-lex-sch-index: grammar size: " (count all-phrases)))
  (if (not (empty? phrases))
    (conj
     {(get-in (first phrases) [:rule])
      {:comp
       (filter (fn [lex]
                 (not (fail? (unifyc (first phrases)
                                     {:comp lex}))))
               lexicon)

       :comp-phrases
       (filter (fn [comp-phrase]
                 (not (fail? (unifyc (first phrases)
                                     {:comp comp-phrase}))))
               all-phrases)

       :head-phrases
       (filter (fn [head-phrase]
                 (not (fail? (unifyc (first phrases)
                                     {:head head-phrase}))))
               all-phrases)

       :head
       (filter (fn [lex]
                 (log/debug (str "trying lexeme: " lex))
                 (not (fail? (unifyc (first phrases)
                                     {:head lex}))))
               lexicon)}}
     (build-lex-sch-index (rest phrases) lexicon all-phrases))))

(defn spec-to-phrases [specs all-phrases]
  (if (not (empty? specs))
    (let [spec (first specs)]
      (conj
       {spec
        (filter #(not (fail? %))
                (map (fn [each-phrase]
                       (unifyc each-phrase spec))
                     ;; TODO: possibly: remove-paths such as (subcat) from head: would make it easier to call with lexemes:
                     ;; e.g. "generate a sentence whose head is the word 'mangiare'" (i.e. user passes the lexical entry as
                     ;; head param of (lightning-bolt)".
                     all-phrases))}
       (spec-to-phrases (rest specs) all-phrases)))
    {}))

(defn get-parent-phrases-for-spec [index spec]
  (log/trace (str "Looking up spec: " (show-spec spec)))
  (let [result (get (get index :phrases-for-spec) (show-spec spec))
        result (if (nil? result) (list) result)]
    (if (empty? result)
      (log/trace (str "parent-phrases for spec: " (show-spec spec) " is empty.")))
    result))

(defn get-head-phrases-of [parent index]
  (if (= true (get-in parent [:head :phrasal] :true))
    (let [result (:head-phrases (get index (get-in parent [:rule])))
          result (if (nil? result) (list) result)
          label (label-of parent)]
      (if (empty? result)
        (log/warn (str "headed-phrases of parent: " label " is empty: " (get-in parent [:head]))))
      result)))

(defn get-comp-phrases-of [parent index]
  (let [result (:comp-phrases (get index (get-in parent [:rule])))
        result (if (nil? result) (list) result)]
    (if (empty? result)
      (log/trace (str "comp-phrases of parent: " (label-of parent) " is empty.")))
    result))

;; TODO: remove this: has already been removed in favor of (map-subset-by-path)
;; TODO: document how this works and especially what 'phrase-constraint' means.
(defn create-index [grammar lexicon phrase-constraint]
  (let [lexicon (if (map? lexicon)
                  (keys lexicon)
                  lexicon)]
    (log/info (str "create index with lexicon with size: " (count lexicon)))
    (conj (build-lex-sch-index grammar
                               (map (fn [lexeme]
                                      (log/debug (str "trying(ci) lexeme: " lexeme))
                                      (unifyc lexeme
                                              {:phrasal false}))
                                    lexicon)
                               grammar)
          {:phrase-constraints phrase-constraint
           :phrases-for-spec
           (spec-to-phrases
            ;; TODO: make this list derivable from the grammar and /or lexicon.
            (list {:synsem {}, :head {:synsem {}}, :phrasal true}
                  {:synsem {:cat :verb, :aux false}, :head {:synsem {:subcat {:2 {}, :1 {}}, :infl :present, :cat :verb, :sem {:tense :present}}, :phrasal false}, :phrasal true}
                  {:synsem {:cat :verb}, :head {:synsem {:cat :verb, :infl {:not :past}, :subcat {:2 {:cat :noun, :subcat (), :pronoun true}, :1 {}}}, :phrasal false}, :phrasal true}
                  {:synsem {:cat :verb, :aux false}, :head {:synsem {:cat :verb, :infl :infinitive, :subcat {:2 {}, :1 {}}}, :phrasal false}, :phrasal true}
                  )
            grammar)})))

(defn show-spec [spec]
  (cond (seq? spec)
        (map show-spec spec)
        true
        (remove-top-values-log (dissoc-paths spec '((:english :initial)
                                                    (:italiano :initial)
                                                    (:synsem :essere)
                                                    (:synsem :agr)
                                                    (:synsem :pronoun)
                                                    (:synsem :sem :tense)
                                                    (:synsem :sem :obj :tense)
                                                    (:synsem :sem :mod)
                                                    (:synsem :infl))))))

(defn map-subset-by-path2 [vals-at-path lexemes path]
  (if (not (empty? vals-at-path))
    (let [val (first vals-at-path)]
      (merge {val
              (filter (fn [lexeme]
                        (or (= :top (get-in lexeme path :top))
                            (= val
                               (get-in lexeme path))))
                      lexemes)}
             (map-subset-by-path2 (rest vals-at-path)
                                  lexemes
                                  path)))))

(defn map-subset-by-path [lexicon path]
  (map-subset-by-path2
   (vec (set (filter #(not (= :top %))
                     (map (fn [entry]
                            (get-in entry path :top))
                          (flatten (vals lexicon))))))
   (flatten (vals lexicon))
   path))

(defn create-indices [lexicon index-lexicon-on-paths]
  (into {}
        (map (fn [path]
               [path (map-subset-by-path lexicon path)])
             index-lexicon-on-paths)))

(defn intersection-with-identity [ & [set1 set2]]
  (if (> (count set1)
         (count set2))
    (filter (fn [member2]
              (some (fn [member1]
                      (identical? member1 member2))
                    set1))
            set2)
    (filter (fn [member1]
              (some (fn [member2]
                      (identical? member1 member2))
                    set2))
            set1)))

(defn lookup-spec [spec indices index-lexicon-on-paths]
  (log/debug (str "index-fn called with spec: "
                  (strip-refs
                   (dissoc (strip-refs spec)
                           :dag_unify.core/serialized))))
  (let [result
        (reduce intersection-with-identity
                (filter #(not (empty? %))
                        (map (fn [path]
                               (let [result
                                     (get (get indices path)
                                          (get-in spec path ::undefined)
                                          [])]
                                 (if (not (empty? result))
                                   (log/trace (str "subset for path:" path " => " (get-in spec path ::undefined)
                                                   " = " (count result)))
                                   (log/trace (str "empty result for path: " path "; spec=" (strip-refs spec))))
                                 result))
                             index-lexicon-on-paths)))]
    (log/debug (str "indexed size returned: " (count result) " for spec: " (strip-refs spec)))
    (if (and false (empty? result))
      (throw (Exception. (str "oops: " (strip-refs spec)))))

    result))

(ns babel.index
  (:refer-clojure :exclude [get-in resolve find parents])
  (:require
   ;; TODO: comment is misleading in that we never call core/get-in from this file.
   ;; TODO: alphabetize
   [clojure.string :as string]
   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [dag_unify.core :refer [fail? dissoc-paths get-in label-of
                           strip-refs unify]]))

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

(def head-index {})
(def comp-index {})
(declare show-spec)

(declare spec-to-phrases)

;; TODO: remove: not used anymore.
;; TODO: diagnostic function that is too specific currently (e.g. refers to ':english').
(defn check-index [index]
  (if (not (= :top (get-in (first (:head (get index "nbar"))) [:english :agr :number])))
    (throw (exception (str "CHECK INDEX FAILED! " (get index "nbar"))))))

;; TODO: remove: not used anymore.
(defn build-lex-sch-index [phrases lexicon all-phrases]
  "Build a mapping of phrases onto subsets of the lexicon. The two values (subsets of the lexicon) to be
   generated for each key (phrase) are:
   1. the subset of the lexicon that can be the head of this phrase.
   2. the subset of the lexicon that can be the complement of this phrase.

   End result is a set of phrase => {:comp subset-of-lexicon
                                     :head subset-of-lexicon}."
  (log/debug (str "build-lex-sch-index: lexicon size: " (count lexicon)))
  (log/debug (str "build-lex-sch-index: grammar size: " (count all-phrases)))
  (if (not (empty? phrases))
    (conj
     {(get-in (first phrases) [:rule])
      {:comp
       (filter (fn [lex]
                 (not (fail? (unify (first phrases)
                                     {:comp lex}))))
               lexicon)

       :comp-phrases
       (filter (fn [comp-phrase]
                 (not (fail? (unify (first phrases)
                                     {:comp comp-phrase}))))
               all-phrases)

       :head-phrases
       (filter (fn [head-phrase]
                 (not (fail? (unify (first phrases)
                                     {:head head-phrase}))))
               all-phrases)

       :head
       (filter (fn [lex]
                 (log/debug (str "trying lexeme: " lex))
                 (not (fail? (unify (first phrases)
                                     {:head lex}))))
               lexicon)}}
     (build-lex-sch-index (rest phrases) lexicon all-phrases))))

(defn spec-to-phrases [specs all-phrases]
  (if (not (empty? specs))
    (let [spec (first specs)]
      (conj
       {spec
        (filter #(not (fail? %))
                (map (fn [each-phrase]
                       (unify each-phrase spec))
                     ;; TODO: possibly: remove-paths such as (subcat) from head: would make it easier to call with lexemes:
                     ;; e.g. "generate a sentence whose head is the word 'mangiare'" (i.e. user passes the lexical entry as
                     ;; head param of (lightning-bolt)".
                     all-phrases))}
       (spec-to-phrases (rest specs) all-phrases)))
    {}))

(defn get-parent-phrases-for-spec [index spec]
  (log/trace (str "Looking up spec: " (show-spec spec)))
  (let [result (get (get index :phrases-for-spec) (show-spec spec))
        result (if (nil? result) (list) result)]
    (if (empty? result)
      (log/trace (str "parent-phrases for spec: " (show-spec spec) " is empty.")))
    result))

(defn get-head-phrases-of [parent index]
  (if (= true (get-in parent [:head :phrasal] :true))
    (let [result (:head-phrases (get index (get-in parent [:rule])))
          result (if (nil? result) (list) result)
          label (label-of parent)]
      (if (empty? result)
        (log/warn (str "headed-phrases of parent: " label " is empty: " (get-in parent [:head]))))
      result)))

(defn get-comp-phrases-of [parent index]
  (let [result (:comp-phrases (get index (get-in parent [:rule])))
        result (if (nil? result) (list) result)]
    (if (empty? result)
      (log/trace (str "comp-phrases of parent: " (label-of parent) " is empty.")))
    result))

;; TODO: remove this: has already been removed in favor of (map-subset-by-path)
;; TODO: document how this works and especially what 'phrase-constraint' means.
(defn create-index [grammar lexicon phrase-constraint]
  (let [lexicon (if (map? lexicon)
                  (keys lexicon)
                  lexicon)]
    (log/info (str "create index with lexicon with size: " (count lexicon)))
    (conj (build-lex-sch-index grammar
                               (map (fn [lexeme]
                                      (log/debug (str "trying(ci) lexeme: " lexeme))
                                      (unify lexeme
                                              {:phrasal false}))
                                    lexicon)
                               grammar)
          {:phrase-constraints phrase-constraint
           :phrases-for-spec
           (spec-to-phrases
            ;; TODO: make this list derivable from the grammar and /or lexicon.
            (list {:synsem {}, :head {:synsem {}}, :phrasal true}
                  {:synsem {:cat :verb, :aux false}, :head {:synsem {:subcat {:2 {}, :1 {}}, :infl :present, :cat :verb, :sem {:tense :present}}, :phrasal false}, :phrasal true}
                  {:synsem {:cat :verb}, :head {:synsem {:cat :verb, :infl {:not :past}, :subcat {:2 {:cat :noun, :subcat (), :pronoun true}, :1 {}}}, :phrasal false}, :phrasal true}
                  {:synsem {:cat :verb, :aux false}, :head {:synsem {:cat :verb, :infl :infinitive, :subcat {:2 {}, :1 {}}}, :phrasal false}, :phrasal true}
                  )
            grammar)})))

(defn show-spec [spec]
  (cond (seq? spec)
        (map show-spec spec)
        true
        (strip-refs (dissoc-paths spec '((:english :initial)
                                         (:italiano :initial)
                                         (:synsem :essere)
                                         (:synsem :agr)
                                         (:synsem :pronoun)
                                         (:synsem :sem :tense)
                                         (:synsem :sem :obj :tense)
                                         (:synsem :sem :mod)
                                         (:synsem :infl))))))

(defn map-subset-by-path2 [vals-at-path lexemes path]
  (if (not (empty? vals-at-path))
    (let [val (first vals-at-path)]
      (merge {val
              (filter (fn [lexeme]
                        (or (= :top (get-in lexeme path :top))
                            (= val
                               (get-in lexeme path))))
                      lexemes)}
             (map-subset-by-path2 (rest vals-at-path)
                                  lexemes
                                  path)))))

(defn map-subset-by-path [lexicon path]
  (map-subset-by-path2
   (vec (set (filter #(not (= :top %))
                     (map (fn [entry]
                            (get-in entry path :top))
                          (flatten (vals lexicon))))))
   (flatten (vals lexicon))
   path))

(defn create-indices [lexicon index-lexicon-on-paths]
  (into {}
        (map (fn [path]
               [path (map-subset-by-path lexicon path)])
             index-lexicon-on-paths)))

(defn intersection-with-identity [ & [set1 set2]]
  (if (> (count set1)
         (count set2))
    (filter (fn [member2]
              (some (fn [member1]
                      (identical? member1 member2))
                    set1))
            set2)
    (filter (fn [member1]
              (some (fn [member2]
                      (identical? member1 member2))
                    set2))
            set1)))

(defn lookup-spec [spec indices index-lexicon-on-paths]
  (log/debug (str "index-fn called with spec: "
                  (strip-refs
                   (dissoc (strip-refs spec)
                           :dag_unify.core/serialized))))
  (let [result
        (reduce intersection-with-identity
                (filter #(not (empty? %))
                        (map (fn [path]
                               (let [result
                                     (get (get indices path)
                                          (get-in spec path ::undefined)
                                          [])]
                                 (if (not (empty? result))
                                   (log/trace (str "subset for path:" path " => " (get-in spec path ::undefined)
                                                   " = " (count result)))
                                   (log/trace (str "empty result for path: " path "; spec=" (strip-refs spec))))
                                 result))
                             index-lexicon-on-paths)))]
    (log/debug (str "indexed size returned: " (count result) " for spec: " (strip-refs spec)))
    (if (and false (empty? result))
      (throw (Exception. (str "oops: " (strip-refs spec)))))

    result))

fix breakage from dag_unify upgrade to latest release 1.5.1