(ns one.application
  (:use [one.sample.api :only (remote-routes)])
  (:require [net.cgrand.enlive-html :as html]))

(defn- production-transform [h]
  (html/transform h
                  [:ul#navigation]
                  (html/substitute (html/html-snippet ))))

(def 
  config {:src-root "src"
          :app-root "src/app/cljs"
          :top-level-package "one"
          :js "public/javascripts"
          :dev-js-file-name "main.js"
          :prod-js-file-name "mainp.js"
          :dev-js ["goog.require('one.sample.core');"
                   "goog.require('one.sample.model');"
                   "goog.require('one.sample.controller');"
                   "goog.require('one.sample.history');"
                   "goog.require('one.sample.logging');"
                   "one.sample.core.start();one.sample.core.repl();"]
          :prod-js ["one.sample.core.start();"]
          :reload-clj ["/one/host_page"
                       "/one/reload"
                       "/one/templates"
                       "/one/sample/api"
                       "/one/application"
                       "/one/dev_server"]
          :prod-transform production-transform
          :api-routes remote-routes})

(ns one.sample.api
  (:use [compojure.core :only (defroutes POST)]))

(defonce ^:private next-id (atom 0))

(defonce ^:dynamic *database* (atom #{}))

(defmulti remote
  :fn)

(defmethod remote :default [data]
  {:status :error :message "Unknown endpoint."})

(defmethod remote :add-name [data]
  (let [n (-> data :args :name)
        response {:exists (contains? @*database* n)}]
    (swap! *database* conj n)
    response))

(defroutes remote-routes
  (POST "/remote" {{data "data"} :params}
        (pr-str
         (remote
          (binding [*read-eval* false]
            (read-string data))))))

(ns one.sample.prod-server
  (:use [ring.adapter.jetty :only (run-jetty)]
        [ring.middleware.file :only (wrap-file)]
        [ring.middleware.file-info :only (wrap-file-info)]
        [ring.middleware.params :only (wrap-params)]
        [ring.util.response :only (file-response)]
        [compojure.core :only (defroutes ANY)]
        [one.sample.api :only (remote-routes)]))

(def ^:private root "out/public")

(.mkdirs (java.io.File. "out/public"))

(defroutes app-routes
  remote-routes
  (-> (ANY "*" request (file-response "404.html" {:root root}))
      (wrap-file root)
      wrap-file-info))

(def ^:private app (-> app-routes
                       wrap-params))

(defn run-server []
  (let [port (Integer/parseInt (get (System/getenv) "PORT" "8080"))]
    (run-jetty (var app) {:join? false :port port})))

(ns one.sample.repl
  (:use [clojure.repl])
  (:require [one.tools :as tools]
            [one.dev-server :as dev]
            [clojure.java.browse :as browse]))

(defn go
  []
  (dev/run-server)
  (future (Thread/sleep 3000)
          (browse/browse-url "http://localhost:8080/development"))
  (tools/cljs-repl))

(defn dev-server
  []
  (dev/run-server)
  (future (Thread/sleep 3000)
          (browse/browse-url "http://localhost:8080")))

(defn cljs-repl
  []
  (tools/cljs-repl))

(println)
(println "Type (go) to launch the development server and setup a browser-connected REPL.")
(println "Type (dev-server) to launch only the development server.")
(println)

(ns script.build
  (:require [clojure.java.io :as io]
            [one.tools :as tools]
            [one.application :as config]))

(defn -main
  []
  (println "Creating out/public...")
  (.mkdir (io/file "out"))
  (tools/copy-recursive-into "public" "out")
  (tools/delete "out/public/index.html"
                "out/public/design.html"
                "out/public/javascripts")
  (.mkdir (io/file "out/public/javascripts"))
  (println "Create advanced compiled JavaScript...")
  (tools/build-project config/config))

(ns script.serve
  (:require [one.sample.prod-server :as prod]))

(defn -main
  []
  (prod/run-server))

(ns one.sample.snippets
  (:use [one.templates :only (render construct-html)])
  (:require [net.cgrand.enlive-html :as html]))

(defn- snippet [file id]
  (render (html/select (construct-html (html/html-resource file)) id)))

(defmacro snippets
  []
  {:form (snippet "form.html" [:div#form])
   :greeting (snippet "greeting.html" [:div#greeting])})

(ns leiningen.bootstrap
  (:use [leiningen.git-deps :only [git-deps]]
        [leiningen.core :only [default-repos]]
        [leiningen.deps :only [deps]]
        [leiningen.util.maven :only [container make-remote-artifact
                                     make-remote-repo make-local-repo]])
  (:import (org.apache.maven.artifact.resolver ArtifactResolver)))

(defn- standalone-download
  [name group version]
  (.resolveAlways (.lookup container ArtifactResolver/ROLE)
                  (make-remote-artifact name group version)
                  (map make-remote-repo default-repos)
                  (make-local-repo)))

(defn bootstrap
  [project]
  ;; Workarond for Leiningen 1.6.2 bug. Ensure that we have Clojure 1.2.1 in
  ;; the local maven repository.
  (standalone-download "clojure" "org.clojure" "1.2.1")
  (git-deps project)
  (deps project))

(ns leiningen.git-deps
  (:require [clojure.java.shell :as sh]
            [clojure.java.io :as io]
            [clojure.string :as string]))

(def ^{:private true
       :doc }
  git-deps-dir ".lein-git-deps")

(defn- directory-exists?
  [dir]
  (.isDirectory (io/file dir)))

(defn- default-clone-dir
  [uri]
  (string/join "." (-> uri
                       (string/split #"/")
                       (last)
                       (string/split #"\.")
                       butlast)))

(defn- exec
  [& args]
  (let [{:keys [exit out err] :as result} (apply sh/sh args)]
    (if (zero? exit)
      result
      (throw
       (Exception.
        (format "Command %s failed with exit code %s\n%s\n%s"
                (apply str (interpose " " args))
                exit
                out
                err))))))

(defn- git-clone
  [url dir-name working-dir]
  (apply exec (remove nil? ["git" "clone" url (str dir-name) :dir working-dir])))

(defn- git-checkout
  [commit dir]
  (println "Running git checkout " commit " in " (str dir))
  (exec "git" "checkout" commit :dir dir))

(defn- detached-head?
  [dir]
  (let [{out :out} (exec "git" "branch" "--no-color" :dir dir)
        lines (string/split-lines out)
        current-branch (first (filter #(.startsWith % "*") lines))]
    (when-not current-branch
      (throw (Exception. "Unable to determine current branch")))
    (= current-branch "* (no branch)")))

(defn- git-pull
  [dir]
  (println "Running git pull on " (str dir))
  (if (detached-head? dir)
    (do
      (println "Not on a branch, so fetching instead of pulling.")
      (exec "git" "fetch" :dir dir))
    (exec "git" "pull" :dir dir)))

(defn git-deps
  [project]
  (when-not (directory-exists? git-deps-dir)
    (.mkdir (io/file git-deps-dir)))
  (doseq [dep (:git-dependencies project)]
    (println "Setting up dependency for " dep)
    (let [[dep-url commit {clone-dir-name :dir}] dep
          commit (or commit "master")
          clone-dir-name (or clone-dir-name (default-clone-dir dep-url))
          clone-dir (io/file git-deps-dir clone-dir-name)]
      (if (directory-exists? clone-dir)
        (git-pull clone-dir)
        (git-clone dep-url clone-dir-name git-deps-dir))
      (git-checkout commit clone-dir))))

(ns 
  one.config)

(defn cljs-build-opts
  [config]
  {:output-to (str (:js config) "/" (:dev-js-file-name config))
   :output-dir (str (:js config) "/out")
   :libs (:libs config)
   :externs (:externs config)
   :foreign-libs (:foreign-libs config)})

(defn production-js
  [config]
  (str (:js config) "/" (:prod-js-file-name config)))

(ns one.dev-server
  (:use [ring.adapter.jetty :only (run-jetty)]
        [ring.middleware.file :only (wrap-file)]
        [ring.middleware.file-info :only (wrap-file-info)]
        [ring.middleware.params :only (wrap-params)]
        [ring.middleware.stacktrace :only (wrap-stacktrace)]
        [ring.util.response :only (file-response)]
        [compojure.core :only (defroutes GET POST ANY)]
        [cljs.repl :only (repl)]
        [cljs.repl.browser :only (repl-env)]
        [one.templates :only (load-html apply-templates render)]
        [one.host-page :only (application-host)]
        [one.application])
  (:require [net.cgrand.enlive-html :as html]
            [one.reload :as reload])
  (:import java.io.File))

(defn- environment [uri]
  (case uri
    "/development" :development
    "/production" :production
    "/fresh" :fresh))

(defn- make-host-page [request]
  {:status 200
   :headers {"Content-Type" "text/html; charset=utf-8"}
   :body (application-host config (environment (:uri request)))})

(defroutes app-routes
  (:api-routes config)
  (GET "/development" request (make-host-page request))
  (GET "/production" request (make-host-page request))
  (GET "/fresh" request (make-host-page request))
  (GET "/design*" {{file :*} :route-params}
       (when (.endsWith file ".html")
         (load-html (.substring file 1))))
  (ANY "*" request (file-response "404.html" {:root "public"})))

(defn- js-encoding [handler]
  (fn [request]
    (let [{:keys [headers body] :as response} (handler request)]
      (if (and (= (get headers "Content-Type") "text/javascript")
               (= (type body) File))
        (assoc-in response [:headers "Content-Type"]
                  "text/javascript; charset=utf-8")
        response))))

(defn- rewrite-design-uris [handler]
  (fn [{:keys [uri] :as request}]
    (if (some true? (map #(.startsWith uri (str "/design/" %))
                         ["css" "javascripts" "images" "js" "favicon.ico"]))
      (handler (assoc request :uri (.substring uri 7)))
      (handler request))))

(defn- html-parse
  [s]
  (html/html-resource (java.io.StringReader. s)))

(defn- active-menu-transform
  [menu response]
  (assoc response
    :body (render (html/transform (html-parse (:body response))
                                  [:ul#navigation (keyword (str "li." (name menu)))]
                                  (html/add-class "active")))))

(defn- set-active-menu
  [handler]
  (fn [request]
    (let [response (handler request)
          uri (:uri request)]
      (cond (= uri "/") (active-menu-transform :home response)
            (and (.startsWith uri "/design") (.endsWith uri ".html")) (active-menu-transform :design response)
            (= uri "/development") (active-menu-transform :development response)
            (= uri "/production") (active-menu-transform :production response)
            :else response))))

(def ^:private app (-> app-routes
                       (reload/watch-cljs config)
                       (wrap-file "public")
                       rewrite-design-uris
                       wrap-file-info
                       apply-templates
                       js-encoding
                       wrap-params
                       set-active-menu
                       wrap-stacktrace
                       (reload/reload-clj (:reload-clj config))))

(defn run-server
  []
  (run-jetty (var app) {:join? false :port 8080}))

(ns one.host-page
  (:use [one.templates :only (construct-html render)])
  (:require [net.cgrand.enlive-html :as html]))

(def ^:private script-snippet
  (html/html-snippet "<script type='text/javascript'></script>"))

(defn- script
  [f]
  (html/transform script-snippet [:script] f))

(defn- application-view
  [& scripts]
  (html/transform (construct-html (html/html-resource "application.html"))
                  [:body]
                  (apply html/append scripts)))

(defn application-host
  [config environment]
  (render
   (case environment
     :development
     (apply application-view (script (html/set-attr :src "javascripts/out/goog/base.js"))
            (script (html/set-attr :src "javascripts/main.js"))
            (map #(script (html/content %)) (:dev-js config)))
     :production
     (let [tfn (get config :prod-transform identity)]
       (tfn (apply application-view
                   (script (html/set-attr :src (str "javascripts/"
                                                    (:prod-js-file-name config))))
                   (map #(script (html/content %)) (:prod-js config)))))
     :fresh
     (apply application-view (script (html/set-attr :src "javascripts/out/goog/base.js"))
            (script (html/set-attr :src "javascripts/fresh.js"))
            (script (html/content "goog.require('one.browser.repl_client');"))
            (script (html/content "one.browser.repl_client.repl();"))))))

(ns one.reload
  (:use [cljs.closure :only (build)]
        [one.config])
  (:require [clojure.java.io :as io]))

(defonce ^:private
  last-compile (atom {}))

(defn- any-modified
  [k files]
  (let [newest (apply max
                      (map #(.lastModified %) files))]
    (when (> newest (get @last-compile k 0))
      newest)))

(defn- descendants-ending-with
  [dir ext]
  (filter #(.endsWith (.getName %) ext) (file-seq (io/file dir))))

(defn- any-modified-cljs
  [dir k]
  (let [files (filter #(.isFile %) (into (descendants-ending-with dir ".cljs")
                                         (file-seq (io/file "templates"))))]
    (any-modified k files)))

(defn watch-cljs 
  [handler config]
  (fn [request]
    (let [k (:uri request)
          ts (any-modified-cljs (:src-root config) k)]
      (when ts
        (swap! last-compile assoc k ts)
        (let [build-opts (cljs-build-opts config)]
          (doseq [file (file-seq (io/file (str (:output-dir build-opts) "/"
                                               (:top-level-package config))))]
            (.setLastModified file 0))
          (build (:app-root config) (cond (= (:uri request) "/production")
                                          (assoc build-opts :optimizations :advanced
                                                 :output-to (production-js config))
                                          (= (:uri request) "/fresh")
                                          (assoc build-opts :output-to (str (:js config) "/fresh.js"))
                                          :default build-opts)))))
    (handler request)))

(defn- any-modified-clj
  [files]
  (any-modified "clj"
                (map #(-> (str % ".clj")
                          (.substring 1)
                          io/resource
                          (.getFile)
                          io/file)
                     files)))

(defn reload-clj
  [handler files]
  (fn [request]
    (when-let [ts (any-modified-clj files)]
      (swap! last-compile assoc "clj" ts)
      (let [ns (ns-name *ns*)]
        (apply load files)))
    (handler request)))

(ns one.templates
  (:use net.cgrand.enlive-html)
  (:import java.io.File))

(defn render
  [t]
  (apply str (emit* t)))

(declare construct-html)

(defn- html-body [name]
  (:content (first (select (html-resource name) [:body]))))

(defn- include-html [h]
  (let [includes (select h [:_include])]
    (loop [h h
           includes (seq includes)]
      (if includes
        (let [file (-> (first includes) :attrs :file)
              include (construct-html (html-body file))]
          (recur (transform h [[:_include (attr= :file file)]] (substitute include))
                 (next includes)))
        h))))

(defn- maps [c] (filter map? c))

(defn- replace-html [h c]
  (let [id (-> c :attrs :id)
        tag (:tag c)
        selector (keyword (str (name tag) "#" id))]
    (transform h [selector] (substitute c))))

(defn- wrap-html [h]
  (let [within (seq (select h [:_within]))]
    (if within
      (let [file (-> (first within) :attrs :file)
            outer (construct-html (html-resource file))
            content (maps (:content (first within)))]
        (loop [outer outer
               content (seq content)]
          (if content
            (recur (replace-html outer (first content)) (next content))
            outer)))
      h)))

(defn construct-html
  [nodes]
  (wrap-html (include-html nodes)))

(defn load-html
  [file]
  (render (construct-html (html-resource file))))

(defn apply-templates
  [handler]
  (fn [request]
    (let [{:keys [headers body] :as response} (handler request)]
      (if (and (= (type body) File)
               (.endsWith (.getName body) ".html"))
        (let [new-body (render (construct-html (html-snippet (slurp body))))]
          {:status 200
           :headers {"Content-Type" "text/html; charset=utf-8"}
           :body new-body})
        response))))

(ns one.test
  (:refer-clojure :exclude [load-file])
  (:require [cljs.repl.browser :as browser])
  (:use [cljs.compiler :only (namespaces)]
        [cljs.repl :only (evaluate-form load-file load-namespace)]
        [clojure.java.browse :only (browse-url)]
        [cljs.repl :only (-setup -tear-down)]
        [one.dev-server :only (run-server)]))

(def ^:dynamic *eval-env*)

(defn evaluate-cljs
  ([eval-env form]
     (evaluate-cljs eval-env 'cljs.user form))
  ([eval-env ns form]
     (let [env {:context :statement :locals {}}]
       (cond
        (and (seq? form) ('#{load-file clojure.core/load-file} (first form)))
        (load-file eval-env (second form))
        (and (seq? form) ('#{load-namespace} (first form)))
        (load-namespace eval-env (second form))
        :else
        (let [ret (evaluate-form eval-env
                                 (assoc env :ns (@namespaces ns))
                                 "<testing>"
                                 form
                                 (fn [x] `(cljs.core.pr-str ~x)))]
          (try (read-string ret)
               (catch Exception e
                 (if (string? ret)
                   ret
                   nil))))))))

(defn cljs-wait-for*
  [eval-env pred ns form remaining]
  (if (pos? remaining)
    (if-let [result (pred (evaluate-cljs eval-env ns form))]
      result
      (do (Thread/sleep 10)
          (recur eval-env pred ns form (- remaining 10))))
    (throw (Exception.
            (str "Form "
                 form
                 " did not satisfy predicate before the timeout expired.")))))

(defmacro cljs-wait-for
  [pred ns form]
  `(cljs-wait-for* *eval-env* ~pred (quote ~ns) (quote ~form) 60000))

(defn ensure-ns-loaded
  ([eval-env ns] (ensure-ns-loaded eval-env ns 60000))
  ([eval-env ns remaining]
     (if (pos? remaining)
       (if (evaluate-cljs eval-env (list 'boolean ns))
         true
         (do (Thread/sleep 10)
             (recur eval-env ns (- remaining 10))))
       (throw (Exception. (str "Namespace " ns " did not load before the timeout expired."))))))

(defmacro cljs-eval
  [ns & forms]
  `(do
     (ensure-ns-loaded *eval-env* (quote ~ns))
     ~@(map (fn [x] `(evaluate-cljs *eval-env* (quote ~ns) (quote ~x))) forms)))

(defn within-browser-env
  ([f] (within-browser-env "http://localhost:8080/development" nil f))
  ([url init f]
     (let [server (run-server)
           eval-env (browser/repl-env)]
       (-setup eval-env)
       (browse-url url)
       (binding [*eval-env* eval-env]
         (when init (init))
         (f))
       (-tear-down eval-env)
       (.stop server))))

(defmacro js-ns
  [ns env-fn url]
  `(do (def ~'js-test-namespace (quote ~ns))
       (def ~'js-functions (atom []))
       (~'use-fixtures :once (partial ~env-fn ~url
                                    (fn [] (do (cljs-eval cljs.user (~'load-namespace (quote ~ns)))
                                              (doseq [f# @~'js-functions]
                                                (f#))))))))

(defn- test-namespace
  []
  (let [test-ns-var (symbol (str *ns*) "js-test-namespace")]
    (var-get (find-var test-ns-var))))

(defmacro js-defn
  [name & body]
  (let [[doc-string args & body] (if (string? (first body))
                                   body
                                   (conj body ""))]
    `(swap! ~'js-functions conj
          (fn [] (cljs-eval ~(test-namespace) (defn ~name ~args ~@body))))))

(defmacro js
  [form]
  `(cljs-eval ~(test-namespace) ~form))

(ns one.tools
  (:use [cljs.closure :only (build)]
        [one.host-page :only (application-host)]
        [one.config :only (cljs-build-opts production-js)]
        [cljs.repl :only (repl)]
        [cljs.repl.browser :only (repl-env)])
  (:require [clojure.java.io :as io]))

(defn build-project
  [config]
  (build (:app-root config) (assoc (cljs-build-opts config)
                              :optimizations :advanced
                              :output-to (str "out/" (production-js config))))
  (spit "out/public/index.html" (application-host config :production)))

(defn cljs-repl
  []
  (repl (repl-env)))

(defn copy-recursive-into
  [src dest]
  (doseq [file (remove #(.isDirectory %) (file-seq (io/file src)))]
    (let [dest-file (io/file dest file)]
      (.mkdirs (.getParentFile dest-file))
      (io/copy file dest-file))))

(defn delete
  [& paths]
  (doseq [path paths
          file (reverse (file-seq (io/file path)))]
    (.delete file)))

(ns script.docs
  (:require [net.cgrand.enlive-html :as html]
            [clojure.java.io :as io]))

(defn- uberdoc-content
  [file]
  (-> (io/file file)
      html/html-resource
      (html/select [:body])
      first
      :content))

(defn- docs
  [template marg]
  (-> (io/file template)
      html/html-resource
      (html/transform [:div#marginalia-documentation]
                      (html/substitute marg))))

(defn -main
  []
  (let [marg (uberdoc-content "docs/uberdoc.html")
        docs (docs "script/documentation.html" marg)]
    (spit "docs/documentation.html"
          (apply str (html/emit* docs)))))

(ns 
  one.sample.animation
  (:use [one.core :only (start)]
        [one.browser.animation :only (bind parallel serial play play-animation)]
        [domina :only (by-id set-html! set-styles! destroy-children! append! single-node)]
        [domina.xpath :only (xpath)])
  (:require [goog.dom.forms :as gforms]
            [goog.style :as style]))

(def form "//div[@id='form']")
(def cloud "//div[@id='greeting']")
(def label "//label[@id='name-input-label']/span")

(def ^:private
  form-in {:effect :fade :start 0 :end 1 :time 800})

(defn initialize-views
  [form-html greeting-html]
  (let [content (xpath "//div[@id='content']")]
    (destroy-children! content)
    (set-html! content form-html)
    (append! content greeting-html)
    ;; Required for IE8 to work correctly
    (style/setOpacity (single-node (xpath label)) 1)
    (set-styles! (xpath cloud) {:opacity "0" :display "none" :margin-top "-500px"})
    (set-styles! (by-id "greet-button") {:opacity "0.2" :disabled true})
    (play form form-in {:after #(.focus (by-id "name-input") ())})))

(comment ;; Try it

  (initialize-views (:form one.sample.view/snippets)
                    (:greeting one.sample.view/snippets))
  
  )

(defn label-move-up
  [label]
  (play label [{:effect :color :end "#53607b" :time 200}
               {:effect :slide :up 40 :time 200}]))

(defn label-fade-out
  [label]
  (play label {:effect :fade :end 0 :time 200}))

(def move-down [{:effect :fade :end 1 :time 200}
                {:effect :color :end "#BBC4D7" :time 200}
                {:effect :slide :down 40 :time 200}])

(def fade-in {:effect :fade :end 1 :time 400})

(def fade-out {:effect :fade :end 0 :time 400})

(defn label-move-down
  [label]
  (play label move-down))

(comment ;; Examples of label effects.
  
  (label-move-up label)
  (label-fade-out label)
  (label-move-down label)
  )

(defn show-greeting
  []
  (let [e {:effect :fade :end 0 :time 500}]
    (play-animation #(parallel (bind form e)
                               (bind label e) ; Since the label won't fade in IE
                               (bind cloud
                                     {:effect :color :time 500} ; Dummy animation for delay purposes
                                     {:effect :fade-in-and-show :time 600}))
                    {:before #(gforms/setDisabled (by-id "name-input") true)
                     ;; We need this next one because IE8 won't hide the button
                     :after #(set-styles! (by-id "greet-button") {:display "none"})})))

(defn show-form
  []
  (play-animation (serial (parallel (bind cloud {:effect :fade-out-and-hide :time 500})
                                    (bind form
                                          {:effect :color :time 300} ; Dummy animation for delay purposes
                                          form-in)
                                    (bind label fade-in move-down)))
                  {;; Because IE8 won't hide the button, we need to
                   ;; toggle it between displaying inline and none
                   :before #(set-styles! (by-id "greet-button") {:display "inline"})
                   :after #(do
                             (gforms/setDisabled (by-id "name-input") false)
                             (.focus (by-id "name-input") ()))}))

(comment ;; Switch between greeting and form views

  (label-move-up label)
  (show-greeting)
  (show-form)
  )

(defn disable-button
  [id]
  (let [button (by-id id)]
    (gforms/setDisabled button true)
    (play button {:effect :fade :end 0.2 :time 400})))

(defn enable-button
  [id]
  (let [button (by-id id)]
    (gforms/setDisabled button false)
    (play button fade-in)))

(comment ;; Examples of all effects

  (initialize-views (:form one.sample.view/snippets)
                    (:greeting one.sample.view/snippets))
  (label-move-up label)
  (label-fade-out label)
  (show-greeting)
  (show-form)

  (disable-button "greet-button")
  (enable-button "greet-button")
  )

(ns 
  one.sample.controller
  (:use [one.browser.remote :only (request)]
        [one.sample.model :only (state)])
  (:require [cljs.reader :as reader]
            [clojure.browser.event :as event]
            [one.dispatch :as dispatch]
            [goog.uri.utils :as uri]))

(defmulti action
  :type)

(defmethod action :init [_]
  (reset! state {:state :init}))

(defmethod action :form [_]
  (when-not (#{:form :init} (:state @state))
    (swap! state assoc :state :form)))

(defn host
  []
  (uri/getHost (.toString window.location ())))

(defn remote
  [f data on-success]
  (request f (str (host) "/remote")
           :method "POST"
           :on-success #(on-success (reader/read-string (:body %)))
           :on-error #(swap! state assoc :error "Error communicating with server.")
           :content (str "data=" (pr-str {:fn f :args data}))))

(defn add-name-callback
  [name response]
  (swap! state (fn [old]
                 (assoc (assoc old :state :greeting :name name)
                   :exists (boolean (:exists response))))))

(defmethod action :greeting [{name :name}]
  (remote :add-name {:name name} #(add-name-callback name %)))

(dispatch/react-to #{:init :form :greeting}
                   (fn [t d] (action (assoc d :type t))))

(ns 
  one.sample.core
  (:require [one.browser.repl-client :as repl-client]
            [one.dispatch :as dispatch]
            [one.sample.view :as view]))

(defn ^:export repl
  []
  (repl-client/repl))

(defn ^:export start
  []
  (dispatch/fire :init))

(ns 
  one.sample.history
  (:require [one.dispatch :as dispatch]
            [one.browser.history :as history]))

(defn nav-handler
  [{:keys [token navigation?]}]
  (when navigation?
    (dispatch/fire token)))

(def 
  history (history/history nav-handler))

(dispatch/react-to #{:init :form :greeting}
                   (fn [t _]
                     (history/set-token history (if (#{:init} t) :form t))))

(ns 
  one.sample.logging
  (:require [one.dispatch :as dispatch]
            [one.logging :as log]))

(def 
  logger (log/get-logger "events"))

(dispatch/react-to (constantly true)
                   (fn [t d] (log/info logger (str (pr-str t) " - " (pr-str d)))))

(comment
  ;; log to the console
  (log/start-display (log/console-output))
  ;; log to to the "fancy" window
  (log/start-display (log/fancy-output "main"))
  ;; change the logging level
  (log/set-level logger :fine)
  )

(ns 
 one.sample.model
  (:require [one.dispatch :as dispatch]))

(def 
  state (atom {}))

(add-watch state :state-change-key
           (fn [k r o n]
             (dispatch/fire :state-change n)))

(def ^{:private true
       :doc }
  greeting-form (atom {}))

(add-watch greeting-form :form-change-key
           (fn [k r o n]
             (dispatch/fire :form-change {:old o :new n})))

(defmulti ^:private new-status
  (fn [& args] (vec args)))

(def error-status
  {:status :error
   :error "Are you sure about that? Names must have at least two characters."})

(def editing-error-status
  {:status :editing-error
   :error "Names must have at least two characters."})

(defmethod new-status [:empty :focus :empty] [p e f]
  {:status :editing})

(defmethod new-status [:editing :finished :empty] [p e f]
  {:status :empty})

(defmethod new-status [:editing :change :empty] [p e f]
  {:status :editing})

(defmethod new-status [:editing :change :error] [p e f]
  {:status :editing})

(defmethod new-status [:editing :change :valid] [p e f]
  {:status :editing-valid})

(defmethod new-status [:editing :finished :error] [p e f]
  error-status)

(defmethod new-status [:editing-valid :change :error] [p e f]
  {:status :editing})

(defmethod new-status [:editing-valid :change :valid] [p e f]
  {:status :editing-valid})

(defmethod new-status [:editing-valid :finished :valid] [p e f]
  {:status :valid})

(defmethod new-status [:error :focus :error] [p e f]
  editing-error-status)

(defmethod new-status [:editing-error :change :error] [p e f]
  editing-error-status)

(defmethod new-status [:editing-error :finished :error] [p e f]
  error-status)

(defmethod new-status [:editing-error :change :valid] [p e f]
  {:status :editing-valid})

(defmethod new-status [:editing-error :change :empty] [p e f]
  {:status :editing-error})

(defmethod new-status [:editing-error :finished :empty] [p e f]
  {:status :empty})

(defmethod new-status [:valid :focus :valid] [p e f]
  {:status :editing-valid})

(defmethod new-status [:valid :finished :empty] [p e f]
  {:status :empty})

(defmethod new-status :default [p e f]
  {:status p})

(defmulti ^:private validate
  (fn [id _] id))

(defmethod validate "name-input" [_ v]
  (cond (= (count v) 0) :empty
        (= (count v) 1) :error
        :else :valid))

(defn- form-status
  [m]
  (if (every? #(or (= % :valid) (= % :editing-valid)) (map :status (vals (:fields m))))
    :finished
    :editing))

(defn- set-field-value
  [field-id type value]
  (swap! greeting-form
         (fn [old]
           (let [field (get (:fields old) field-id {})
                 field-status (assoc (new-status (-> old :fields field-id :status)
                                                 type
                                                 (validate field-id value))
                                :value value)
                 new (assoc-in old [:fields field-id] field-status)]
             (assoc new :status (form-status new))))))

(defn- set-editing
  [id]
  (swap! greeting-form
         (fn [old]
           (let [field-map (-> old :fields id)
                 status (or (:status field-map) :empty)
                 field-status (new-status status
                                          :focus
                                          status)]
             (-> old
                 (assoc-in [:fields id] (assoc field-status :value (:value field-map)))
                 (assoc :status (form-status old)))))))

(dispatch/react-to (fn [e] (= (first e) :field-finished))
                   (fn [[_ id] value]
                     (set-field-value id :finished value)))

(dispatch/react-to (fn [e] (= (first e) :field-changed))
                   (fn [[_ id] value]
                     (set-field-value id :change value)))

(dispatch/react-to (fn [e] (= (first e) :editing-field))
                   (fn [[_ id] _]
                     (set-editing id)))

(dispatch/react-to #{:form-submit}
  (fn [t d]
    (let [form-data @greeting-form]
      (when (= (:status form-data) :finished)
        (dispatch/fire :greeting {:name (-> form-data :fields "name-input" :value)})))))

(ns 
  one.sample.view
  (:use [domina :only (set-html! set-styles! styles by-id set-style!
                       by-class value set-value! set-text! nodes single-node)]
        [domina.xpath :only (xpath)]
        [one.browser.animation :only (play)])
  (:require-macros [one.sample.snippets :as snippets])
  (:require [goog.events.KeyCodes :as key-codes]
            [goog.events.KeyHandler :as key-handler]
            [clojure.browser.event :as event]
            [one.dispatch :as dispatch]
            [one.sample.animation :as fx]))

(def 
  snippets (snippets/snippets))

(defmulti render-button
  identity)

(defmethod render-button :default [_])

(defmethod render-button [:finished :editing] [_]
  (fx/disable-button "greet-button"))

(defmethod render-button [:editing :finished] [_]
  (fx/enable-button "greet-button"))

(defmulti render-form-field
  :transition)

(defmethod render-form-field :default [_])

(defn- label-xpath
  [id]
  (str "//label[@id='" id "-label']/span"))

(defmethod render-form-field [:empty :editing] [{:keys [id]}]
  (fx/label-move-up (label-xpath id)))

(defmethod render-form-field [:editing :empty] [{:keys [id]}]
  (fx/label-move-down (label-xpath id)))

(defmethod render-form-field [:editing-valid :valid] [{:keys [id]}]
  (fx/label-fade-out (label-xpath id)))

(defmethod render-form-field [:valid :editing-valid] [{:keys [id]}]
  (play (label-xpath id) fx/fade-in))

(defmethod render-form-field [:editing :error] [{:keys [id error]}]
  (let [error-element (by-id (str id "-error"))]
    (set-style! error-element "opacity" "0")
    (set-html! error-element error)
    (play error-element fx/fade-in)))

(defn- swap-error-messages
  [id error]
  (let [error-element (by-id (str id "-error"))]
    (play error-element fx/fade-out
             {:name "fade out error"})
    (play error-element fx/fade-in {:before #(set-html! error-element error)})))

(defmethod render-form-field [:error :editing-error] [{:keys [id error]}]
  (swap-error-messages id error))

(defmethod render-form-field [:editing-error :error] [{:keys [id error]}]
  (swap-error-messages id error))

(defmethod render-form-field [:editing-error :editing-valid] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))))

(defmethod render-form-field [:editing-error :empty] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))
    (fx/label-move-down (label-xpath id))))

(defn- add-input-event-listeners
  [field-id]
  (let [field (by-id field-id)
        keyboard (goog.events.KeyHandler. (by-id "form"))]
    (event/listen field
                  "blur"
                  #(dispatch/fire [:field-finished field-id] (value field)))
    (event/listen field
                  "focus"
                  #(dispatch/fire [:editing-field field-id]))
    (event/listen field
                  "keyup"
                  #(dispatch/fire [:field-changed field-id] (value field)))
    (event/listen keyboard
                  "key"
                  (fn [e] (when (= (.-keyCode e) key-codes/ENTER)
                           (do (.blur (by-id "name-input") ())
                               (dispatch/fire :form-submit)))))))

(defmulti render
  :state)

(defmethod render :init [_]
  (fx/initialize-views (:form snippets) (:greeting snippets))
  (add-input-event-listeners "name-input")
  (event/listen (by-id "greet-button")
                "click"
                #(dispatch/fire :greeting
                                {:name (value (by-id "name-input"))})))

(defmethod render :form [{:keys [state error name]}]
  (fx/show-form)
  (set-value! (by-id "name-input") "")
  (dispatch/fire [:field-finished "name-input"] ""))

(defmethod render :greeting [{:keys [state name exists]}]
  (set-text! (single-node (by-class "name")) name)
  (set-text! (single-node (by-class "again")) (if exists "again" ""))
  (fx/show-greeting))

(dispatch/react-to #{:state-change} (fn [_ m] (render m)))

(defn- form-fields-status
  [m]
  (map #(hash-map :id %
                  :transition [(or (-> m :old :fields % :status) :empty)
                               (-> m :new :fields % :status)]
                  :error (-> m :new :fields % :error))
       (keys (-> m :new :fields))))

(dispatch/react-to #{:form-change}
                   (fn [_ m]
                     (doseq [s (form-fields-status m)]
                       (render-form-field s))
                     (render-button [(-> m :old :status)
                                     (-> m :new :status)] )))

(ns 
  one.browser.animation
  (:use [one.color :only (color bg-color rgb IColorSource)]
        [one.core :only (start dispose get-style)])
  (:require [goog.style :as style]
            [goog.string :as gstring]
            [goog.fx.AnimationQueue :as queue]
            [goog.fx.easing :as easing]
            [goog.fx.dom :as anim]
            [goog.async.Delay :as delay]
            [clojure.browser.event :as event]
            [clojure.browser.dom :as dom]
            [domina :as d]
            [domina.xpath :as dx]))

(def ^:dynamic *default-time* 1000)

(defn- get-element
  [e]
  (cond (keyword? e) (d/by-id (name e))
        (string? e) (first (d/nodes (dx/xpath e)))
        :else e))

(defprotocol IPosition
  (position [this] "Return the position of the passed object as a 2D array, `[X Y]`."))

(extend-protocol IPosition

  cljs.core.Vector
  (position [this] this)

  js/Array
  (position [this] (js->clj this))

  js/Element
  (position [this]
    (let [p (js->clj (style/getPosition this) :keywordize-keys true)]
      [(:x p) (:y p)])))

(defprotocol IScroll
  (scroll [this] "Return the scroll position of an element as `[X Y]`."))

(extend-protocol IScroll

  js/Number
  (scroll [this] [0 this])

  cljs.core.Vector
  (scroll [this] this)

  js/Element
  (scroll [this]
    [(.-scrollLeft this) (.-scrollTop this)]))

(defprotocol ISize
  (size [this] "Return the size of an element as `[W H]`.")
  (width [this] "Return the width of an element.")
  (height [this] "Return the height of an element."))

(extend-protocol ISize

  js/Number
  (size [this] [this this])
  (width [this] this)
  (height [this] this)

  cljs.core.Vector
  (size [this] this)
  (width [this] (first this))
  (height [this] (second this))

  js/Element
  (size [this]
    (let [s (js->clj (style/getSize this)
                     :keywordize-keys true)]
      [(:width s) (:height s)]))
  (width [this]
    (width (size this)))
  (height [this]
    (height (size this))))

(defprotocol IOpacity
  (opacity [this] "Return the elements current opacity."))

(extend-protocol IOpacity

  js/String
  (opacity [this]
    (js/parseFloat this))

  js/Number
  (opacity [this] this)

  js/Element
  (opacity [this]
    (let [op (style/getComputedStyle this "opacity")]
      (if (= op "")
        (opacity (style/getOpacity this))
        op))))

(extend-type goog.fx.AnimationQueue
  
  one.core/Startable
  (start [this] (.play this ()))
  
  one.core/Disposable
  (dispose [this] (.dispose this ())))

(extend-type goog.fx.dom.PredefinedEffect
  
  one.core/Startable
  (start [this] (.play this ()))
  
  one.core/Disposable
  (dispose [this] (.dispose this ()))
  
  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (. k (toLowerCase)))
              v])
           (merge (js->clj goog.fx.Animation.EventType))))))

(defmulti acceleration
  identity :default :ease-out)

(defmethod acceleration :ease-out [name]
  easing/easeOut)

(defmethod acceleration :ease-in [name]
  easing/easeIn)

(defmethod acceleration :in-and-out [name]
  easing/inAndOut)

(defn- accel
  [m]
  (when-let [a (:accel m)]
    (if (fn? a)
      a
      (acceleration a))))

(defrecord Effect [effect start end time accel]
  one.color.IColorSource
  (color [this] (:end this))
  (bg-color [this] (:end this))
  IOpacity
  (opacity [this] (:end this))
  IPosition
  (position [this] (:end this))
  ISize
  (size [this] (:end this))
  (width [this] (width (:end this)))
  (height [this] (height (:end this)))
  IScroll
  (scroll [this] (:end this)))

(defn- effect-dispatch
  [_ {effect :effect}] effect)

(defmulti standardize
  effect-dispatch)

(defmethod standardize :color [element m]
  (Effect. :color
           (color (or (:start m) element))
           (color (or (:end m) element))
           (or (:time m) *default-time*)
           (accel m)))

(defmulti effect
  effect-dispatch)

(defmethod effect :color [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.ColorTransform. element
                                 (apply array (rgb start))
                                 (apply array (rgb end))
                                 time
                                 accel)))

(comment ;; Color effect examples
  (def label (get-element "//label[@id='name-input-label']/span"))
  (def label-color (color label))
  (def red [255 0 0])
  (def green [0 255 0])
  (start (effect label {:effect :color :end red}))
  (start (effect label {:effect :color :end green}))
  (start (effect label {:effect :color :end label-color}))
  (start (bind label
               {:effect :color :end red}
               {:effect :color :end green}
               {:effect :color :end label-color})))

(defmethod standardize :fade [element m]
  (Effect. :fade
           (opacity (or (:start m) element))
           (opacity (:end m))
           (or (:time m) *default-time*)
           (accel m)))

(defmethod effect :fade [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Fade. element start end time accel)))

(defmethod standardize :fade-in [element m]
  (Effect. :fade-in 0 1 (or (:time m) *default-time*) (accel m)))

(defmethod effect :fade-in [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeIn. element time accel)))

(defmethod standardize :fade-out [element m]
  (Effect. :fade-out 1 0 (or (:time m) *default-time*) (accel m)))

(defmethod effect :fade-out [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeOut. element time accel)))

(defmethod standardize :fade-in-and-show [element m]
  (Effect. :fade-in-and-show 0 1 (or (:time m) *default-time*) (accel m)))

(defmethod effect :fade-in-and-show [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeInAndShow. element time accel)))

(defmethod standardize :fade-out-and-hide [element m]
  (Effect. :fade-out-and-hide 1 0 (or (:time m) *default-time*) (accel m)))

(defmethod effect :fade-out-and-hide [element m]
  (let [{:keys [time accel]} (standardize element m)]
    (goog.fx.dom.FadeOutAndHide. element time accel)))

(comment ;; Fade effect examples
  (def label (get-element "//label[@id='name-input-label']/span"))
  (def title (get-element "//div[@id='form']/h1"))
  (def title-opacity (opacity title))
  (def label-opacity (opacity label))
  (start (effect label {:effect :fade :end 0.2}))
  (start (effect title {:effect :fade :end label}))
  (start (effect label {:effect :fade :end label-opacity}))
  (start (effect title {:effect :fade :end title-opacity}))
  (start (effect label {:effect :fade-out}))
  (start (effect label {:effect :fade-in}))
  (start (effect label {:effect :fade-out-and-hide}))
  (start (effect label {:effect :fade-in-and-show}))
  (start (bind label
               {:effect :fade :end 0 :time 2000}
               {:effect :fade :end 1 :time 2000}))
  ;; mix fade effects - cannot mix both fade-in-and-show and
  ;; fade-out-and-hide in the same animation.
  (start (apply bind label
                (map #(assoc % :time 2000)
                     [{:effect :fade-out}
                      {:effect :fade :end 1}
                      {:effect :fade :end 0}
                      {:effect :fade-in}
                      {:effect :fade :end 0}
                      {:effect :fade :end 1}]))))

(defmethod standardize :bg-color [element m]
  (let [start (or (:start m) element)
        end (or (:end m) element)]
    (Effect. :bg-color
             (bg-color start)
             (bg-color end)
             (or (:time m) *default-time*)
             (accel m))))

(defmethod effect :bg-color [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.BgColorTransform. element
                                   (apply array (rgb start))
                                   (apply array (rgb end))
                                   time
                                   accel)))

(comment ;; Background color effect examples
  (def input (get-element :name-input))
  (def red [255 0 0])
  (def green [0 255 0])
  (def input-bg-color (bg-color input))
  (def input-color (color input))
  (start (effect input {:effect :bg-color :end red}))
  (start (effect input {:effect :bg-color :end green}))
  (start (effect input {:effect :bg-color :end input-bg-color}))
  (start (bind input
               {:effect :bg-color :end red}
               {:effect :bg-color :end green}
               {:effect :bg-color :end input-bg-color})))

(defn- calculate-slide-end
  [[x y] m]
  (vector (+ (- x (:left m 0)) (:right m 0))
          (+ (- y (:up m 0)) (:down m 0))))

(defmethod standardize :slide [element m]
  (let [start (position (or (:start m) element))
        end (or (:end m) (calculate-slide-end start m))]
    (Effect. :slide
             start
             end
             (or (:time m) *default-time*)
             (accel m))))

(defmethod effect :slide [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Slide. element
                        (apply array start)
                        (apply array end)
                        time
                        accel)))

(comment ;; Slide effect examples
  (def label (get-element "//label[@id='name-input-label']/span"))
  (start (effect label {:effect :slide :up 40 :time 100}))
  (start (effect label {:effect :slide :down 40 :time 100}))
  ;; Easing examples
  (start (effect label {:effect :slide :up 200 :accel :ease-out}))
  (start (effect label {:effect :slide :down 200 :accel :ease-in}))
  ;; slide up and then down
  (start (bind label
               {:effect :slide :up 200 :time 2000 :accel :ease-out}
               {:effect :slide :down 200 :time 2000 :accel :ease-in})))

(defmethod standardize :resize-height [element m]
  (let [start (when-let [h (:start m)] [(width element) (height h)])
        end (when-let [h (:end m)] [(width element) (height h)])]
    (Effect. :resize-height
            (size (or start element))
            (size (or end element))
            (or (:time m) *default-time*)
            (accel m))))

(defmethod effect :resize-height [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.ResizeHeight. element (height start) (height end) time accel)))

(defmethod standardize :resize-width [element m]
  (let [start (when-let [w (:start m)] [(width w) (height element)])
        end (when-let [w (:end m)] [(width w) (height element)])]
    (Effect. :resize-width
            (size (or start element))
            (size (or end element))
            (or (:time m) *default-time*)
            (accel m))))

(defmethod effect :resize-width [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.ResizeWidth. element (width start) (width end) time accel)))

(defmethod standardize :resize [element m]
  (Effect. :resize
           (size (or (:start m) element))
           (size (or (:end m) element))
           (or (:time m) *default-time*)
           (accel m)))

(defmethod effect :resize [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Resize. element
                         (apply array start)
                         (apply array end)
                         time
                         accel)))

(comment ;; Resize examples
  (def button (get-element :greet-button))
  (def button-size (size button))
  (def button-height (height button))
  (def button-width (width button))
  (start (effect button {:effect :resize :end [200 200]}))
  (start (effect button {:effect :resize :end button-size}))
  (start (effect button {:effect :resize-height :end 200}))
  (start (effect button {:effect :resize-height :end button-height}))
  (start (effect button {:effect :resize-width :end 200}))
  (start (effect button {:effect :resize-width :end button-width}))
  (start (bind button
               {:effect :resize :end [200 200]}
               {:effect :resize-height :end 300}
               {:effect :resize-width :end 300}
               {:effect :resize-height :end 200}
               {:effect :resize-width :end 200}
               {:effect :resize :end button-size})))

(defmethod standardize :scroll [element m]
  (let [start (or (:start m) element)
        end (:end m)]
    (Effect. :scroll
             (scroll start)
             (scroll end)
             (or (:time m) *default-time*)
             (accel m))))

(defmethod effect :scroll [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Scroll. element
                         (apply array start)
                         (apply array end)
                         time
                         accel)))

(comment ;; Scroll examples
  (def doc (get-element "//body"))
  ;; Make the window small before trying this.
  (start (effect doc {:effect :scroll :end [500 500]}))
  (start (effect doc {:effect :scroll :end [0 0]}))
  (start (effect doc {:effect :scroll :end 300}))
  (start (effect doc {:effect :scroll :end 0}))
  (start (bind doc
               {:effect :scroll :end [500 500]}
               {:effect :scroll :end [0 0]}
               {:effect :scroll :end 300}
               {:effect :scroll :end 0})))

(defmethod standardize :swipe [element m]
  (let [start (or (:start m) [0 0])
        end (or (:end m) element)]
    (Effect. :swipe
             (size start)
             (size end)
             (or (:time m) *default-time*)
             (accel m))))

(defmethod effect :swipe [element m]
  (let [{:keys [start end time accel]} (standardize element m)]
    (goog.fx.dom.Swipe. element
                        (apply array start)
                        (apply array end)
                        time
                        accel)))

(comment ;; Swipe examples
  (def button (get-element :greet-button))
  (def button-size (size button))
  (style/setStyle button "position" "absolute")
  (start (effect button {:effect :swipe :start [100 0] :time 300}))
  (start (effect button {:effect :swipe :start [0 45] :time 300}))
  (start (effect button {:effect :swipe :time 300}))
  (style/setStyle button "position" ))

(defn parallel
  [& effects]
  (let [parallel (goog.fx.AnimationParallelQueue.)]
    (doseq [effect effects] (.add parallel effect))
    parallel))

(defn serial
  [& effects]
  (let [serial (goog.fx.AnimationSerialQueue.)]
    (doseq [effect effects]
      (.add serial effect))
    serial))

(def ^{:doc 
       :private true}
  effect-types
  {:color             :color
   :fade              :opacity
   :fade-in           :opacity
   :fade-out          :opacity
   :fade-in-and-show  :opacity
   :fade-out-and-hide :opacity
   :bg-color          :bg-color
   :slide             :position
   :resize            :size
   :resize-height     :size
   :resize-width      :size
   :scroll            :scroll
   :swipe             :size})

(defn- standardize-in-env
  [element env effect]
  (if (vector? effect)
    (let [coll (map #(standardize-in-env element env %) effect)]
      [(apply merge (map first coll)) (vec (map second coll))])
    (let [effect-type ((:effect effect) effect-types)
          effect (standardize (get env effect-type element) effect)
          env (assoc env effect-type effect)]
      [env effect])))

(defn- standardize-all-effects
  [element & effects]
  (loop [env {}
         effects effects
         std-effects []]
    (if (seq effects)
      (let [effect (first effects)
            [env effect] (standardize-in-env element env effect)]
        (recur env
               (rest effects)
               (conj std-effects effect)))
      std-effects)))

(defn bind
  [element & effects]
  (let [element (get-element element)
        effects (apply standardize-all-effects element effects)
        serial (goog.fx.AnimationSerialQueue.)]
    (doseq [sequential-effect effects]
      (if (vector? sequential-effect)
        (let [parallel (goog.fx.AnimationParallelQueue.)]
          (doseq [parallel-effect sequential-effect]
            (.add parallel (effect element parallel-effect)))
          (.add serial parallel))
        (.add serial (effect element sequential-effect))))
    serial))

(comment ;; Bind examples
  (def label-color (color (get-element "//label[@id='name-input-label']/span")))
  (def label (get-element "//label[@id='name-input-label']/span"))
  (def input (get-element :name-input))
  (def red [255 0 0])
  (def green [0 255 0])
  (def blue [0 0 255])
  (def input-bg-color (bg-color input))
  (def input-color (color input))
  (def button (get-element :greet-button))
  (def button-size (size button))
  (def move-label (bind label
                        [{:effect :slide :up 200 :time 2000}
                         {:effect :color :end red :time 2000}]
                        [{:effect :slide :down 200 :time 2000}
                         {:effect :color :end label-color :time 2000}]))
  (start move-label)
  (def background (bind input
                        {:effect :bg-color :end red}
                        {:effect :bg-color :end green}
                        {:effect :bg-color :end blue}
                        {:effect :bg-color :end input-bg-color}))
  (start background)
  ;; Serial and parallel animations on different elements
  (def big-button (bind button
                        {:effect :resize :end [200 200] :time 2000}
                        {:effect :resize :end button-size :time 2000}))
  (start big-button)
  (start (serial move-label background big-button))
  (start (parallel move-label background big-button)))

(comment ;; Events
  ;; You may listen for "begin" and "finish" events
  (def label-up (bind "//label[@id='name-input-label']/span"
                      {:effect :color :end "#53607b" :time 200}
                      {:effect :slide :up 40 :time 200}))
  (event/listen-once label-up
                     "finish"
                     #(js/alert "Animation finished."))
  (start label-up))

(def ^{:doc 
       :private true}
  animation-id (atom 0))

(def ^{:doc 
       :private true}
  animation-queue (atom {:runner nil :running nil :next []}))

(defn- add-to-queue
  [queue id animations]
  (let [new-next (conj (:next queue) animations)]
    (if (:runner queue)
      (assoc queue :next new-next)
      (assoc queue
        :runner id
        :running (first new-next)
        :next (vec (rest new-next))))))

(comment

  (add-to-queue {:runner nil :running nil :next []} 2 {:e 1 :a 2})
  (add-to-queue {:runner nil :running nil :next [{:e 1 :a 2}]} 2 {:e 3 :a 4})
  (add-to-queue {:runner 3 :running nil :next [{:e 1 :a 2}]} 2 {:e 3 :a 4})
  )

(defn- record-finished-animation
  [queue id]
  (if (empty? (:next queue))
    (assoc queue :runner nil :running nil)
    (assoc queue :running (first (:next queue)) :next (vec (rest (:next queue))))))

(comment

  (record-finished-animation {:runner 2, :running [{:e 1, :a 2}], :next []} 2)
  (record-finished-animation {:runner 3, :running nil, :next [{:e 1, :a 2} {:e 3, :a 4}]} 3)
  )

(declare play-animations)

(defn- animation-finished
  [id {after :after}]
  (let [new-queue (swap! animation-queue record-finished-animation id)]
    (when after (after))
    (when (= (:runner new-queue) id)
      (play-animations id new-queue))))

(defn- make-animation
  [{:keys [element animation]}]
  (cond element (bind element animation)
        (fn? animation) (animation)
        :else animation))

(defn- play-animations
  [id queue]
  (let [animation-map (:running queue)
        animation (make-animation animation-map)]
    (event/listen-once animation
                       "finish"
                       (fn [] (.start (goog.async.Delay. #(animation-finished id animation-map)) 100)))
    (when-let [before (:before animation-map)]
      (before))
    (start animation)))

(defn play
  ([element animation]
     (play element animation {}))
  ([element animation {:keys [name after before]}]
     (let [id (swap! animation-id inc)
           animation {:name name :id id :element element :animation animation :before before :after after}
           queue (swap! animation-queue add-to-queue id animation)]
       (when (= (:runner queue) id)
         (play-animations id queue)))))

(defn play-animation
  ([animation]
     (play-animation animation {}))
  ([animation opts]
     (play nil animation opts)))

(ns 
  one.browser.history
  (:require [clojure.browser.event :as event]
            [goog.History :as history]
            [goog.history.Html5History :as history5]))

(extend-type goog.History
  
  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (. k (toLowerCase)))
              v])
           (js->clj goog.history.EventType)))))

(defn history
  [callback]
  (let [h (if (history5/isSupported)
            (goog.history.Html5History.)
            (goog.History.))]
    (do (event/listen h "navigate"
                      (fn [e]
                        (callback {:token (keyword (.-token e))
                                   :type (.-type e)
                                   :navigation? (.-isNavigation e)})))
        (.setEnabled h true)
        h)))

(defn set-token
  [history token]
  (.setToken history (name token)))

(ns 
  one.browser.remote
  (:require [goog.net.XhrManager   :as manager]))

(def ^:private
  *xhr-manager*
  (goog.net.XhrManager. nil
                        nil
                        nil
                        0
                        5000))

(defn success?
  [{status :status}]
  (and (>= status 200)
       (<  status 300)))

(defn redirect?
  [{status :status}]
  (boolean (#{301 302 303 307} status)))

(defn error?
  [{status :status}]
  (>= status 400))

(defn- handle-response
  [on-success on-error e]
  (let [response {:id     (.-id e)
                  :body   (. e/currentTarget (getResponseText))
                  :status (. e/currentTarget (getStatus))
                  :event  e}
        handler  (if (success? response)
                   on-success
                   on-error)]
    (handler response)))

(defn request
  [id url & {:keys [method content headers priority retries
                    on-success on-error]
             :or   {method   "GET"
                    retries  0}}]
  (try
    (.send *xhr-manager*
           id
           url
           method
           content
           (when headers (.-strobj headers))
           priority
           (partial handle-response on-success on-error)
           retries)
    (catch js/Error e
      nil)))

(defn url
  [path]
  (str (.-origin (.-location js/document)) path))

(ns 
  one.browser.repl-client
  (:require [goog.uri.utils :as uri]
            [clojure.browser.repl :as repl]))

(defn- server
  []
  (let [location (.toString window.location ())]
    (str (uri/getScheme location) "://" (uri/getDomain location))))

(defn ^:export repl
  []
  (repl/connect (str (server) ":9000/repl")))

(ns 
  one.color
  (:require [one.core :as core]
            [goog.string :as gstring]
            [goog.style :as style]
            [goog.color :as gcolor]
            [goog.color.alpha :as alpha]))

(defprotocol IColor
  (rgb [this] "Returns a vector `[r g b]`.")
  (rgba [this] "Returns a vector `[r g b a]`.")
  (hex [this] "Returns a hex string for this color.")
  (hex-rgba [this] "Returns a hex rgba string for this color.")
  (alpha [this] "Returns the alpha for this color, a number in the range `[0 1]`."))

(defrecord Color [r g b a]
  IColor
  (rgb [_] [r g b])
  (rgba [_] [r g b a])
  (hex [_]
    (gcolor/rgbArrayToHex (array r g b)))
  (hex-rgba [_]
    (alpha/rgbaArrayToHex (array r g b a)))
  (alpha [_] a))

(defn- make-color
  ([r g b]
     (make-color r g b 1))
  ([r g b a]
     (Color. r g b a)))

(comment ;; Color examples
  (def red (make-color 200 0 0))
  (rgb red)
  (rgba red)
  (hex red)
  (hex-rgba red)
  (alpha red))

(defprotocol IColorSource
  (color [this] "Get the color from the passed object. Return a `Color` object.")
  (bg-color [this] "Get the background color from the passed
  object. Returns a `Color` object."))

(extend-protocol IColorSource

  nil
  (color [this] (make-color 0 0 0))
  (bg-color [this] (make-color 0 0 0))

  Color
  (color [this] this)
  (bg-color [this] this)

  cljs.core.Vector
  (color [this] (apply make-color this))
  (bg-color [this] (apply make-color this))

  js/Array
  (color [this] (apply make-color (js->clj this)))
  (bg-color [this] (apply make-color (js->clj this)))

  js/String
  (color [this]
    (color (js->clj (cond (gstring/startsWith this "#")
                          (cond (= (count this) 7) (gcolor/hexToRgb this)
                                (= (count this) 9) (alpha/hexToRgba this))
                          
                          (gstring/startsWith this "rgba(")
                          (alpha/parse this)

                          (gstring/startsWith this "rgb(") (gcolor/parseRgb this))
                    :keywordize-keys true)))
  (bg-color [this] (color this))
  
  cljs.core.ObjMap
  (color [this] (color (:hex this)))
  (bg-color [this] (color this))
  
  js/Element
  (color [this]
    (color (js->clj (gcolor/parse (core/get-style this "color"))
                    :keywordize-keys true)))
  (bg-color [this]
    (color (js->clj (let [c (style/getBackgroundColor this)]
                      (try
                        (gcolor/parse c)
                        (catch js/Error e (alpha/parse c))))
                    :keywordize-keys true))))

(ns 
  one.core
  (:require [goog.style :as style]))

(defprotocol Startable
  (start [this]))

(defprotocol Disposable
  (dispose [this]))

(defn get-style
  [element style]
  (some #(let [v (%)] (when (not= "" v) v))
        [#(style/getComputedStyle element style)
         #(style/getStyle element style)
         #(aget (.-currentStyle element) style)
         #(throw (js/Error. (str "Could not retrieve value for style " style)))]))

(ns 
  one.dispatch)

(def 
  reactions (atom {}))

(defn react-to
  ([event-pred reactor]
     (react-to nil event-pred reactor))
  ([max-count event-pred reactor]
     (let [reaction {:max-count max-count
                     :event-pred event-pred
                     :reactor reactor}]
       (swap! reactions assoc reaction 0)
       reaction)))

(defn delete-reaction
  [reaction]
  (swap! reactions dissoc reaction))

(defn fire
  ([event-id]
     (fire event-id nil))
  ([event-id event-data]
     (let [matching-reactions (filter (fn [[{event-pred :event-pred} run-count]]
                                        (event-pred event-id))
                                      @reactions)]
       (doseq [[reaction run-count] matching-reactions]
         (let [{:keys [max-count reactor]} reaction
               run-count (inc run-count)]
           (reactor event-id event-data)
           (if (and max-count
                    (<= max-count run-count))
             (delete-reaction reaction)
             (swap! reactions assoc reaction run-count)))))))

(ns 
  one.logging
  (:require [goog.debug.Console :as console]
            [goog.debug.FancyWindow :as fancy]
            [goog.debug.Logger :as logger]))

(defprotocol ILogViewer
  (start-display [this] "Start displaying log messages in this viewer.")
  (stop-display [this] "Stop displaying log messages in this viewer."))

(def 
  levels {:severe goog.debug.Logger.Level.SEVERE
          :warning goog.debug.Logger.Level.WARNING
          :info goog.debug.Logger.Level.INFO
          :config goog.debug.Logger.Level.CONFIG
          :fine goog.debug.Logger.Level.FINE
          :finer goog.debug.Logger.Level.FINER
          :finest goog.debug.Logger.Level.FINEST})

(defn get-logger
  [name]
  (goog.debug.Logger/getLogger name))

(defn severe
  [logger s] (.severe logger s))

(defn warning
  [logger s] (.warning logger s))

(defn info
  [logger s] (.info logger s))

(defn config
  [logger s] (.config logger s))

(defn fine
  [logger s] (.fine logger s))

(defn finer
  [logger s] (.finer logger s))

(defn finest
  [logger s] (.finest logger s))

(defn set-level
  [logger level]
  (.setLevel logger (get levels level goog.debug.Logger.Level.INFO)))

(extend-protocol ILogViewer
  
  goog.debug.Console
  (start-display [this]
    (.setCapturing this true))
  (stop-display [this]
    (.setCapturing this false))
  
  goog.debug.FancyWindow
  (start-display [this]
    (doto this
      (.setEnabled true)
      (.init ())))
  (stop-display [this]
    (.setCapturing this false)))

(defn console-output
  []
  (goog.debug.Console.))

(defn fancy-output
  [name]
  (goog.debug.FancyWindow. name))