clue-core.clj

(ns clue.core
  (:require [clj-http.client :as http]
            [clojure.spec :as s]))

(def client-key (System/getProperty "HUE_CLIENT_KEY"))
(def hue-api (System/getProperty "HUE_SERVER_ADDRESS"))

(def base-url (str "http://" hue-api "/api/" client-key))

(s/def :light/name (s/nilable string?))
(s/def :light/swconfigid string?)
(s/def :light/type #{"Extended color light"})
(s/def :light/swversion string?)
(s/def :light/modelid #(re-matches #"LCT\d\d\d" %))
(s/def :light/manufacturername #{"Philips"})
(s/def :light/id pos-int?)
(s/def :light/productid string?)
(s/def :light/uniqueid string?)

(s/def :state/hue (s/and int? #(>= 0) #(< % 65536)))
(s/def :state/reachable boolean?)
(s/def :state/xy (s/tuple double? double?))
(s/def :state/sat (s/and int? #(>= 0) #(< % 256)))
(s/def :state/alert #{"none" "select" "lselect"})
(s/def :state/colormode #{"hs" "xy" "ct"})
(s/def :state/on boolean?)
(s/def :state/effect #{"none" "colorloop"})
(s/def :state/bri (s/and int? #(>= 0) #(< % 256)))
(s/def :state/ct (s/and int? #(> % 152) #(< % 501)))

(s/def :light/state
  (s/keys
    :opt-un [:state/hue
             :state/reachable
             :state/xy
             :state/sat
             :state/alert
             :state/colormode
             :state/on
             :state/effect
             :state/bri
             :state/ct]))

;(s/def :light/transition)


(s/def ::light
  (s/keys
    :req-un [:light/name
             :light/type
             :light/swversion
             :light/state
             :light/modelid
             :light/manufacturername
             :light/id
             :light/uniqueid]
    :opt-un [:light/swconfigid
             :light/productid]))


(defn all-lights []
  (let [resp (-> (str base-url "/lights")
                 (http/get {:as :auto})
                 :body)]
    (->> resp
      (mapv (fn [[id light]]
              (assoc light :id (Long/valueOf (name id))))))))

;(s/fdef lights
;  :ret (s/coll-of ::light))

(defn light-named [ls light-name]
  (->> ls
       (filter #(= light-name (:name %)))
       (first)))

(s/fdef light-named
  :args (s/cat :ls (s/coll-of ::light) :light-name (s/nilable string?))
  :ret (s/nilable ::light))

(defn lights-named [names ls]
  (let [nameset (set names)]
    (filterv #(nameset (:name %)) ls)))

(defn rename [light light-name]
  (-> (str base-url "/lights/" (:id light))
      (http/post {:form-params {:name light-name :content-type :json :as :json}})
      :body))

(defn transition
  ([light state]
   (transition light state 4))
  ([light state transitiontime]
   (-> (str base-url "/lights/" (:id light) "/state")
       (http/put {:form-params (assoc state :transitiontime transitiontime)
                  :content-type :json
                  :as :json})
       :body)))



(defn transition-all [state lights]
  (map #(transition % state) lights))

(defn reload-light [light]
  (-> (str base-url "/lights/" (:id light))
      (http/get {:as :json})
      (assoc :id (:id light))))

(s/fdef transition
        :args (s/cat :light ::light :state :light/state))

(defn hsb->hue-hsb [hue sat bri]
  {:hue (-> hue (/ 360) (float) (* 65535) (long))
   :sat (-> sat (/ 100) (float) (* 255) (long))
   :bri (-> bri (/ 100) (float) (* 255) (long))})

(def orange
  (hsb->hue-hsb 32 85 18))

(def burnt-orange
  (hsb->hue-hsb 17 86 23))

(def blood-red
  (hsb->hue-hsb 0 89 32))

(def burgundy
  (hsb->hue-hsb 338 87 30))

(def brown
  (hsb->hue-hsb 31 90 16))

(def grey-pink
  (hsb->hue-hsb 41 32 20))

(def bright-white
  (hsb->hue-hsb 0 0 100))

(def cycle-colors
  (atom
    {:blood-red blood-red
     :brown brown
     :burgundy burgundy
     :burnt-orange burnt-orange
     :grey-pink grey-pink
     :orange orange}))

(defn everything-off []
  (->> (all-lights)
       (transition-all {:on false})))

(defn everything-on []
  (->> (all-lights)
       (transition-all {:on true})))

(def cycling?
  (atom true))

(defn rand-color []
  (-> @cycle-colors (vals) (vec) (rand-nth)))

(def sleep-time
  (atom 800))

(def lights
  (atom ["Living Room 1" "Living Room 2" "Nook 1" "Nook 2"]))

(def cycler (atom nil))

(defn color-cycle []
  (reset! cycling? true)
  (future
    (loop [idx 0]
      (if-not @cycling?
        (println "stopped cycling; exiting loop")
        (let [the-lights (->> (all-lights))
                              ;(lights-named @lights))
              light (get the-lights idx)
              color (rand-color)
              sleep-time @sleep-time]
          (println "setting" (:name light) "to" color ", then sleeping" sleep-time)
          (transition light color 10)
          (Thread/sleep sleep-time)
          (recur (-> idx (+ 1) (mod (count the-lights)))))))))