(ns kixi.hecuba.api.profiles
  (:require
   [bidi.bidi :as bidi]
   [cheshire.core :as json]
   [clojure.tools.logging :as log]
   [kixi.hecuba.protocols :as hecuba]
   [kixi.hecuba.security :as sec]
   [kixi.hecuba.webutil :as util]
   [kixi.hecuba.webutil :refer (decode-body authorized? stringify-values update-stringified-lists sha1-regex)]
   [liberator.core :refer (defresource)]
   [liberator.representation :refer (ring-response)]))

(defn index-exists? [querier ctx]
  (let [request       (:request ctx)
        method        (:request-method request)
        route-params  (:route-params request)
        entity-id     (:entity-id route-params)
        entity        (hecuba/item querier :entity entity-id)]
    (case method
      :post (not (nil? entity))
      :get (let [items (hecuba/items querier :profile [[= :entity-id entity-id]])]
             {::items items}))))

(defn index-malformed? [ctx]
  (let [request (:request ctx)
        {:keys [route-params request-method]} request
        entity-id (:entity-id route-params)]
    (case request-method
      :post (let [body (decode-body request)]
              ;; We need to assert a few things
              (if
                (or
                  (not= (:entity-id body) entity-id))
                true                  ; it's malformed, game over
                [false {:body body}]  ; it's not malformed, return the body now we've read it
                ))
      false)))

(defn index-post! [querier commander ctx]
  (let [{:keys [request body]} ctx
        entity-id     (-> request :route-params :entity-id)
        [username _]  (sec/get-username-password request querier)
        user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)]

    (when-not (empty? (first (hecuba/items querier :entity [[= :id entity-id]])))
      (let [profile   (-> body
                          (assoc :user-id user-id)
                          (update-in [:profile-data] json/encode)
                          ;; here goes the list of "stuff" associated with profiles
                          (update-stringified-lists [:airflow_measurements
                                                    :chps :conservatories
                                                    :door_sets
                                                    :extensions
                                                    :floors
                                                    :heat_pumps
                                                    :heating_systems
                                                    :hot_water_systems
                                                    :low_energy_lights
                                                    :photovoltaics
                                                    :roof_rooms
                                                    :roofs
                                                    :small_hydros
                                                    :solar_thermals
                                                    :storeys
                                                    :thermal-images
                                                    :walls
                                                    :wind_turbines
                                                    :window_sets]))
            profile-id (hecuba/upsert! commander :profile profile)]
        {:profile-id profile-id}))))

(defn index-handle-ok [ctx]
  (let [{items ::items
         {mime :media-type} :representation
         {routes :modular.bidi/routes
          route-params :route-params} :request} ctx]
    (util/render-items ctx (->> items
                                (map #(dissoc % :user-id))
                                (map #(update-in % [:thermal-images] json/decode))
                                (map #(update-in % [:storeys] json/decode))
                                (map #(update-in % [:walls] json/decode))
                                (map #(update-in % [:roofs] json/decode))
                                (map util/downcast-to-json)
                                (map util/camelify)
                                json/encode))))

(defn index-handle-created [handlers ctx]
  (let [{{routes :modular.bidi/routes {entity-id :entity-id} :route-params} :request
         profile-id :profile-id} ctx]
    (if-not (empty? profile-id)
      (let [location
            (bidi/path-for routes (:profile @handlers)
                           :entity-id entity-id
                           :profile-id profile-id)]
        (when-not location
          (throw (ex-info "No path resolved for Location header"
                          {:entity-id entity-id
                           :profile-id profile-id})))
        (ring-response {:headers {"Location" location}
                        :body (json/encode {:location location
                                            :status "OK"
                                            :version "4"})}))
      (ring-response {:status 422
                      :body "Provide valid projectId and propertyCode."}))))

(defn resource-exists? [querier ctx]
  (let [{{{:keys [entity-id profile-id]} :route-params} :request} ctx
        item (hecuba/item querier :profile profile-id)]
    (if-not (empty? item)
      {::item (-> item
                  (assoc :profile-id profile-id)
                  (dissoc :id))}
      false)))

(defn resource-delete-enacted? [commander ctx]
  (let [{item ::item} ctx
        device-id (:device-id item)
        entity-id (:entity-id item)
        response1 (hecuba/delete! commander :device [[= :id device-id]])
        response2 (hecuba/delete! commander :sensor [[= :device-id device-id]])
        response3 (hecuba/delete! commander :sensor-metadata [[= :device-id device-id]])
        response4 (hecuba/delete! commander :entity {:devices device-id} [[= :id entity-id]])]
    (every? empty? [response1 response2 response3 response4])))

(defn resource-put! [commander querier ctx]
  (let [{request :request} ctx]
    (if-let [item (::item ctx)]
      (let [body          (decode-body request)
            entity-id     (-> item :entity-id)
            [username _]  (sec/get-username-password request querier)
            user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)
            profile-id     (-> item :profile-id)]
        (hecuba/upsert! commander :profile (-> body
                                               (assoc :id profile-id)
                                               (assoc :user-id user-id)
                                               ;; TODO: add storeys, walls, etc.
                                               stringify-values)))
      (ring-response {:status 404 :body "Please provide valid entityId and timestamp"}))))

(defn resource-handle-ok [querier ctx]
  (let [{item ::item} ctx]
    (-> item
        (dissoc :user-id)
        ;; TODO add storeys, walls, etc.
        util/downcast-to-json
        util/camelify
        json/encode)))

(defn resource-respond-with-entity [ctx]
  (let [request (:request ctx)
        method  (:request-method request)]
    (cond
     (= method :delete) false
      :else true)))

(defresource index [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :post}
  :available-media-types #{"application/json"}
  :known-content-type? #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial index-exists? querier)
  :malformed? index-malformed?
  :post! (partial index-post! querier commander)
  :handle-ok (partial index-handle-ok)
  :handle-created (partial index-handle-created handlers))

(defresource resource [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :delete :putj}
  :available-media-types #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial resource-exists? querier)
  :delete-enacted? (partial resource-delete-enacted? commander)
  :respond-with-entity? (partial resource-respond-with-entity)
  :new? (constantly false)
  :can-put-to-missing? (constantly false)
  :put! (partial resource-put! commander querier)
  :handle-ok (partial resource-handle-ok querier))

(ns kixi.hecuba.api.profiles
  (:require
   [bidi.bidi :as bidi]
   [cheshire.core :as json]
   [clojure.tools.logging :as log]
   [kixi.hecuba.protocols :as hecuba]
   [kixi.hecuba.security :as sec]
   [kixi.hecuba.webutil :as util]
   [kixi.hecuba.webutil :refer (decode-body authorized? stringify-values update-stringified-lists sha1-regex)]
   [liberator.core :refer (defresource)]
   [liberator.representation :refer (ring-response)]))

(defn index-exists? [querier ctx]
  (let [request       (:request ctx)
        method        (:request-method request)
        route-params  (:route-params request)
        entity-id     (:entity-id route-params)
        entity        (hecuba/item querier :entity entity-id)]
    (case method
      :post (not (nil? entity))
      :get (let [items (hecuba/items querier :profile [[= :entity-id entity-id]])]
             {::items items}))))

(defn index-malformed? [ctx]
  (let [request (:request ctx)
        {:keys [route-params request-method]} request
        entity-id (:entity-id route-params)]
    (case request-method
      :post (let [body (decode-body request)]
              ;; We need to assert a few things
              (if
                (or
                  (not= (:entity-id body) entity-id))
                true                  ; it's malformed, game over
                [false {:body body}]  ; it's not malformed, return the body now we've read it
                ))
      false)))

(defn index-post! [commander querier ctx]
  (let [request       (-> ctx :request)
        profile       (-> ctx :body)
        entity-id     (-> profile :entity-id)
        timestamp     (-> profile :timestamp)
        [username _]  (sec/get-username-password request querier)
        user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)
        ]
    (when (and entity-id timestamp)
      (when-not (empty? (hecuba/item querier :entity entity-id))
        {:profile-id (hecuba/upsert!
                        commander
                        :profile (-> profile
                                     (assoc :user-id user-id)
                                     (update-stringified-lists
                                       [:airflow-measurements :chps
                                        :conservatories :door-sets
                                        :extensions :floors :heat-pumps
                                        :heating-systems :hot-water-systems
                                        :low-energy-lights :photovoltaics
                                        :roof-rooms :roofs :small-hydros
                                        :solar-thermals :storeys :thermal-images
                                        :walls :wind-turbines :window-sets])
                                     (update-in [:profile-data] json/encode)
                                     ))}))))

(defn index-handle-ok [ctx]
  (let [{items ::items
         {mime :media-type} :representation
         {routes :modular.bidi/routes
          route-params :route-params} :request} ctx]
    (util/render-items ctx (->> items
                                (map #(dissoc % :user-id))
                                (map #(update-in % [:thermal-images] json/decode))
                                (map #(update-in % [:storeys] json/decode))
                                (map #(update-in % [:walls] json/decode))
                                (map #(update-in % [:roofs] json/decode))
                                (map util/downcast-to-json)
                                (map util/camelify)
                                json/encode))))

(defn index-handle-created [handlers ctx]
  (let [{{routes :modular.bidi/routes {entity-id :entity-id} :route-params} :request
         profile-id :profile-id} ctx]
    (if-not (empty? profile-id)
      (let [location
            (bidi/path-for routes (:profile @handlers)
                           :entity-id entity-id
                           :profile-id profile-id)]
        (when-not location
          (throw (ex-info "No path resolved for Location header"
                          {:entity-id entity-id
                           :profile-id profile-id})))
        (ring-response {:headers {"Location" location}
                        :body (json/encode {:location location
                                            :status "OK"
                                            :version "4"})}))
      (ring-response {:status 422
                      :body "Provide valid entityId and timestamp."}))))

(defn resource-exists? [querier ctx]
  (let [{{{:keys [entity-id profile-id]} :route-params} :request} ctx
        item (hecuba/item querier :profile profile-id)]
    (if-not (empty? item)
      {::item (-> item
                  (assoc :profile-id profile-id)
                  (dissoc :id))}
      false)))

(defn resource-delete-enacted? [commander ctx]
  (let [{item ::item} ctx
        device-id (:device-id item)
        entity-id (:entity-id item)
        response1 (hecuba/delete! commander :device [[= :id device-id]])
        response2 (hecuba/delete! commander :sensor [[= :device-id device-id]])
        response3 (hecuba/delete! commander :sensor-metadata [[= :device-id device-id]])
        response4 (hecuba/delete! commander :entity {:devices device-id} [[= :id entity-id]])]
    (every? empty? [response1 response2 response3 response4])))

(defn resource-put! [commander querier ctx]
  (let [{request :request} ctx]
    (if-let [item (::item ctx)]
      (let [body          (decode-body request)
            entity-id     (-> item :entity-id)
            [username _]  (sec/get-username-password request querier)
            user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)
            profile-id     (-> item :profile-id)]
        (hecuba/upsert! commander :profile (-> body
                                               (assoc :id profile-id)
                                               (assoc :user-id user-id)
                                               ;; TODO: add storeys, walls, etc.
                                               stringify-values)))
      (ring-response {:status 404 :body "Please provide valid entityId and timestamp"}))))

(defn resource-handle-ok [querier ctx]
  (let [{item ::item} ctx]
    (-> item
        (dissoc :user-id)
        ;; TODO add storeys, walls, etc.
        util/downcast-to-json
        util/camelify
        json/encode)))

(defn resource-respond-with-entity [ctx]
  (let [request (:request ctx)
        method  (:request-method request)]
    (cond
     (= method :delete) false
      :else true)))

(defresource index [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :post}
  :available-media-types #{"application/json"}
  :known-content-type? #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial index-exists? querier)
  :malformed? index-malformed?
  :post! (partial index-post! commander querier)
  :handle-ok (partial index-handle-ok)
  :handle-created (partial index-handle-created handlers))

(defresource resource [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :delete :putj}
  :available-media-types #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial resource-exists? querier)
  :delete-enacted? (partial resource-delete-enacted? commander)
  :respond-with-entity? (partial resource-respond-with-entity)
  :new? (constantly false)
  :can-put-to-missing? (constantly false)
  :put! (partial resource-put! commander querier)
  :handle-ok (partial resource-handle-ok querier))

fix update-stringified-lists invocation

fix update-stringified-lists invocation

bru writes 100 times on the blackboard: _always use kebab-case keywords
when in clojure context_


(ns cruncher.config)

(def api {:host "http://localhost:5000/"
          :init "api/init/"
          :base "api/"
          :login "api/login"
          :get-all-pokemon "api/pokemon"
          :toggle-favorite "api/pokemon/favorite"
          :crunch-selected-pokemon "api/pokemon/delete"
          :status-delete "api/status/delete"
          :get-player "api/player"})

(ns cruncher.config)

(def api {:host "http://localhost:5000/"
          :init "api/init/"
          :base "api/"
          :login "api/login"
          :get-all-pokemon "api/pokemon"
          :toggle-favorite "api/pokemon/favorite"
          :crunch-selected-pokemon "api/pokemon/delete"
          :status-delete "api/status/delete"
          :get-player "api/player"
          :api-status "api/status/niantic"})

Add route to ping niantic server

Add route to ping niantic server


;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns futura.stream.channel
  (:require [futura.atomic :as atomic]
            [futura.stream.common :as common]
            [clojure.core.async :as async]
            [clojure.core.async.impl.protocols :as asyncp])
  (:import clojure.lang.Seqable
           org.reactivestreams.Subscriber
           futura.stream.common.IPullStream
           java.lang.AutoCloseable
           java.util.Set
           java.util.HashSet
           java.util.Queue
           java.util.Collections
           java.util.concurrent.ForkJoinPool
           java.util.concurrent.Executor
           java.util.concurrent.Executors
           java.util.concurrent.CountDownLatch
           java.util.concurrent.ConcurrentLinkedQueue))

(declare signal-cancel)
(declare signal-request)
(declare signal-subscribe)
(declare subscribe)
(declare schedule)
(declare handle-subscribe)
(declare handle-request)
(declare handle-send)
(declare handle-cancel)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deftype Subscription [canceled active demand queue publisher subscriber]
  org.reactivestreams.Subscription
  (^void cancel [this]
    (signal-cancel this))

  (^void request [this ^long n]
    (signal-request this n))

  Runnable
  (^void run [this]
    (try
      (let [signal (.poll ^Queue queue)]
        (when (not @canceled)
          (case (:type signal)
            ::request (handle-request this (:number signal))
            ::send (handle-send this)
            ::cancel (handle-cancel this)
            ::subscribe (handle-subscribe this))))
      (finally
        (atomic/set! active false)
        (when-not (.isEmpty ^Queue queue)
          (schedule this))))))

(declare terminate)

(deftype Publisher [source subscriptions options]
  clojure.lang.Seqable
  (seq [p]
    (seq (common/subscribe p)))

  org.reactivestreams.Publisher
  (^void subscribe [this ^Subscriber subscriber]
    (let [sub (Subscription.
               (atomic/boolean false)
               (atomic/boolean false)
               (atomic/long 0)
               (ConcurrentLinkedQueue.)
               this
               subscriber)]
      (.add ^Set subscriptions sub)
      (try
        (.onSubscribe subscriber sub)
        (catch Throwable t
          (terminate sub (IllegalStateException. "Violated the Reactive Streams rule 2.13"))))
      ;; Temporary avoid async subscription because
      ;; Ratpack has a bug with them: https://github.com/ratpack/ratpack/issues/682
      ;; (signal-subscribe sub)
      sub)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- terminate
  "Mark a subscrition as terminated
  with provided exception."
  [^Subscription sub e]
  (let [^Subscriber subscriber (.-subscriber sub)]
    (handle-cancel sub)
    (try
      (.onError subscriber e)
      (catch Throwable t
        (IllegalStateException. "Violated the Reactive Streams rule 2.13")))))

(defn- schedule
  "Schedule the subscrption to be executed
  in builtin scheduler executor."
  [^Subscription sub]
  (let [active (.-active sub)
        canceled (.-canceled sub)
        queue (.-queue sub)]
    (when (atomic/compare-and-set! active false true)
      (try
        (.execute ^Executor common/*executor* ^Runnable sub)
        (catch Throwable t
          (when (not @canceled)
            (atomic/set! canceled true)
            (try
              (terminate sub (IllegalStateException. "Unavailable executor."))
              (finally
                (.clear ^Queue queue)
                (atomic/set! active false)))))))))

(defn- signal
  "Notify the subscription about specific event."
  [sub m]
  (let [^Queue queue (.-queue sub)]
    (when (.offer queue m)
      (schedule sub))))

(defn- signal-request
  "Signal the request event."
  [sub n]
  (signal sub {:type ::request :number n}))

(defn- signal-send
  "Signal the send event."
  [sub]
  (signal sub {:type ::send}))

(defn- signal-subscribe
  "Signal the subscribe event."
  [sub]
  (signal sub {:type ::subscribe}))

(defn- signal-cancel
  "Signal the cancel event."
  [sub]
  (signal sub {:type ::cancel}))

(defn- handle-request
  "A generic implementation for request events
  handling for any type of subscriptions."
  [^Subscription sub n]
  (let [demand (.-demand sub)]
    (cond
      (< n 1)
      (terminate sub (IllegalStateException. "violated the Reactive Streams rule 3.9"))

      (< (+ @demand n) 1)
      (do
        (atomic/set! demand Long/MAX_VALUE)
        (handle-send sub))

      :else
      (do
        (atomic/get-and-add! demand n)
        (handle-send sub)))))

(defn- handle-cancel
  [^Subscription sub]
  (let [^Publisher publisher (.-publisher sub)
        ^Set subscriptions (.-subscriptions publisher)
        canceled (.-canceled sub)
        options (.-options publisher)
        source (.-source publisher)]
    (when (not @canceled)
      (atomic/set! canceled true)
      (.remove subscriptions sub)
      (when (:close options)
        (async/close! source)))))

(defn- handle-subscribe
  [^Subscription sub]
  (let [^Publisher publisher (.-publisher sub)
        ^Subscriber subscriber (.-subscriber sub)
        source (.-source publisher)
        canceled (.-canceled sub)]
    (try
      (.onSubscribe subscriber sub)
      (catch Throwable t
        (terminate sub (IllegalStateException. "Violated the Reactive Streams rule 2.13"))))
    (when (asyncp/closed? source)
      (try
        (handle-cancel sub)
        (.onComplete subscriber)
        (catch Throwable t
          ;; (IllegalStateException. "Violated the Reactive Streams rule 2.13")
          )))))

(defn- handle-send
  [sub]
  (let [^Publisher publisher (.-publisher sub)
        ^Subscriber subscriber (.-subscriber sub)
        source (.-source publisher)
        canceled (.-canceled sub)]
    (async/take! source (fn [value]
                          (try
                            (if (nil? value)
                              (do
                                (handle-cancel sub)
                                (.onComplete subscriber))
                              (let [demand (atomic/dec-and-get! (.-demand sub))]
                                (.onNext subscriber value)
                                (when (and (not @canceled) (pos? demand))
                                  (signal-send sub))))
                            (catch Throwable t
                              (handle-cancel sub)))))))

(defn publisher
  "A publisher constructor with core.async
  channel as its source. The returned publisher
  instance is of unicast type."
  ([source] (publisher source {}))
  ([source options]
  (let [subscriptions (Collections/synchronizedSet (HashSet.))]
    (Publisher. source subscriptions options))))

;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns futura.stream.channel
  (:require [futura.atomic :as atomic]
            [futura.stream.common :as common]
            [clojure.core.async :as async]
            [clojure.core.async.impl.protocols :as asyncp])
  (:import clojure.lang.Seqable
           org.reactivestreams.Subscriber
           futura.stream.common.IPullStream
           java.lang.AutoCloseable
           java.util.Set
           java.util.HashSet
           java.util.Queue
           java.util.Collections
           java.util.concurrent.ForkJoinPool
           java.util.concurrent.Executor
           java.util.concurrent.Executors
           java.util.concurrent.CountDownLatch
           java.util.concurrent.ConcurrentLinkedQueue))

(declare signal-cancel)
(declare signal-request)
(declare signal-subscribe)
(declare subscribe)
(declare schedule)
(declare handle-subscribe)
(declare handle-request)
(declare handle-send)
(declare handle-cancel)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deftype Subscription [canceled active demand queue publisher subscriber]
  org.reactivestreams.Subscription
  (^void cancel [this]
    (signal-cancel this))

  (^void request [this ^long n]
    (signal-request this n))

  Runnable
  (^void run [this]
    (try
      (let [signal (.poll ^Queue queue)]
        (when (not @canceled)
          (case (:type signal)
            ::request (handle-request this (:number signal))
            ::send (handle-send this)
            ::cancel (handle-cancel this)
            ::subscribe (handle-subscribe this))))
      (finally
        (atomic/set! active false)
        (when-not (.isEmpty ^Queue queue)
          (schedule this))))))

(declare terminate)

(deftype Publisher [source subscriptions options]
  clojure.lang.Seqable
  (seq [p]
    (seq (common/subscribe p)))

  org.reactivestreams.Publisher
  (^void subscribe [this ^Subscriber subscriber]
    (let [sub (Subscription.
               (atomic/boolean false)
               (atomic/boolean false)
               (atomic/long 0)
               (ConcurrentLinkedQueue.)
               this
               subscriber)]
      (.add ^Set subscriptions sub)
      ;; (try
      ;;   (.onSubscribe subscriber sub)
      ;;   (catch Throwable t
      ;;     (terminate sub (IllegalStateException. "Violated the Reactive Streams rule 2.13"))))
      (signal-subscribe sub)
      sub)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- terminate
  "Mark a subscrition as terminated
  with provided exception."
  [^Subscription sub e]
  (let [^Subscriber subscriber (.-subscriber sub)]
    (handle-cancel sub)
    (try
      (.onError subscriber e)
      (catch Throwable t
        (IllegalStateException. "Violated the Reactive Streams rule 2.13")))))

(defn- schedule
  "Schedule the subscrption to be executed
  in builtin scheduler executor."
  [^Subscription sub]
  (let [active (.-active sub)
        canceled (.-canceled sub)
        queue (.-queue sub)]
    (when (atomic/compare-and-set! active false true)
      (try
        (.execute ^Executor common/*executor* ^Runnable sub)
        (catch Throwable t
          (when (not @canceled)
            (atomic/set! canceled true)
            (try
              (terminate sub (IllegalStateException. "Unavailable executor."))
              (finally
                (.clear ^Queue queue)
                (atomic/set! active false)))))))))

(defn- signal
  "Notify the subscription about specific event."
  [sub m]
  (let [^Queue queue (.-queue sub)]
    (when (.offer queue m)
      (schedule sub))))

(defn- signal-request
  "Signal the request event."
  [sub n]
  (signal sub {:type ::request :number n}))

(defn- signal-send
  "Signal the send event."
  [sub]
  (signal sub {:type ::send}))

(defn- signal-subscribe
  "Signal the subscribe event."
  [sub]
  (signal sub {:type ::subscribe}))

(defn- signal-cancel
  "Signal the cancel event."
  [sub]
  (signal sub {:type ::cancel}))

(defn- handle-request
  "A generic implementation for request events
  handling for any type of subscriptions."
  [^Subscription sub n]
  (let [demand (.-demand sub)]
    (cond
      (< n 1)
      (terminate sub (IllegalStateException. "violated the Reactive Streams rule 3.9"))

      (< (+ @demand n) 1)
      (do
        (atomic/set! demand Long/MAX_VALUE)
        (handle-send sub))

      :else
      (do
        (atomic/get-and-add! demand n)
        (handle-send sub)))))

(defn- handle-cancel
  [^Subscription sub]
  (let [^Publisher publisher (.-publisher sub)
        ^Set subscriptions (.-subscriptions publisher)
        canceled (.-canceled sub)
        options (.-options publisher)
        source (.-source publisher)]
    (when (not @canceled)
      (atomic/set! canceled true)
      (.remove subscriptions sub)
      (when (:close options)
        (async/close! source)))))

(defn- handle-subscribe
  [^Subscription sub]
  (let [^Publisher publisher (.-publisher sub)
        ^Subscriber subscriber (.-subscriber sub)
        source (.-source publisher)
        canceled (.-canceled sub)]
    (try
      (.onSubscribe subscriber sub)
      (catch Throwable t
        (terminate sub (IllegalStateException. "Violated the Reactive Streams rule 2.13"))))
    (when (asyncp/closed? source)
      (try
        (handle-cancel sub)
        (.onComplete subscriber)
        (catch Throwable t
          ;; (IllegalStateException. "Violated the Reactive Streams rule 2.13")
          )))))

(defn- handle-send
  [sub]
  (let [^Publisher publisher (.-publisher sub)
        ^Subscriber subscriber (.-subscriber sub)
        source (.-source publisher)
        canceled (.-canceled sub)]
    (async/take! source (fn [value]
                          (try
                            (if (nil? value)
                              (do
                                (handle-cancel sub)
                                (.onComplete subscriber))
                              (let [demand (atomic/dec-and-get! (.-demand sub))]
                                (.onNext subscriber value)
                                (when (and (not @canceled) (pos? demand))
                                  (signal-send sub))))
                            (catch Throwable t
                              (handle-cancel sub)))))))

(defn publisher
  "A publisher constructor with core.async
  channel as its source. The returned publisher
  instance is of unicast type."
  ([source] (publisher source {}))
  ([source options]
  (let [subscriptions (Collections/synchronizedSet (HashSet.))]
    (Publisher. source subscriptions options))))

Enable async subscription.

Enable async subscription.


(ns github-changelog.fs
  (:require [clojure.java.io :as io])
  (:import java.io.File
           [java.nio.file Files FileVisitResult Path SimpleFileVisitor]
           java.nio.file.attribute.FileAttribute))

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

(def empty-file-attrs (into-array FileAttribute []))

(defn tmp []
  (System/getProperty "java.io.tmpdir"))

(defn- as-path ^Path [^String str]
  (.toPath (File. str)))

(defn as-file
  (^File [f] (io/as-file f))
  (^File [^String parent ^String child] (File. parent child)))

(defn basename
  "Returns the filename or the directory portion of the pathname"
  ^String [^String f]
  (.toString (.getFileName (as-path f))))

(defn tmp-file
  "Creates a temporary file"
  ([] (tmp-file nil))
  ([dir] (tmp-file dir nil))
  ([dir prefix] (tmp-file dir prefix nil))
  ([dir ^String prefix ^String suffix]
   (.toString (Files/createTempFile (as-path (or dir (tmp))) prefix suffix empty-file-attrs))))

(defn tmp-dir
  "Creates a temporary directory"
  ([] (tmp-dir nil))
  ([dir] (tmp-dir dir nil))
  ([dir prefix]
   (.toString (Files/createTempDirectory (as-path (or dir (tmp))) prefix empty-file-attrs))))

(defn exists? [file]
  (.exists (as-file file)))

(defn file? [file]
  (.isFile (as-file file)))

(defn dir? [file]
  (.isDirectory (as-file file)))

(def recursive-delete
  (proxy [SimpleFileVisitor] []
    (visitFile [path _attrs]
      (Files/delete path)
      FileVisitResult/CONTINUE)
    (postVisitDirectory [path _exc]
      (Files/delete path)
      FileVisitResult/CONTINUE)))

(defn rm
  "Deletes file"
  [file]
  (.delete (as-file file)))

(defn rm-dir
  "Deletes directory recursively"
  [dir]
  (Files/walkFileTree (as-path dir) recursive-delete))

(ns github-changelog.fs
  (:require [clojure.java.io :as io])
  (:import java.io.File
           [java.nio.file Files FileVisitResult Path SimpleFileVisitor]
           java.nio.file.attribute.FileAttribute))

(def empty-file-attrs (into-array FileAttribute []))

(defn tmp []
  (System/getProperty "java.io.tmpdir"))

(defn- as-path ^Path [^String str]
  (.toPath (File. str)))

(defn as-file
  (^File [f] (io/as-file f))
  (^File [^String parent ^String child] (File. parent child)))

(defn basename
  "Returns the filename or the directory portion of the pathname"
  ^String [^String f]
  (.toString (.getFileName (as-path f))))

(defn tmp-file
  "Creates a temporary file"
  ([] (tmp-file nil))
  ([dir] (tmp-file dir nil))
  ([dir prefix] (tmp-file dir prefix nil))
  ([dir ^String prefix ^String suffix]
   (.toString (Files/createTempFile (as-path (or dir (tmp))) prefix suffix empty-file-attrs))))

(defn tmp-dir
  "Creates a temporary directory"
  ([] (tmp-dir nil))
  ([dir] (tmp-dir dir nil))
  ([dir prefix]
   (.toString (Files/createTempDirectory (as-path (or dir (tmp))) prefix empty-file-attrs))))

(defn exists? [file]
  (.exists (as-file file)))

(defn file? [file]
  (.isFile (as-file file)))

(defn dir? [file]
  (.isDirectory (as-file file)))

(def recursive-delete
  (proxy [SimpleFileVisitor] []
    (visitFile [path _attrs]
      (Files/delete path)
      FileVisitResult/CONTINUE)
    (postVisitDirectory [path _exc]
      (Files/delete path)
      FileVisitResult/CONTINUE)))

(defn rm
  "Deletes file"
  [file]
  (.delete (as-file file)))

(defn rm-dir
  "Deletes directory recursively"
  [dir]
  (Files/walkFileTree (as-path dir) recursive-delete))

Remove reflection warning

Remove reflection warning


{:user {:plugins [[lein-cloverage                    "1.0.2"]
                  [lein-fore-prob                    "0.1.2"]
                  [lein-ancient                      "0.5.4"]
                  [jonase/eastwood                   "0.2.3"]
                  [com.jakemccrary/lein-test-refresh "0.3.4"]
                  [lein-pprint                       "1.1.1"]
                  [cider/cider-nrepl                 "0.12.0"]
                  [venantius/ultra                   "0.4.1"]]
        :signing {:gpg-key "E5B26621"}}}

{:user {:plugins [[lein-cloverage                    "1.0.2"]
                  [lein-fore-prob                    "0.1.2"]
                  [lein-ancient                      "0.6.10"]
                  [jonase/eastwood                   "0.2.3"]
                  [com.jakemccrary/lein-test-refresh "0.3.4"]
                  [lein-pprint                       "1.1.1"]
                  [cider/cider-nrepl                 "0.12.0"]
                  [venantius/ultra                   "0.4.1"]]
        :signing {:gpg-key "E5B26621"}}}

Bump lein-ancient

[lein] Bump lein-ancient


(ns babel.ug
  (:refer-clojure :exclude [get-in resolve])
  (:require [clojure.string :as string]
            [dag_unify.core :refer (fail? get-in unifyc)]))

(def phrasal {:phrasal true})

;;    [1]
;;   /   \
;;  /     \
;; H[1]    C
(def head-principle-no-infl
  (let [head-cat (atom :top)
        head-essere (atom :top)
        head-is-pronoun (atom :top)
        head-sem (atom :top)]
    (unifyc phrasal
            {:synsem {:cat head-cat
                      :essere head-essere
                      :pronoun head-is-pronoun
                      :sem head-sem}
             :head {:synsem {:cat head-cat
                             :essere head-essere
                             :pronoun head-is-pronoun
                             :sem head-sem}}})))

;;    [1]
;;   /   \
;;  /     \
;; H[1]    C
(def head-principle
  (unifyc head-principle-no-infl
          phrasal
          (let [head-infl (atom :top)
                agr (atom :top)]
            {:synsem {:infl head-infl
                      :agr agr}
             :head {:synsem {:infl head-infl
                             :agr agr}}})))

;;     subcat<>
;;     /      \
;;    /        \
;; H subcat<1>  C[1]
(def subcat-1-principle
  (let [comp-synsem (atom :top)]
    {:synsem {:subcat '()}
     :head {:synsem {:subcat {:1 comp-synsem
                              :2 '()}}}
     :comp {:synsem comp-synsem}}))

;;     subcat<>
;;     /      \
;;    /        \
;; H subcat<1>  C[1]
(def subcat-1-principle-no-complement-subcat-restrictions
  (let [comp-synsem (atom {:subcat :top})]
    {:synsem {:subcat '()}
     :head {:synsem {:subcat {:1 comp-synsem
                              :2 '()}}}
     :comp {:synsem comp-synsem}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<1>  C<>
(def subcat-1-1-principle
  (let [subcat (atom :top)]
    {:synsem {:subcat {:1 subcat
                       :2 '()}}
     :comp {:synsem {:subcat '()}}
     :head {:synsem {:subcat {:1 subcat
                              :2 '()}}}}))

;;     subcat<1,2>
;;     /         \
;;    /           \
;; H subcat<1,3>  3:C<1,2>
(def subcat-2-2-principle
  (let [subcat1 (atom :top)
        subcat2 (atom :top)
        subcat3 (atom {:subcat {:1 subcat1
                               :2 subcat2
                               :3 '()}})]
    {:synsem {:subcat {:1 subcat1
                       :2 subcat2
                       :3 '()}}
     :comp {:synsem subcat3}
     :head {:synsem {:subcat {:1 subcat1
                              :2 subcat3
                              :3 '()}}}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<1>  C<>
(def subcat-1-1-principle-comp-subcat-1
  (let [subcat (atom :top)]
    {:synsem {:subcat {:1 subcat
                       :2 '()}}
     :comp {:synsem {:subcat {:1 :top
                              :2 '()}}}
     :head {:synsem {:subcat {:1 subcat
                              :2 '()}}}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<1,2>  C[2]
(def subcat-2-principle
  (let [comp-synsem (atom {:cat :top})
        parent-subcat (atom {:cat :top})]
    {:synsem {:subcat {:1 parent-subcat
                       :2 '()}}
     :head {:synsem {:subcat {:1 parent-subcat
                              :2 comp-synsem
                              :3 '()}}}
     :comp {:synsem comp-synsem}}))

;;     subcat<1,3>
;;     /      \
;;    /        \
;; H subcat<1,2>  C[2]<1,3>
(def subcat-3-principle
  (let [subcat-1 (atom :top)
        subcat-3 (atom :top)
        subcat-2 (atom {:subcat {:1 subcat-1
                                :2 subcat-3}})]
    {:synsem {:subcat {:1 subcat-1
                       :2 subcat-3
                       :3 '()}}
     :head {:synsem {:subcat {:1 subcat-1
                              :2 subcat-2
                              :3 '()}}}
     :comp {:synsem subcat-2}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<2>  C[2]<1>
(def subcat-4-principle
  (let [subcat-1 (atom :top)
        subcat-2 (atom {:subcat {:1 subcat-1}})]
    {:synsem {:subcat {:1 subcat-1
                       :2 '()}}
     :head {:synsem {:subcat {:1 subcat-2}}}
     :comp {:synsem subcat-2}}))

;;       subcat<1,2>
;;      /          \
;;     /            \
;; H subcat<1,2,3>  C[3]
(def subcat-5-principle
  ;; we specify {:cat :top} rather than simply :top
  ;; because we want to prevent matching with '()
  ;; that is, a verb which only subcats for :1 and 2: (transitive)
  ;; would match :3 because (unify '() :top) => :top,
  ;; and would fit in here erroneously.
  ;; This is prevented by {:cat :top},
  ;; because (unify '() {:cat :top}) => :fail.
  (let [subcat-1 (atom {:cat :top})
        subcat-2 (atom {:cat :top})
        subcat-3 (atom {:cat :top})]
    {:head {:synsem {:subcat {:1 subcat-1
                              :2 subcat-2
                              :3 subcat-3}}}
     :comp {:synsem subcat-3}
     :synsem {:subcat {:1 subcat-1
                       :2 subcat-2}}}))

(def comp-modifies-head
  (let [human (atom :top)
        animate (atom :top)
        comp-semantics (atom {:animate animate :human human})
        head-semantics (atom {:animate animate :human human :mod comp-semantics})]
    {:head {:synsem {:sem head-semantics}}
     :comp {:synsem {:sem comp-semantics}}}))

(def comp-specs-head
  (let [comp-semantics (atom :top)
        head-semantics (atom {:spec comp-semantics})]
    {:head {:synsem {:sem head-semantics}}
     :comp {:synsem {:sem comp-semantics}}}))

;; -- END SCHEMA DEFINITIONS

(defn sentence-impl [input]
  "do things necessary before something can be a sentence. e.g. if infl is still :top, set to
:present (later, set to a randomly selected member of {:finite, :futuro, ..}."
  (do
    (cond
     (seq? input)
     (map (fn [each]
            (sentence-impl each))
          input)
     (= input :top) input
     true
     (let [finitize
           (cond (or (= (get-in input '(:synsem :infl))
                        :top)
                     (= (get-in input '(:synsem :infl))
                        :infinitive))

                 (first (take 1 (shuffle
                                 (list
                                  {:synsem {:infl :futuro}}
                                  {:synsem {:infl :imperfetto}}
                                  {:synsem {:infl :present}}
                                  ))))
                 ;; special additional case for 'potere' exclude :imperfetto.
                 (= (get-in input '(:synsem :infl :not))
                    :imperfetto)
                 (first (take 1 (shuffle
                                 (list
                                  {:synsem {:infl :futuro}}
                                  {:synsem {:infl :present}})))))]
       (let [merged
             (if (= input :fail) :fail
                 (unifyc input finitize))]
         (do
           merged)))))) ;; for now, no recursive call.

(defn sent-impl [input]
  "shortcut"
  (sentence-impl input))

;; Phrase [:root [1]]
;;       /        \
;;  [1] H          C
(def root-is-head
  "'root' is used to generate and search for expressions that have a given lexeme as their root. e.g. the 'root' of 'io ho parlato' is 'parlare'"
  (let [root (atom :top)]
    {:root root
     :head root}))

;; Phrase [:root [1]]
;;        /       \
;;  H [:root [1]]  C
(def root-is-head-root
  (let [root (atom :top)]
    {:root root
     :head {:root root}}))

;; Phrase [:root [1]]
;;        /       \
;;       H     [1] C
(def root-is-comp
  (let [root (atom :top)]
    {:root root
     :comp root}))

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

(defn unify-check [ & vals]
  (let [result (apply unifyc vals)]
    (if (fail? result)
      (exception (str "failed to unify grammar rule with values: " vals))
      result)))

(ns babel.ug
  (:refer-clojure :exclude [get-in resolve])
  (:require [clojure.string :as string]
            [dag_unify.core :refer (fail? get-in unifyc)]))

(def phrasal {:phrasal true})

;;    [1]
;;   /   \
;;  /     \
;; H[1]    C
(def head-principle-no-infl
  (let [head-cat (atom :top)
        head-essere (atom :top)
        head-is-pronoun (atom :top)
        head-sem (atom :top)]
    (unifyc phrasal
            {:synsem {:cat head-cat
                      :essere head-essere
                      :pronoun head-is-pronoun
                      :sem head-sem}
             :head {:synsem {:cat head-cat
                             :essere head-essere
                             :pronoun head-is-pronoun
                             :sem head-sem}}})))

;;    [1]
;;   /   \
;;  /     \
;; H[1]    C
(def head-principle
  (unifyc head-principle-no-infl
          phrasal
          (let [head-infl (atom :top)
                agr (atom :top)]
            {:synsem {:infl head-infl
                      :agr agr}
             :head {:synsem {:infl head-infl
                             :agr agr}}})))

;;     subcat<>
;;     /      \
;;    /        \
;; H subcat<1>  C[1]
(def subcat-1-principle
  (let [comp-synsem (atom :top)]
    {:synsem {:subcat '()}
     :head {:synsem {:subcat {:1 comp-synsem
                              :2 '()}}}
     :comp {:synsem comp-synsem}}))

;;     subcat<>
;;     /      \
;;    /        \
;; H subcat<1>  C[1]
(def subcat-1-principle-no-complement-subcat-restrictions
  (let [comp-synsem (atom {:subcat :top})]
    {:synsem {:subcat '()}
     :head {:synsem {:subcat {:1 comp-synsem
                              :2 '()}}}
     :comp {:synsem comp-synsem}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<1>  C<>
(def subcat-1-1-principle
  (let [subcat (atom :top)]
    {:synsem {:subcat {:1 subcat
                       :2 '()}}
     :comp {:synsem {:subcat '()}}
     :head {:synsem {:subcat {:1 subcat
                              :2 '()}}}}))

;;     subcat<1,2>
;;     /         \
;;    /           \
;; H subcat<1,3>  3:C<1,2>
(def subcat-2-2-principle
  (let [subcat1 (atom :top)
        subcat2 (atom :top)
        subcat3 (atom {:subcat {:1 subcat1
                               :2 subcat2
                               :3 '()}})]
    {:synsem {:subcat {:1 subcat1
                       :2 subcat2
                       :3 '()}}
     :comp {:synsem subcat3}
     :head {:synsem {:subcat {:1 subcat1
                              :2 subcat3
                              :3 '()}}}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<1>  C<>
(def subcat-1-1-principle-comp-subcat-1
  (let [subcat (atom :top)]
    {:synsem {:subcat {:1 subcat
                       :2 '()}}
     :comp {:synsem {:subcat {:1 :top
                              :2 '()}}}
     :head {:synsem {:subcat {:1 subcat
                              :2 '()}}}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<1,2>  C[2]
(def subcat-2-principle
  (let [comp-synsem (atom {:cat :top})
        parent-subcat (atom {:cat :top})]
    {:synsem {:subcat {:1 parent-subcat
                       :2 '()}}
     :head {:synsem {:subcat {:1 parent-subcat
                              :2 comp-synsem
                              :3 '()}}}
     :comp {:synsem comp-synsem}}))

;;     subcat<1,3>
;;     /      \
;;    /        \
;; H subcat<1,2>  C[2]<1,3>
(def subcat-3-principle
  (let [subcat-1 (atom :top)
        subcat-3 (atom :top)
        subcat-2 (atom {:subcat {:1 subcat-1
                                :2 subcat-3}})]
    {:synsem {:subcat {:1 subcat-1
                       :2 subcat-3
                       :3 '()}}
     :head {:synsem {:subcat {:1 subcat-1
                              :2 subcat-2
                              :3 '()}}}
     :comp {:synsem subcat-2}}))

;;     subcat<1>
;;     /      \
;;    /        \
;; H subcat<2>  C[2]<1>
(def subcat-4-principle
  (let [subcat-1 (atom :top)
        subcat-2 (atom {:subcat {:1 subcat-1}})]
    {:synsem {:subcat {:1 subcat-1
                       :2 '()}}
     :head {:synsem {:subcat {:1 subcat-2}}}
     :comp {:synsem subcat-2}}))

;;       subcat<1,2>
;;      /          \
;;     /            \
;; H subcat<1,2,3>  C[3]
(def subcat-5-principle
  ;; we specify {:cat :top} rather than simply :top
  ;; because we want to prevent matching with '()
  ;; that is, a verb which only subcats for :1 and 2: (transitive)
  ;; would match :3 because (unify '() :top) => :top,
  ;; and would fit in here erroneously.
  ;; This is prevented by {:cat :top},
  ;; because (unify '() {:cat :top}) => :fail.
  (let [subcat-1 (atom {:cat :top})
        subcat-2 (atom {:cat :top})
        subcat-3 (atom {:cat :top})]
    {:head {:synsem {:subcat {:1 subcat-1
                              :2 subcat-2
                              :3 subcat-3}}}
     :comp {:synsem subcat-3}
     :synsem {:subcat {:1 subcat-1
                       :2 subcat-2
                       :3 '()}}}))

(def comp-modifies-head
  (let [human (atom :top)
        animate (atom :top)
        comp-semantics (atom {:animate animate :human human})
        head-semantics (atom {:animate animate :human human :mod comp-semantics})]
    {:head {:synsem {:sem head-semantics}}
     :comp {:synsem {:sem comp-semantics}}}))

(def comp-specs-head
  (let [comp-semantics (atom :top)
        head-semantics (atom {:spec comp-semantics})]
    {:head {:synsem {:sem head-semantics}}
     :comp {:synsem {:sem comp-semantics}}}))

;; -- END SCHEMA DEFINITIONS

(defn sentence-impl [input]
  "do things necessary before something can be a sentence. e.g. if infl is still :top, set to
:present (later, set to a randomly selected member of {:finite, :futuro, ..}."
  (do
    (cond
     (seq? input)
     (map (fn [each]
            (sentence-impl each))
          input)
     (= input :top) input
     true
     (let [finitize
           (cond (or (= (get-in input '(:synsem :infl))
                        :top)
                     (= (get-in input '(:synsem :infl))
                        :infinitive))

                 (first (take 1 (shuffle
                                 (list
                                  {:synsem {:infl :futuro}}
                                  {:synsem {:infl :imperfetto}}
                                  {:synsem {:infl :present}}
                                  ))))
                 ;; special additional case for 'potere' exclude :imperfetto.
                 (= (get-in input '(:synsem :infl :not))
                    :imperfetto)
                 (first (take 1 (shuffle
                                 (list
                                  {:synsem {:infl :futuro}}
                                  {:synsem {:infl :present}})))))]
       (let [merged
             (if (= input :fail) :fail
                 (unifyc input finitize))]
         (do
           merged)))))) ;; for now, no recursive call.

(defn sent-impl [input]
  "shortcut"
  (sentence-impl input))

;; Phrase [:root [1]]
;;       /        \
;;  [1] H          C
(def root-is-head
  "'root' is used to generate and search for expressions that have a given lexeme as their root. e.g. the 'root' of 'io ho parlato' is 'parlare'"
  (let [root (atom :top)]
    {:root root
     :head root}))

;; Phrase [:root [1]]
;;        /       \
;;  H [:root [1]]  C
(def root-is-head-root
  (let [root (atom :top)]
    {:root root
     :head {:root root}}))

;; Phrase [:root [1]]
;;        /       \
;;       H     [1] C
(def root-is-comp
  (let [root (atom :top)]
    {:root root
     :comp root}))

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

(defn unify-check [ & vals]
  (let [result (apply unifyc vals)]
    (if (fail? result)
      (exception (str "failed to unify grammar rule with values: " vals))
      result)))

add subcat terminator to subcat-principle-5 rule


(ns compojure-bot.facebook
  (:gen-class)
  (:require [org.httpkit.client :as http]
            [clojure.pprint :as pprint]
            [clojure.data.json :as json]))

(defn webhook-is-valid? [request]
  (def params (:params request))
  (println "Incoming Webhook Request:")
  (println request)
  (if (= true (= (params "hub.mode") "subscribe")
        (= (params "hub.verify_token") (System/getenv "FB_PAGE_ACCESS_TOKEN")))
    {:status 200 :body (params "hub.challenge")}
    {:status 403}))

(defn sendAPI [messageData]
    (try
        (def response (http/post "https://graph.facebook.com/v2.6/me/messages"
                        {:query-params {"access_token" (System/getenv "FB_PAGE_ACCESS_TOKEN")}
                         :headers {"Content-Type" "application/json"}
                         :body (json/write-str messageData)
                         :insecure? true}))
        (println "Response to FB:")
        (println @response)
        (catch Exception e (str "caught exception: " (.getMessage e)))))

(defn sendTextMessage [[recipientId messageText]]
    (def messageData {:recipient {:id recipientId} :message {:text messageText}})
    (println messageData)
    (sendAPI messageData))

(defn onMessage [event]
  (let [senderID (get-in event [:sender :id]) recipientID (get-in event [:recipient :id]) timeOfMessage (get-in event [:timestamp]) message (get-in event [:message])]
    (println (str "Received message for user " senderID " and page " recipientID " at " timeOfMessage " with message:"))
    (println message)
    [senderID (:text message)]))

(defn route-request [request]
  (def data (get-in request [:params]))
  (println "Incoming Request:")
  (println request)
  (if (= (:object data) "page")
    (doseq [pageEntry (:entry data)]
      (doseq [messagingEvent (:messaging pageEntry)]
        (cond (contains? messagingEvent :message) (sendTextMessage (onMessage messagingEvent))
          :else (println (str "Webhook received unknown messagingEvent: " messagingEvent)))))))

(ns compojure-bot.facebook
  (:gen-class)
  (:require [org.httpkit.client :as http]
            [clojure.pprint :as pprint]
            [clojure.data.json :as json]
            [clojure.string :as s]))

(defn webhook-is-valid? [request]
  (def params (:params request))
  (println "Incoming Webhook Request:")
  (println request)
  (if (= true (= (params "hub.mode") "subscribe")
        (= (params "hub.verify_token") (System/getenv "FB_PAGE_ACCESS_TOKEN")))
    {:status 200 :body (params "hub.challenge")}
    {:status 403}))

(defn sendAPI [messageData]
    (try
        (def response (http/post "https://graph.facebook.com/v2.6/me/messages"
                        {:query-params {"access_token" (System/getenv "FB_PAGE_ACCESS_TOKEN")}
                         :headers {"Content-Type" "application/json"}
                         :body (json/write-str messageData)
                         :insecure? true}))
        (println "Response to FB:")
        (println @response)
        (catch Exception e (str "caught exception: " (.getMessage e)))))

(defn sendTextMessage [[recipientId messageText]]
    (def messageData {:recipient {:id recipientId} :message {:text messageText}})
    (println messageData)
    (sendAPI messageData))

(defn sendImageMessage [[recipientId imageUrl]]
    (def messageData {:recipient {:id recipientId} :message {:attachment {:type "image" :payload {:url imageUrl}}}})
    (println messageData)
    (sendAPI messageData))

(defn onMessage [event]
  (let [senderID (get-in event [:sender :id]) recipientID (get-in event [:recipient :id]) timeOfMessage (get-in event [:timestamp]) message (get-in event [:message])]
    (println (str "Received message for user " senderID " and page " recipientID " at " timeOfMessage " with message:"))
    (println message)
    (println (:text message))
    ; Add rules here
    (cond
      (s/includes? (s/lower-case (:text message)) "help") (sendTextMessage [senderID "Hi there, happy to help :)"])
      (s/includes? (s/lower-case (:text message)) "image") (sendImageMessage [senderID "https://upload.wikimedia.org/wikipedia/commons/thumb/c/c5/M101_hires_STScI-PRC2006-10a.jpg/1280px-M101_hires_STScI-PRC2006-10a.jpg"])
      :else (sendTextMessage [senderID (:text message)]))))

(defn route-request [request]
  (def data (get-in request [:params]))
  (println "Incoming Request:")
  (println request)
  (if (= (:object data) "page")
    (doseq [pageEntry (:entry data)]
      (doseq [messagingEvent (:messaging pageEntry)]
        ; Check for text or attachments here
        (cond (contains? messagingEvent :message) (onMessage messagingEvent)
          :else (println (str "Webhook received unknown messagingEvent: " messagingEvent)))))))

feat(handler): add handler to send image message, add condition for help


(defproject example "1.0.0-SNAPSHOT"
  :description "Example web app using single-sign-on with couchdb"
  :dependencies [[org.clojure/clojure "1.3.0"]
                 [org.clojure/data.json "0.1.1"]
                 [org.clojure/tools.logging "0.2.3"]
                 [org.slf4j/log4j-over-slf4j "1.6.4"]
                 [ch.qos.logback/logback-classic "1.0.0"]
                 [compojure "1.0.0"]
                 [org.signaut/ring.middleware.servlet-ext "0.4"]
                 [ring/ring-core "1.0.2"]
                 [ring/ring-servlet "1.0.2"]]
  :dev-dependencies [[swank-clojure "1.2.1"]
                     [ring/ring-devel "1.0.2"]
                     [uk.org.alienscience/leiningen-war "0.0.12"]
                     [org.signaut/ring-jetty7-adapter "1.0.2.2"]]
  :war {:name "example.war"}
  :aot [example.servlet])

(defproject example "1.0.0-SNAPSHOT"
  :description "Example web app using single-sign-on with couchdb"
  :dependencies [[org.clojure/clojure "1.4.0"]
                 [org.clojure/data.json "0.1.1"]
                 [org.clojure/tools.logging "0.2.3"]
                 [org.slf4j/log4j-over-slf4j "1.6.4"]
                 [ch.qos.logback/logback-classic "1.0.0"]
                 [compojure "1.0.0"]
                 [org.signaut/ring.middleware.servlet-ext "0.4"]
                 [ring/ring-core "1.1.0"]
                 [ring/ring-servlet "1.1.0"]]
  :dev-dependencies [[swank-clojure "1.2.1"]
                     [ring/ring-devel "1.0.2"]
                     [uk.org.alienscience/leiningen-war "0.0.12"]
                     [org.signaut/ring-jetty7-adapter "1.0.2.2"]]
  :war {:name "example.war"}
  :aot [example.servlet])

update example

update example


(defproject example "0.1.0-SNAPSHOT"
  :description "Simple example of using lein-jshint"
  :url "https://github.com/vbauer/lein-jshint"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}

  ; List of plugins
  :plugins [[lein-jshint "0.1.8"]]

  ; List of hooks
  ; It's used for running JSHint during compile phase
  :hooks [lein-jshint.plugin]

  ; JSHint configuration
  :jshint {:debug true
           :includes "resources/*.js"})

(defproject example "0.1.0-SNAPSHOT"
  :description "Simple example of using lein-jshint"
  :url "https://github.com/vbauer/lein-jshint"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}

  ; List of plugins
  :plugins [[lein-jshint "0.1.9"]]

  ; List of hooks
  ; It's used for running JSHint during compile phase
  :hooks [lein-jshint.plugin]

  ; JSHint configuration
  :jshint {:debug true
           :includes "resources/*.js"})

Update an example project

Update an example project


(ns iss.core
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [iss.buttons :as buttons]
            [iss.constants :refer [light-blue dark-blue light-gray]])
  (:require-macros [iss.macros :as macros :refer [defstyles gradient]]))

(enable-console-print!)

(def app-state
  (atom
    {:widgets
     [{:my-number 16}
      {:my-number 23}]}))

(defstyles even-odd
  {:app
    {:alignItems "center"
     :backgroundImage (gradient dark-blue light-blue)
     :display "flex"
     :flexGrow 1
     :justifyContent "space-around"}
   :container
    {:display "flex"
     :flex 1
     :maxWidth 760}
   :widget
    {:alignItems "center"
     :display "flex"
     :flexBasis "50%"
     :flexDirection "column"}
   :title
    {:color light-gray
     :margin "1rem"
     :fontSize "4.2rem"}})

(defmulti even-odd-widget
  (fn [props _] (even? (:my-number props))))

(defmethod even-odd-widget true
  [props owner]
  (reify
    om/IWillMount
    (will-mount [_]
      (println "Even widget mounting"))
    om/IWillUnmount
    (will-unmount [_]
      (println "Even widget unmounting"))
    om/IRender
    (render [_]
      (dom/div #js {:className (.-widget even-odd)}
        (dom/h2 #js {:className (.-title even-odd)}
          (str (:my-number props)))
        (om/build buttons/button
          {:even true :onClick #(om/transact! props :my-number inc)}
          {:init-state {:text "+"}})))))

(defmethod even-odd-widget false
  [props owner]
  (reify
    om/IWillMount
    (will-mount [_]
      (println "Odd widget mounting"))
    om/IWillUnmount
    (will-unmount [_]
      (println "Odd widget unmounting"))
    om/IRender
    (render [_]
      (dom/div #js {:className (.-widget even-odd)}
        (dom/h2 #js {:className (.-title even-odd)}
          (str (:my-number props)))
        (om/build buttons/button
          {:even false :onClick #(om/transact! props :my-number inc)}
          {:init-state {:text "+"}})))))

(defn app [props owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (.-app even-odd)}
        (apply dom/div #js {:className (.-container even-odd)}
          (om/build-all even-odd-widget (:widgets props)))))))

(om/root app app-state
  {:target (.-body js/document)})

(ns iss.core
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [iss.buttons :as buttons]
            [iss.constants :refer [light-blue dark-blue light-gray]])
  (:require-macros [iss.macros :as macros :refer [defstyles gradient]]))

(enable-console-print!)

(def app-state
  (atom
    {:widgets
     [{:my-number 16}
      {:my-number 23}]}))

(defstyles even-odd
  {:app
    {:alignItems "center"
     :backgroundImage (gradient dark-blue light-blue)
     :display "flex"
     :flexGrow 1
     :justifyContent "space-around"}
   :container
    {:display "flex"
     :flex 1
     :maxWidth 760}
   :widget
    {:alignItems "center"
     :display "flex"
     :flexBasis "50%"
     :flexDirection "column"}
   :title
    {:color light-gray
     :margin "1rem"
     :fontSize "4.2rem"}})

(defmulti even-odd-widget
  (fn [props _] (even? (:my-number props))))

(defmethod even-odd-widget true
  [props owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (.-widget even-odd)}
        (dom/h2 #js {:className (.-title even-odd)}
          (str (:my-number props)))
        (om/build buttons/button
          {:even true :onClick #(om/transact! props :my-number inc)}
          {:init-state {:text "+"}})))))

(defmethod even-odd-widget false
  [props owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (.-widget even-odd)}
        (dom/h2 #js {:className (.-title even-odd)}
          (str (:my-number props)))
        (om/build buttons/button
          {:even false :onClick #(om/transact! props :my-number inc)}
          {:init-state {:text "+"}})))))

(defn app [props owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (.-app even-odd)}
        (apply dom/div #js {:className (.-container even-odd)}
          (om/build-all even-odd-widget (:widgets props)))))))

(om/root app app-state
  {:target (.-body js/document)})

Remove mount hooks

Remove mount hooks


(ns semtag-web.spinner
  (:require [domina :as dom]
            [goog.events.KeyCodes :as key-codes]
            [goog.ui.KeyboardShortcutHandler :as shortcut]))

;; Consider using a working defonce - https://gist.github.com/cemerick/6331727
(def spinner (atom nil))

;; Based on http://stackoverflow.com/questions/9585752/using-simplemodal-show-loading-spinner-while-content-inside-iframe-loads/12882847#12882847
(def modal-opts
  {:lines 11
   :length 23
   :width 8
   :radius 40
   :corners 1
   :rotate 9
   :color "#FFF"
   :speed 1
   :trail 50
   :shadow true
   :hwaccel false
   :className "spinner"
   :zIndex 2e9})

(defn- setup-keybindings []
  (let [shortcut-handler (goog.ui.KeyboardShortcutHandler. js/document)
        show-triggered (fn [event]
                         (.log js/console (str "Received: " (.-identifier event)))
                         (.stop @spinner)
                         (set! (-> "spin_modal_overlay" dom/by-id .-style .-display) "none"))]
    (.registerShortcut shortcut-handler "esc" goog.events.KeyCodes.ESC)
    (.listen goog.events
             shortcut-handler
             goog.ui.KeyboardShortcutHandler.EventType.SHORTCUT_TRIGGERED
             show-triggered)))

(defn- create-spinner
  []
  (reset! spinner (new js/Spinner (clj->js modal-opts)))
  (.spin @spinner (dom/by-id "spin_modal_overlay"))
  (set! (-> @spinner .-el .-style .-top) "50%")
  (set! (-> @spinner .-el .-style .-left) "50%"))

(defn render [new-value]
  (.log js/console "spinner" new-value)
  (when-not @spinner
    (create-spinner)
    ;; TODO: disable input focus for search
    (setup-keybindings))
  (if new-value
    (set! (-> "spin_modal_overlay" dom/by-id .-style .-display) "block")
    ;; Add a little lag so it's not just a blink
    (js/setTimeout
     (fn [] (set! (-> "spin_modal_overlay" dom/by-id .-style .-display) "none"))
     200)))

(ns semtag-web.spinner
  (:require [domina :as dom]
            [goog.events.KeyCodes :as key-codes]
            [goog.ui.KeyboardShortcutHandler :as shortcut]))

;; Consider using a working defonce - https://gist.github.com/cemerick/6331727
(def spinner (atom nil))

;; Based on http://stackoverflow.com/questions/9585752/using-simplemodal-show-loading-spinner-while-content-inside-iframe-loads/12882847#12882847
(def modal-opts
  {:lines 11
   :length 33
   :width 8
   :radius 45
   :corners 1
   :rotate 9
   :color "#FFF"
   :speed 1
   :trail 50
   :shadow true
   :hwaccel false
   :className "spinner"
   :zIndex 2e9})

(defn- setup-keybindings []
  (let [shortcut-handler (goog.ui.KeyboardShortcutHandler. js/document)
        show-triggered (fn [event]
                         (.log js/console (str "Received: " (.-identifier event)))
                         (.stop @spinner)
                         (set! (-> "spin_modal_overlay" dom/by-id .-style .-display) "none"))]
    (.registerShortcut shortcut-handler "esc" goog.events.KeyCodes.ESC)
    (.listen goog.events
             shortcut-handler
             goog.ui.KeyboardShortcutHandler.EventType.SHORTCUT_TRIGGERED
             show-triggered)))

(defn- create-spinner
  []
  (reset! spinner (new js/Spinner (clj->js modal-opts)))
  (.spin @spinner (dom/by-id "spin_modal_overlay"))
  (set! (-> @spinner .-el .-style .-top) "50%")
  (set! (-> @spinner .-el .-style .-left) "50%"))

(defn render [new-value]
  (.log js/console "spinner" new-value)
  (when-not @spinner
    (create-spinner)
    ;; TODO: disable input focus for search
    (setup-keybindings))
  (if new-value
    (set! (-> "spin_modal_overlay" dom/by-id .-style .-display) "block")
    ;; Add a little lag so it's not just a blink
    (js/setTimeout
     (fn [] (set! (-> "spin_modal_overlay" dom/by-id .-style .-display) "none"))
     200)))

make spinner bigger

make spinner bigger


(ns multicodec.codecs.mux
  "Multiplexing codec which uses the codec predicates `encodable?` and
  `decodable?` to decide which codec to use when encoding or decoding data.

  `codecs` should be a map from (arbitrary) keys to codecs with headers and
  support for the codec predicates.

  The actual codec delegated to can be determined by binding
  `*dispatched-codec*` to `nil` and checking the result after an operation."
  (:require
    [multicodec.core :as codec]
    [multicodec.header :as header]
    [multicodec.codecs.wrap :as wrap]))

;; This var can be bound to find out what codec the mux used internally when
;; encoding or decoding a value.
(def ^:dynamic *dispatched-codec*)

(defn- find-encodable
  "Finds the first codec in the map which can encode the given value. Returns a
  vector of the key and codec entry, or nil if none are found."
  [codecs value]
  (first (filter #(codec/encodable? (val %) value) codecs)))

(defn- find-decodable
  "Finds the first codec in the map which can decode the given header. Returns
  a vector of the key and codec entry, or nil if none are found."
  [codecs header]
  (first (filter #(codec/decodable? (val %) header) codecs)))

;; ## Multiplexing Codec

(defrecord MuxCodec
  [header codecs]

  codec/Encoder

  (encodable?
    [this value]
    (boolean (find-encodable codecs value)))

  (encode!
    [this output value]
    (let [[codec-key codec] (find-encodable codecs value)]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can encode value: " (pr-str value))
                 {:codecs (keys codecs)
                  :value value})))
      (when (bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/encode-with-header! codec output value)))

  codec/Decoder

  (decodable?
    [this header']
    (boolean (find-decodable codecs header')))

  (decode!
    [this input]
    (let [header' (header/read-header! input)
          [codec-key codec] (find-decodable codecs header')]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can decode header: " (pr-str header'))
                 {:codecs (keys codecs)
                  :header header'})))
      (when (bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/decode! codec input))))

(defn select
  "Convenience function for selecting a specific codec from a multiplexer. The
  returned codec will encode and decode as the mux would, but only for that
  subcodec."
  [mux codec-key]
  (if-let [codec (get (:codecs mux) codec-key)]
    (wrap/wrap-header codec)
    (throw (ex-info (str "Multiplexer does not contain codec for key "
                         (pr-str codec-key) " " (pr-str (keys (:codecs mux))))
                    {:codecs (keys (:codecs mux))
                     :key codec-key}))))

(defn mux-codec
  "Creates a new multiplexing codec which delegates to the given collection of
  codecs by reading and writing multicodec headers when serializing values.

  When encoding a value, the multiplexer will look for the first codec which
  reports it is `encodable?`. The selected codec's header is written first,
  then the codec is used to write the value.

  When decoding, the multiplexer tries to read a multicodec header and looks
  for the first codec which reports the header is `decodable?`. The selected
  codec is then used to read a value from the remaining data.

  As a consequence, the delegated codecs _must_ implement the codec predicates
  and _must not_ write or expect to consume their own headers!"
  [& codecs]
  (when-not (seq codecs)
    (throw (IllegalArgumentException.
             "mux-codec requires at least one codec")))
  (when-not (even? (count codecs))
    (throw (IllegalArgumentException.
             "mux-codec must be given an even number of arguments")))
  (let [codec-map (apply array-map codecs)]
    (when-let [bad-codecs (seq (remove (comp string? :header)
                                       (vals codec-map)))]
      (throw (IllegalArgumentException.
               (str "Every codec must specify a header path: "
                    (pr-str bad-codecs)))))
    (MuxCodec. "/multicodec" codec-map)))

;; Remove automatic constructor functions.
(ns-unmap *ns* '->MuxCodec)
(ns-unmap *ns* 'map->MuxCodec)

(ns multicodec.codecs.mux
  "Multiplexing codec which uses the codec predicates `encodable?` and
  `decodable?` to decide which codec to use when encoding or decoding data.

  `codecs` should be a map from (arbitrary) keys to codecs with headers and
  support for the codec predicates.

  The actual codec delegated to can be determined by binding
  `*dispatched-codec*` to `nil` and checking the result after an operation."
  (:require
    [multicodec.core :as codec]
    [multicodec.header :as header]
    [multicodec.codecs.wrap :as wrap]))

;; This var can be bound to find out what codec the mux used internally when
;; encoding or decoding a value.
(def ^:dynamic *dispatched-codec*)

(defn- find-encodable
  "Finds the first codec in the map which can encode the given value. Returns a
  vector of the key and codec entry, or nil if none are found."
  [codecs value]
  (first (filter #(codec/encodable? (val %) value) codecs)))

(defn- find-decodable
  "Finds the first codec in the map which can decode the given header. Returns
  a vector of the key and codec entry, or nil if none are found."
  [codecs header]
  (first (filter #(codec/decodable? (val %) header) codecs)))

;; ## Multiplexing Codec

(defrecord MuxCodec
  [header codecs]

  codec/Encoder

  (encodable?
    [this value]
    (boolean (find-encodable codecs value)))

  (encode!
    [this output value]
    (let [[codec-key codec] (find-encodable codecs value)]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can encode value: " (pr-str value))
                 {:codecs (keys codecs)
                  :value value})))
      (when (thread-bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/encode-with-header! codec output value)))

  codec/Decoder

  (decodable?
    [this header']
    (boolean (find-decodable codecs header')))

  (decode!
    [this input]
    (let [header' (header/read-header! input)
          [codec-key codec] (find-decodable codecs header')]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can decode header: " (pr-str header'))
                 {:codecs (keys codecs)
                  :header header'})))
      (when (thread-bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/decode! codec input))))

(defn select
  "Convenience function for selecting a specific codec from a multiplexer. The
  returned codec will encode and decode as the mux would, but only for that
  subcodec."
  [mux codec-key]
  (if-let [codec (get (:codecs mux) codec-key)]
    (wrap/wrap-header codec)
    (throw (ex-info (str "Multiplexer does not contain codec for key "
                         (pr-str codec-key) " " (pr-str (keys (:codecs mux))))
                    {:codecs (keys (:codecs mux))
                     :key codec-key}))))

(defn mux-codec
  "Creates a new multiplexing codec which delegates to the given collection of
  codecs by reading and writing multicodec headers when serializing values.

  When encoding a value, the multiplexer will look for the first codec which
  reports it is `encodable?`. The selected codec's header is written first,
  then the codec is used to write the value.

  When decoding, the multiplexer tries to read a multicodec header and looks
  for the first codec which reports the header is `decodable?`. The selected
  codec is then used to read a value from the remaining data.

  As a consequence, the delegated codecs _must_ implement the codec predicates
  and _must not_ write or expect to consume their own headers!"
  [& codecs]
  (when-not (seq codecs)
    (throw (IllegalArgumentException.
             "mux-codec requires at least one codec")))
  (when-not (even? (count codecs))
    (throw (IllegalArgumentException.
             "mux-codec must be given an even number of arguments")))
  (let [codec-map (apply array-map codecs)]
    (when-let [bad-codecs (seq (remove (comp string? :header)
                                       (vals codec-map)))]
      (throw (IllegalArgumentException.
               (str "Every codec must specify a header path: "
                    (pr-str bad-codecs)))))
    (MuxCodec. "/multicodec" codec-map)))

;; Remove automatic constructor functions.
(ns-unmap *ns* '->MuxCodec)
(ns-unmap *ns* 'map->MuxCodec)

Check for thread-bound? not just bound?.


(ns navigator
  ^{:author "David Zaharee <dzaharee@vlacs.org>"
    :doc "This library knows how to work with competency data."}
  (:require [clojure.edn :as edn]
            [datomic.api :as d]
            [liberator.core :refer [resource]]
            [navigator.schema :as schema]
            [hatch]
            [navigator.templates :as templates]
            [navigator.data :as data]))

;; front end

(defn helmsman-def [db-conn]
  [[:get "/comp-map/" (resource :allowed-methods [:get]
                                :available-media-types ["text/html"]
                                :handle-ok (fn [ctx] (apply str (templates/view-comp-map (data/get-comp-map db-conn ctx) ctx))))]])

;; Get functions

(defn get-entity
  "Gets an entity using query and bindings. The db conn is assumed to
  be the first binding of the query and doesn't need to be included in
  the bindings part of the arguments."
  ([db-conn query & bindings]
     (d/entity (d/db db-conn) (ffirst (apply d/q query (d/db db-conn) bindings)))))

(defn get-competency
  "Get competency by shared key"
  [db-conn id-sk]
  (get-entity db-conn '[:find ?e
                     :in $ ?id-sk
                     :where [?e :comp/id-sk ?id-sk]]
              id-sk))

(defn get-competency-by-name-version
  "Get competency by name+verion"
  [db-conn name version]
  (get-entity db-conn '[:find ?e
                     :in $ ?name ?version
                     :where [?e :comp/name ?name]
                            [?e :comp/version ?version]]
              name version))
;; TODO: we probably want other ways to get competency(s)

(defn get-perf-asmt
  "Get perf-asmt by shared key"
  [db-conn id-sk]
  (get-entity db-conn '[:find ?e
                     :in $ ?id-sk
                     :where [?e :perf-asmt/id-sk ?id-sk]]
              id-sk))

(defn get-user2comp
  "Get user2comp by sis-user-id and comp"
  [db-conn sis-user-id comp-eid]
  (get-entity db-conn '[:find ?e
                     :in $ ?sis-user-id ?comp-eid
                     :where [?e :user2comp/sis-user-id ?sis-user-id]
                            [?e :user2comp/comp ?comp-eid]]))

;; Creation/update functions

(def partitions (hatch/schematode->partitions schema/schema))

(def valid-attrs (hatch/schematode->attrs schema/schema))

(def tx-entity! (partial hatch/tx-clean-entity! partitions valid-attrs))

;; queue functions

(defn task-in [db-conn message]
  (tx-entity! db-conn :task (merge {:task/id-sk (str (get-in message [:header :entity-id :task-id]))}
                                   (hatch/slam-all (get-in message [:payload :entity]) :task))))

(defn comp-in [db-conn message]
  (tx-entity! db-conn :comp (merge {:comp/id-sk (str (get-in message [:header :entity-id :comp-id]))
                                    (hatch/slam-all (get-in message [:payload :entity]) :comp)})))

(defn comp-tag-in [db-conn message]
  (tx-entity! db-conn :comp-tag (hatch/slam-all (get-in message [:payload :entity]) :comp-tag)))

(defn perf-asmt-in [db-conn message]
  (tx-entity! db-conn :perf-asmt (merge {:perf-asmt/id-sk (str (get-in message [:header :entity-id :perf-asmt-id]))
                                         (hatch/slam-all (get-in message [:paylod :entity]) :perf-asmt)})))
(defn user2comp-in [db-conn message]
  (tx-entity! db-conn :user2comp (hatch/slam-all (get-in message [:payload :entity]) :user2comp)))

(defn user2perf-asmt-in [db-conn message]
  (tx-entity! db-conn :user2perf-asmt (hatch/slam-all (get-in message [:payload :entity]) :user2perf-asmt)))

(comment

  (navigator/task-in (:db-conn nt-config/system)
                     {:payload
                      {:entity
                       {:competency-parents [1 2 3],
                        :name "tie shoes (together)",
                        :version "v3"}},
                      :header
                      {:entity-type "task", :operation "assert", :entity-id {:task-id 17}}})

)

(ns navigator
  ^{:author "David Zaharee <dzaharee@vlacs.org>"
    :doc "This library knows how to work with competency data."}
  (:require [clojure.edn :as edn]
            [datomic.api :as d]
            [liberator.core :refer [resource]]
            [navigator.schema :as schema]
            [hatch]
            [navigator.templates :as templates]
            [navigator.data :as data]))

;; front end

(defn helmsman-def [db-conn]
  [[:get "/comp-map/" (resource :allowed-methods [:get]
                                :available-media-types ["text/html"]
                                :handle-ok (fn [ctx] (apply str (templates/view-comp-map (data/get-comp-map db-conn ctx) ctx))))]])

;; Get functions

(defn get-entity
  "Gets an entity using query and bindings. The db conn is assumed to
  be the first binding of the query and doesn't need to be included in
  the bindings part of the arguments."
  ([db-conn query & bindings]
     (d/entity (d/db db-conn) (ffirst (apply d/q query (d/db db-conn) bindings)))))

(defn get-competency
  "Get competency by shared key"
  [db-conn id-sk]
  (get-entity db-conn '[:find ?e
                     :in $ ?id-sk
                     :where [?e :comp/id-sk ?id-sk]]
              id-sk))

(defn get-competency-by-name-version
  "Get competency by name+verion"
  [db-conn name version]
  (get-entity db-conn '[:find ?e
                     :in $ ?name ?version
                     :where [?e :comp/name ?name]
                            [?e :comp/version ?version]]
              name version))
;; TODO: we probably want other ways to get competency(s)

(defn get-perf-asmt
  "Get perf-asmt by shared key"
  [db-conn id-sk]
  (get-entity db-conn '[:find ?e
                     :in $ ?id-sk
                     :where [?e :perf-asmt/id-sk ?id-sk]]
              id-sk))

(defn get-user2comp
  "Get user2comp by sis-user-id and comp"
  [db-conn sis-user-id comp-eid]
  (get-entity db-conn '[:find ?e
                     :in $ ?sis-user-id ?comp-eid
                     :where [?e :user2comp/sis-user-id ?sis-user-id]
                            [?e :user2comp/comp ?comp-eid]]))

;; Creation/update functions

(def partitions (hatch/schematode->partitions schema/schema))

(def valid-attrs (hatch/schematode->attrs schema/schema))

(def tx-entity! (partial hatch/tx-clean-entity! partitions valid-attrs))

;; queue functions

(defn task-in [db-conn message]
  (tx-entity! db-conn :task (merge {:task/id-sk (str (get-in message [:header :entity-id :task-id]))}
                                   (hatch/slam-all (get-in message [:payload :entity]) :task))))

(defn comp-in [db-conn message]
  (tx-entity! db-conn :comp (merge {:comp/id-sk (str (get-in message [:header :entity-id :comp-id]))}
                                    (hatch/slam-all (get-in message [:payload :entity]) :comp))))

(defn comp-tag-in [db-conn message]
  (tx-entity! db-conn :comp-tag (hatch/slam-all (get-in message [:payload :entity]) :comp-tag)))

(defn perf-asmt-in [db-conn message]
  (tx-entity! db-conn :perf-asmt (merge {:perf-asmt/id-sk (str (get-in message [:header :entity-id :perf-asmt-id]))}
                                         (hatch/slam-all (get-in message [:paylod :entity]) :perf-asmt))))
(defn user2comp-in [db-conn message]
  (tx-entity! db-conn :user2comp (hatch/slam-all (get-in message [:payload :entity]) :user2comp)))

(defn user2perf-asmt-in [db-conn message]
  (tx-entity! db-conn :user2perf-asmt (hatch/slam-all (get-in message [:payload :entity]) :user2perf-asmt)))

(comment

  (navigator/task-in (:db-conn nt-config/system)
                     {:payload
                      {:entity
                       {:competency-parents [1 2 3],
                        :name "tie shoes (together)",
                        :version "v3"}},
                      :header
                      {:entity-type "task", :operation "assert", :entity-id {:task-id 17}}})

)

move the slams out of the maps

move the slams out of the maps


(ns ygq.popup.ui
  (:require [om.next :as om]
            [om.dom :as dom]
            [goog.string :as gstr]
            [youtube.video :as video]
            [untangled.client.core :as uc]
            [untangled.client.mutations :refer [mutate]]
            [untangled.client.data-fetch :as df]
            [cljs.spec :as s]))

(defmethod mutate 'auth/token-received [{:keys [state]} _ {:keys [token]}]
  {:action (fn []
             (swap! state assoc :app/user-token token))})

(defmethod mutate 'youtube.video/navigate [_ _ {::video/keys [id]}]
  {:action (fn []
             (let [video-url (str "https://www.youtube.com/watch?v=" id)]
               (js/chrome.tabs.update #js {:url video-url})))})

(defmethod mutate 'youtube.video/mark-watched [{:keys [state ref]} _ {::video/keys [id]}]
  {:remote true
   :action (fn []
             (swap! state assoc-in [::video/by-id id ::video/watched?] true))})

(defmethod mutate 'youtube.video/mark-unwatched [{:keys [state ref]} _ {::video/keys [id]}]
  {:remote true
   :action (fn []
             (swap! state assoc-in [::video/by-id id ::video/watched?] false))})

(defmethod mutate 'window/close [_ _ _]
  {:action (fn []
             (js/console.log "Close window")
             (js/window.close))})

(defn pd [f]
  (fn [e]
    (.preventDefault e)
    (f e)))

(defn get-load-query [comp]
  (conj (om/get-query comp) :ui/fetch-state))

(defn icon [name]
  (dom/span #js {:className (str "glyphicon glyphicon-" name)}))

(defn duration-str [duration]
  (if-let [[h m s] (some->> (re-find #"(?:(\d+)H)?(\d+)M(\d+)S$" duration)
                            next (map #(some-> % (gstr/padNumber 2))))]
    (cond->> (str m ":" s)
             h (str h ":"))))

(s/def ::duration string?)

(s/fdef duration-str
  :args (s/cat :duration ::duration)
  :ret (s/and string? #(re-find #"^(\d{2}:)?\d{2}:\d{2}$" %)))

(om/defui ^:once QueuedVideo
  static uc/InitialAppState
  (initial-state [_ title] {::video/id    (random-uuid)
                            ::video/title title})

  static om/IQuery
  (query [_] [::video/id
              ::video/watched?
              {::video/snippet
               [::video/title
                ::video/channel-title
                {::video/thumbnails
                 [{:youtube.thumbnail/default
                   [:youtube.thumbnail/url]}]}]}
              {::video/content-details
               [::video/duration]}])

  static om/Ident
  (ident [_ props] [::video/by-id (::video/id props)])

  Object
  (componentDidMount [this]
    (when-not (-> this om/props ::video/snippet)
      (df/load this (om/get-ident this) QueuedVideo
        {:parallel true})))

  (render [this]
    (let [{::video/keys [id snippet content-details watched?]} (om/props this)
          {::video/keys [title channel-title thumbnails]} snippet
          {::video/keys [duration]} content-details]
      (dom/div #js {:className (cond-> "video--row"
                                 watched? (str " video--row--watched"))}
        (dom/div #js {:className "video--thumbnail--container"}
          (dom/img #js {:src       (get-in thumbnails [:youtube.thumbnail/default :youtube.thumbnail/url])
                        :className "video--thumbnail"})
          (dom/div #js {:className "video--duration"} (duration-str (str duration))))
        (dom/div #js {:className "flex-column"}
          (dom/div #js {:className "video--title"}
            (dom/a #js {:href    "#"
                        :title   title
                        :onClick (pd #(om/transact! this `[(video/navigate {::video/id ~id})
                                                           (video/mark-watched {::video/id ~id})
                                                           (window/close)]))}
              title))
          (dom/div #js {:className "video--channel-title"} channel-title)

          (dom/div #js {:className "flex-space"})
          (dom/div #js {:className "video--actions"}
            (if-not watched?
              (dom/a #js {:className "video--action"
                          :href      "#"
                          :onClick   (pd #(om/transact! this `[(video/mark-watched {::video/id ~id})]))}
                (icon "ok"))
              (dom/a #js {:className "video--action"
                          :href      "#"
                          :onClick   (pd #(om/transact! this `[(video/mark-unwatched {::video/id ~id})]))}
                (icon "repeat")))
            #_(dom/a #js {:className "video--action"}
                (dom/a #js {:className "video--action"
                            :href      "#"
                            :onClick   (pd #(om/transact! this `[(video/mark-watched {::video/id ~id})
                                                                 (video/remove {::video/id ~id})]))}
                  (icon "remove")))))))))

(def queued-video (om/factory QueuedVideo))

(defn center-text [text]
  (dom/div #js {:className "loading-container"} text))

(om/defui ^:once Root
  static uc/InitialAppState
  (initial-state [_ _] {})

  static om/IQuery
  (query [_] [{:video/queue (get-load-query QueuedVideo)} :ui/react-key])

  Object
  (render [this]
    (let [{:keys [ui/react-key video/queue]} (om/props this)]
      (dom/div #js {:key react-key}
        (dom/div nil
          (dom/div #js {:className "main-actions-row"}
            (dom/div #js {:className "main-actions-title"} "Youtube Gmail Queue")
            (dom/div #js {:className "flex-space"})
            (dom/a #js {:href      "#"
                        :className "main-actions-row--reload"
                        :onClick   (pd #(df/load this :video/queue QueuedVideo {:params {:clear-cache true}}))}
              "Reload queue"))
          (if (df/loading? (:ui/fetch-state queue))
            (center-text "Loading video list...")
            (if (empty? queue)
              (center-text "No videos left to watch.")
              (mapv queued-video queue))))))))

(def root (om/factory Root))

(ns ygq.popup.ui
  (:require [om.next :as om]
            [om.dom :as dom]
            [goog.string :as gstr]
            [youtube.video :as video]
            [untangled.client.core :as uc]
            [untangled.client.mutations :refer [mutate]]
            [untangled.client.data-fetch :as df]
            [cljs.spec :as s]
            [clojure.string :as str]))

(defmethod mutate 'auth/token-received [{:keys [state]} _ {:keys [token]}]
  {:action (fn []
             (swap! state assoc :app/user-token token))})

(defmethod mutate 'youtube.video/navigate [_ _ {::video/keys [id]}]
  {:action (fn []
             (let [video-url (str "https://www.youtube.com/watch?v=" id)]
               (js/chrome.tabs.update #js {:url video-url})))})

(defmethod mutate 'youtube.video/mark-watched [{:keys [state ref]} _ {::video/keys [id]}]
  {:remote true
   :action (fn []
             (swap! state assoc-in [::video/by-id id ::video/watched?] true))})

(defmethod mutate 'youtube.video/mark-unwatched [{:keys [state ref]} _ {::video/keys [id]}]
  {:remote true
   :action (fn []
             (swap! state assoc-in [::video/by-id id ::video/watched?] false))})

(defmethod mutate 'window/close [_ _ _]
  {:action (fn []
             (js/console.log "Close window")
             (js/window.close))})

(defn pd [f]
  (fn [e]
    (.preventDefault e)
    (f e)))

(defn get-load-query [comp]
  (conj (om/get-query comp) :ui/fetch-state))

(defn icon [name]
  (dom/span #js {:className (str "glyphicon glyphicon-" name)}))

(defn duration-str [duration]
  (if-let [[h m s] (some->> (re-find #"(?:(\d+)H)?(?:(\d+)M)(?:(\d+)S)?$" duration)
                            next)]
    (let [items (->> (filter some? [h (or m 0) (or s 0)])
                     (map #(some-> % (gstr/padNumber 2))))]
      (str/join ":" items))))

(s/def ::duration string?)

(s/fdef duration-str
  :args (s/cat :duration ::duration)
  :ret (s/and string? #(re-find #"^(\d{2}:)?\d{2}:\d{2}$" %)))

(om/defui ^:once QueuedVideo
  static uc/InitialAppState
  (initial-state [_ title] {::video/id    (random-uuid)
                            ::video/title title})

  static om/IQuery
  (query [_] [::video/id
              ::video/watched?
              {::video/snippet
               [::video/title
                ::video/channel-title
                {::video/thumbnails
                 [{:youtube.thumbnail/default
                   [:youtube.thumbnail/url]}]}]}
              {::video/content-details
               [::video/duration]}])

  static om/Ident
  (ident [_ props] [::video/by-id (::video/id props)])

  Object
  (componentDidMount [this]
    (when-not (-> this om/props ::video/snippet)
      (df/load this (om/get-ident this) QueuedVideo
        {:parallel true})))

  (render [this]
    (let [{::video/keys [id snippet content-details watched?]} (om/props this)
          {::video/keys [title channel-title thumbnails]} snippet
          {::video/keys [duration]} content-details]
      (dom/div #js {:className (cond-> "video--row"
                                 watched? (str " video--row--watched"))}
        (dom/div #js {:className "video--thumbnail--container"}
          (dom/img #js {:src       (get-in thumbnails [:youtube.thumbnail/default :youtube.thumbnail/url])
                        :className "video--thumbnail"})
          (dom/div #js {:className "video--duration"} (duration-str (str duration))))
        (dom/div #js {:className "flex-column"}
          (dom/div #js {:className "video--title"}
            (dom/a #js {:href    "#"
                        :title   title
                        :onClick (pd #(om/transact! this `[(video/navigate {::video/id ~id})
                                                           (video/mark-watched {::video/id ~id})
                                                           (window/close)]))}
              title))
          (dom/div #js {:className "video--channel-title"} channel-title)

          (dom/div #js {:className "flex-space"})
          (dom/div #js {:className "video--actions"}
            (if-not watched?
              (dom/a #js {:className "video--action"
                          :href      "#"
                          :onClick   (pd #(om/transact! this `[(video/mark-watched {::video/id ~id})]))}
                (icon "ok"))
              (dom/a #js {:className "video--action"
                          :href      "#"
                          :onClick   (pd #(om/transact! this `[(video/mark-unwatched {::video/id ~id})]))}
                (icon "repeat")))
            #_(dom/a #js {:className "video--action"}
                (dom/a #js {:className "video--action"
                            :href      "#"
                            :onClick   (pd #(om/transact! this `[(video/mark-watched {::video/id ~id})
                                                                 (video/remove {::video/id ~id})]))}
                  (icon "remove")))))))))

(def queued-video (om/factory QueuedVideo))

(defn center-text [text]
  (dom/div #js {:className "loading-container"} text))

(om/defui ^:once Root
  static uc/InitialAppState
  (initial-state [_ _] {})

  static om/IQuery
  (query [_] [{:video/queue (get-load-query QueuedVideo)} :ui/react-key])

  Object
  (render [this]
    (let [{:keys [ui/react-key video/queue]} (om/props this)]
      (dom/div #js {:key react-key}
        (dom/div nil
          (dom/div #js {:className "main-actions-row"}
            (dom/div #js {:className "main-actions-title"} "Youtube Gmail Queue")
            (dom/div #js {:className "flex-space"})
            (dom/a #js {:href      "#"
                        :className "main-actions-row--reload"
                        :onClick   (pd #(df/load this :video/queue QueuedVideo {:params {:clear-cache true}}))}
              "Reload queue"))
          (if (df/loading? (:ui/fetch-state queue))
            (center-text "Loading video list...")
            (if (empty? queue)
              (center-text "No videos left to watch.")
              (mapv queued-video queue))))))))

(def root (om/factory Root))

Fix duration string parsing

Fix duration string parsing