(ns com.okl.tokenmgr.cli
  (:gen-class)
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [clojure.string :as string]
            [com.okl.tokenmgr.tokens :refer :all]
            [com.okl.tokenmgr.port :as port]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure-csv.core :as csv]))

;; tokens start with a letter and then can be letters, numbers, or underscores
;; and end with a letter or number
;; groups: 1 - matched leading underscores
;;         2 - macro (token with underscores)
;;         3 - token
(def token-regex #"(_*)(__([a-zA-Z][a-zA-Z0-9_]*[a-zA-Z0-9])__)\1")

(defn- lkup-token
  "Look up sym in tokens or log and return defval."
  ([tokens sym defval]
   (let [v (get tokens sym)]
     (if (not v)
       (do (log/error (str "Unknown token: " sym)) defval)
       v)))
  ([tokens sym] (lkup-token tokens sym nil)))

(defn expand-line [line tokens]
  "Returns expanded line with all provided tokens."
  (log/trace (str "expand-line: " line))
  (string/replace
    line
    token-regex
    #(str (nth % 1) (lkup-token tokens (nth % 3) (nth % 2)) (nth % 1))))

(defn count-macros [line]
  "Returns the number of potential expansions in line."
  (count (re-seq token-regex line)))

(defn- process-file! [file tokens]
  "Expands file. Returns # of unexpanded macros."
  (log/trace (str "Attempting to process file " (str file)))
  (let [output-file (io/file (string/replace (.getAbsolutePath file) #"\.tmpl$" ""))]
    (with-open [reader (io/reader file)
                writer (io/writer output-file)]
      (if (.canExecute file)
        (.setExecutable output-file true false))
      (reduce + (for [line (line-seq reader)
                      :let [expanded (expand-line line tokens)]]
                  (do (.write writer (str expanded "\n"))
                      (count-macros expanded)))))))

(defn- find-tmpl-files [dir]
  "find all .tmpl files in this directory and below"
  (log/trace (str "List of files in dir " dir " is " (seq (.listFiles dir))))
  (flatten
   (remove
    nil?
    (map #(if (.isDirectory %)
            (find-tmpl-files %)
            (when (.endsWith (str %) ".tmpl")
              %))
         (.listFiles dir)))))

(defn- process-dir [dir tokens]
  "Expand tmpl files in dir and return # of unexpanded macros or nil on error."
  (let [dir-file (io/file dir)]
    (log/trace (str "I found things " (find-tmpl-files dir-file)))
    (if (and (.exists dir-file) (.isDirectory dir-file))
      (reduce + (for [f (find-tmpl-files dir-file)]
                  (process-file! f tokens)))
      (log/error (str dir " is not a directory")))))

(defn- process-token-values-pass [tokens]
  "Single pass of tokens through expand-line."
  (into {} (map #(hash-map % (expand-line (get tokens %) tokens))
                (keys tokens))))

(defn process-token-values [tokens]
  "Filter token values that contain tokens."
  (log/trace (str "processing token values for " tokens))
  (let [tokenpass (process-token-values-pass tokens)]
    (if (= tokens tokenpass)
      tokens
      (process-token-values tokenpass))))

(defn arg->map [arg]
  "Turn a string XXX=YYY to map {XXX YYY}"
  (let [pair (string/split arg #"=" 2)]
    (if (= 1 (count pair))
      (hash-map arg "")
      (apply hash-map pair))))

(def help-str
  (str "Arguments: filter app evnt dir -- filters .tmpl files replacing tokens "
       "with values\n\n"
       "           load path_to_csv app -- loads in a new csv into a specified "
       "application\n\n"
       "           export app path_to_csv -- exports the entire repository into"
       "a csv file\n\n"
       "           import app path_to_csv -- loads the entire repository from a"
       " csv file"))

(defn- usage [parsed-opts]
  (if (:errors parsed-opts)
    (println (string/join "/" (:errors parsed-opts))))
  (println (str help-str "\n\nAdditonal parameters\n" (:summary parsed-opts)))
  (System/exit 1))

(def cli-opts
  [["-t" "--token" "Token definitions, TOKEN=VAL"
    :required true
    :parse-fn #(hash-map :token (arg->map %))
    :assoc-fn (fn [previous key val]
                (merge-with coalesce-map previous val))]
   ["-d" "--delimiter" "Character for delimiter in csv-related operations"
    :required true
    :default "\t"
    :valiate [#(= 1 (count %))]]])

(defn- cli-fn [parsed-opts req-arg-cnt]
  (let [my-args (rest (:arguments parsed-opts))]
    (log/debug (str "args are " my-args))
    (if (not (= (count my-args) req-arg-cnt))
      (usage parsed-opts)
      my-args)))

(defn- store-token [app header row]
  (let [token (zipmap header row)
        name (get token "key_name")
        description (get token "description")]
    (log/debug (str "processing " token))
    (doseq [envt (keys token)]
      (log/debug (str "processing token " name " with envt " envt))
      (if (not (or (= envt "key_name")
                   (= envt "description")
                   (= envt "id")
                   (= envt "module")
                   (empty? (get token envt))))
        (create-token
         (string/join "/" [app name])
         description
         envt
         (get token envt))))))

(defn- token->value-list [token environments]
  [(concat [(:name token) (:description token)]
          (map #(let [value (get (get (:values token) %) "value")]
                  (if (nil? value)
                    ""
                    value))
               environments))])

(defn- handle-port-status [status]
  (case (:status status)
    :success 0
    :sys-error  1
    :user-error 1))

(defn- call-port
  "Calls the port facility for import/export.
Currently forced through JSON for backup control."
  [port-method filename]
  (handle-port-status
   ((port-method {:import port/import-tokens
                  :export port/export-tokens})
    filename
    :json)))

(defn- export-all-apps [filename]
  (call-port :export filename))

(defn- export-single-app [app filename delimiter]
  (let [tokens (get-tokens app)
        environments (set (flatten (map #(keys (:values %)) tokens)))]
    (with-open [wrtr (io/writer filename)]
      (.write wrtr (csv/write-csv [(concat ["key_name" "description"]
                                           environments)]
                                   :delimiter delimiter))
      (doall (map #(.write wrtr
                           (csv/write-csv (token->value-list % environments)
                                          :delimiter delimiter))
                  tokens)))))

(defn- do-filter [parsed-opts]
  "'filter' command. Returns an exit code."
  (let [[app envt dir] (cli-fn parsed-opts 3)
        cli-tokens (:token (:options parsed-opts))
        tokens (process-token-values (get-token-values app envt cli-tokens))]
    (let [num-unexpanded (process-dir dir tokens)]
      (if (or (nil? num-unexpanded) (> num-unexpanded 0))
        1
        0))))

(defn- import-all-apps [filename]
  (call-port :import filename))

(defn- import-single-app [parsed-opts]
  (let [[app file] (cli-fn parsed-opts 2)
        file-contents (slurp file)
        csv (csv/parse-csv file-contents
                           :delimiter (first (:delimiter (:options parsed-opts))))
        ; first row is column headers
        header (first csv)
        token-rows (rest csv)]
    (doseq [row token-rows]
      (store-token app header row))))

(defn- do-import [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 2)
      nil
      (import-single-app parsed-opts)))
  0)

(defn- do-export [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 2)
      (export-all-apps (second parsed-args))
      (export-single-app (second parsed-args) (second (rest parsed-args))
                         (:delimiter (:options parsed-opts)))))
  0)

(defn- do-backup [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 2)
      (export-all-apps (second parsed-args))
      1)))

(defn- do-restore [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 2)
      (import-all-apps (second parsed-args))
      1)))

(defn exec [cmd opts]
  "Execute a single command or print usage."
  (let [cmds {"filter" do-filter
              "export" do-export
              "import" do-import
              "backup" do-backup
              "restore" do-restore}]
    ((get cmds cmd #(usage %)) opts)))

(defn -main  [& args]
  (let [parsed-opts (parse-opts args cli-opts)
        parsed-args (:arguments parsed-opts)]
    (log/debug parsed-opts)
    (if (:errors parsed-opts)
      (usage parsed-opts)
      (System/exit (exec (first parsed-args) parsed-opts)))))

(ns com.okl.tokenmgr.cli
  (:gen-class)
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [clojure.string :as string]
            [com.okl.tokenmgr.tokens :refer :all]
            [com.okl.tokenmgr.port :as port]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure-csv.core :as csv]))

;; tokens start with a letter and then can be letters, numbers, or underscores
;; and end with a letter or number
;; groups: 1 - matched leading underscores
;;         2 - macro (token with underscores)
;;         3 - token
(def token-regex #"(_*)(__([a-zA-Z][a-zA-Z0-9_]*[a-zA-Z0-9])__)\1")

(defn- lkup-token
  "Look up sym in tokens or log and return defval."
  ([tokens sym defval]
   (let [v (get tokens sym)]
     (if (not v)
       (do (log/error (str "Unknown token: " sym)) defval)
       v)))
  ([tokens sym] (lkup-token tokens sym nil)))

(defn expand-line [line tokens]
  "Returns expanded line with all provided tokens."
  (log/trace (str "expand-line: " line))
  (string/replace
    line
    token-regex
    #(str (nth % 1) (lkup-token tokens (nth % 3) (nth % 2)) (nth % 1))))

(defn count-macros [line]
  "Returns the number of potential expansions in line."
  (count (re-seq token-regex line)))

(defn- process-file! [file tokens]
  "Expands file. Returns # of unexpanded macros."
  (log/trace (str "Attempting to process file " (str file)))
  (let [output-file (io/file (string/replace (.getAbsolutePath file) #"\.tmpl$" ""))]
    (with-open [reader (io/reader file)
                writer (io/writer output-file)]
      (if (.canExecute file)
        (.setExecutable output-file true false))
      (reduce + (for [line (line-seq reader)
                      :let [expanded (expand-line line tokens)]]
                  (do (.write writer (str expanded "\n"))
                      (count-macros expanded)))))))

(defn- find-tmpl-files [dir]
  "find all .tmpl files in this directory and below"
  (log/trace (str "List of files in dir " dir " is " (seq (.listFiles dir))))
  (flatten
   (remove
    nil?
    (map #(if (.isDirectory %)
            (find-tmpl-files %)
            (when (.endsWith (str %) ".tmpl")
              %))
         (.listFiles dir)))))

(defn- process-dir [dir tokens]
  "Expand tmpl files in dir and return # of unexpanded macros or nil on error."
  (let [dir-file (io/file dir)]
    (log/trace (str "I found things " (find-tmpl-files dir-file)))
    (if (and (.exists dir-file) (.isDirectory dir-file))
      (reduce + (for [f (find-tmpl-files dir-file)]
                  (process-file! f tokens)))
      (log/error (str dir " is not a directory")))))

(defn- process-token-values-pass [tokens]
  "Single pass of tokens through expand-line."
  (into {} (map #(hash-map % (expand-line (get tokens %) tokens))
                (keys tokens))))

(defn process-token-values [tokens]
  "Filter token values that contain tokens."
  (log/trace (str "processing token values for " tokens))
  (let [tokenpass (process-token-values-pass tokens)]
    (if (= tokens tokenpass)
      tokens
      (process-token-values tokenpass))))

(defn arg->map [arg]
  "Turn a string XXX=YYY to map {XXX YYY}"
  (let [pair (string/split arg #"=" 2)]
    (if (= 1 (count pair))
      (hash-map arg "")
      (apply hash-map pair))))

(def help-str
  (str "Arguments: filter app evnt dir -- filters .tmpl files replacing tokens "
       "with values\n\n"
       "           load path_to_csv app -- loads in a new csv into a specified "
       "application\n\n"
       "           export app path_to_csv -- exports the an application into"
       "a csv file\n\n"
       "           import app path_to_csv -- loads the an application from a"
       " csv file\n\n"
       "           backup path_to_json -- exports the everything into json\n\n"
       "           restore path_to_json -- restores from backup json file"))

(defn- usage [parsed-opts]
  (if (:errors parsed-opts)
    (println (string/join "/" (:errors parsed-opts))))
  (println (str help-str "\n\nAdditonal parameters\n" (:summary parsed-opts)))
  (System/exit 1))

(def cli-opts
  [["-t" "--token" "Token definitions, TOKEN=VAL"
    :required true
    :parse-fn #(hash-map :token (arg->map %))
    :assoc-fn (fn [previous key val]
                (merge-with coalesce-map previous val))]
   ["-d" "--delimiter" "Character for delimiter in csv-related operations"
    :required true
    :default "\t"
    :valiate [#(= 1 (count %))]]])

(defn- cli-fn [parsed-opts req-arg-cnt]
  (let [my-args (rest (:arguments parsed-opts))]
    (log/debug (str "args are " my-args))
    (if (not (= (count my-args) req-arg-cnt))
      (usage parsed-opts)
      my-args)))

(defn- store-token [app header row]
  (let [token (zipmap header row)
        name (get token "key_name")
        description (get token "description")]
    (log/debug (str "processing " token))
    (doseq [envt (keys token)]
      (log/debug (str "processing token " name " with envt " envt))
      (if (not (or (= envt "key_name")
                   (= envt "description")
                   (= envt "id")
                   (= envt "module")
                   (empty? (get token envt))))
        (create-token
         (string/join "/" [app name])
         description
         envt
         (get token envt))))))

(defn- token->value-list [token environments]
  [(concat [(:name token) (:description token)]
          (map #(let [value (get (get (:values token) %) "value")]
                  (if (nil? value)
                    ""
                    value))
               environments))])

(defn- handle-port-status [status]
  (case (:status status)
    :success 0
    :sys-error  1
    :user-error 1))

(defn- call-port
  "Calls the port facility for import/export.
Currently forced through JSON for backup control."
  [port-method filename]
  (handle-port-status
   ((port-method {:import port/import-tokens
                  :export port/export-tokens})
    filename
    :json)))

(defn- export-all-apps [filename]
  (call-port :export filename))

(defn- export-single-app [app filename delimiter]
  (let [tokens (get-tokens app)
        environments (set (flatten (map #(keys (:values %)) tokens)))]
    (with-open [wrtr (io/writer filename)]
      (.write wrtr (csv/write-csv [(concat ["key_name" "description"]
                                           environments)]
                                   :delimiter delimiter))
      (doall (map #(.write wrtr
                           (csv/write-csv (token->value-list % environments)
                                          :delimiter delimiter))
                  tokens)))))

(defn- do-filter [parsed-opts]
  "'filter' command. Returns an exit code."
  (let [[app envt dir] (cli-fn parsed-opts 3)
        cli-tokens (:token (:options parsed-opts))
        tokens (process-token-values (get-token-values app envt cli-tokens))]
    (let [num-unexpanded (process-dir dir tokens)]
      (if (or (nil? num-unexpanded) (> num-unexpanded 0))
        1
        0))))

(defn- import-all-apps [filename]
  (call-port :import filename))

(defn- import-single-app [parsed-opts]
  (let [[app file] (cli-fn parsed-opts 2)
        file-contents (slurp file)
        csv (csv/parse-csv file-contents
                           :delimiter (first (:delimiter (:options parsed-opts))))
        ; first row is column headers
        header (first csv)
        token-rows (rest csv)]
    (doseq [row token-rows]
      (store-token app header row))))

(defn- do-import [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 3)
      (import-single-app parsed-opts)
      1)))

(defn- do-export [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 3)
      (export-single-app (second parsed-args) (second (rest parsed-args))
                         (:delimiter (:options parsed-opts)))
      1)))

(defn- do-backup [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 2)
      (export-all-apps (second parsed-args))
      1)))

(defn- do-restore [parsed-opts]
  (let [parsed-args (:arguments parsed-opts)]
    (if (= (count parsed-args) 2)
      (import-all-apps (second parsed-args))
      1)))

(defn exec [cmd opts]
  "Execute a single command or print usage."
  (let [cmds {"filter" do-filter
              "export" do-export
              "import" do-import
              "backup" do-backup
              "restore" do-restore}]
    ((get cmds cmd #(usage %)) opts)))

(defn -main  [& args]
  (let [parsed-opts (parse-opts args cli-opts)
        parsed-args (:arguments parsed-opts)]
    (log/debug parsed-opts)
    (if (:errors parsed-opts)
      (usage parsed-opts)
      (System/exit (exec (first parsed-args) parsed-opts)))))

Backup and restore are their own commands


(ns euler.practice.alfa)

;;take''
(defn take'' [a b]
  (loop [la (dec a)
         lb '()]
    (if (= la -1)
      lb
      (recur (dec la) (conj lb (nth b la))))))

(defn take$$ [n ls]
  (loop [i 1 res [] raw ls]
        (if (> i n)
            res
            (recur (inc i)
                   (conj res (first raw))
                   (rest ls)))))

;; Reimplementing Clojure in pure recursion
;; last, butlast, keep, map, take, take-while, remove, drop, drop-while, distinct, range, for

(ns euler.practice.alfa)

;;take
(defn take' [a b]
  (if (= (count b) a)
    b
    (take' a (butlast b))))

(defn take'' [a b]
  (loop [la (dec a)
         lb '()]
    (if (= la -1)
      lb
      (recur (dec la) (conj lb (nth b la))))))

(defn take$$ [n ls]
  (loop [i 1 res [] raw ls]
        (if (> i n)
            res
            (recur (inc i)
                   (conj res (first raw))
                   (rest ls)))))

;; Reimplementing Clojure in pure recursion
;; last, butlast, keep, map, take, take-while, remove, drop, drop-while, distinct, range, for

Update alfa.clj

Update alfa.clj


(ns day8.re-frame.trace
  (:require [day8.re-frame.trace.subvis :as subvis]
            [day8.re-frame.trace.styles :as styles]
            [day8.re-frame.trace.components :as components]
            [re-frame.trace :as trace :include-macros true]
            [cljs.pprint :as pprint]
            [clojure.string :as str]
            [reagent.core :as r]
            [reagent.interop :refer-macros [$ $!]]
            [reagent.impl.util :as util]
            [reagent.impl.component :as component]
            [reagent.impl.batching :as batch]
            [reagent.ratom :as ratom]
            [goog.object :as gob]
            [re-frame.interop :as interop]

            [devtools.formatters.core :as devtools]))

(defn comp-name [c]
  (let [n (or (component/component-path c)
              (some-> c .-constructor util/fun-name))]
    (if-not (empty? n)
      n
      "")))

(def static-fns
  {:render
   (fn render []
     (this-as c
       (trace/with-trace {:op-type   :render
                          :tags      {:component-path (reagent.impl.component/component-path c)}
                          :operation (last (str/split (reagent.impl.component/component-path c) #" > "))}
                         (if util/*non-reactive*
                           (reagent.impl.component/do-render c)
                           (let [rat        ($ c :cljsRatom)
                                 _          (batch/mark-rendered c)
                                 res        (if (nil? rat)
                                              (ratom/run-in-reaction #(reagent.impl.component/do-render c) c "cljsRatom"
                                                                     batch/queue-render reagent.impl.component/rat-opts)
                                              (._run rat false))
                                 cljs-ratom ($ c :cljsRatom)] ;; actually a reaction
                             (trace/merge-trace!
                               {:tags {:reaction      (interop/reagent-id cljs-ratom)
                                       :input-signals (when cljs-ratom
                                                        (map interop/reagent-id (gob/get cljs-ratom "watching" :none)))}})
                             res)))))})

(defn monkey-patch-reagent []
  (let [#_#_real-renderer reagent.impl.component/do-render
        real-custom-wrapper reagent.impl.component/custom-wrapper
        real-next-tick      reagent.impl.batching/next-tick
        real-schedule       reagent.impl.batching/schedule]

    #_(set! reagent.impl.component/do-render
            (fn [c]
              (let [name (comp-name c)]
                (js/console.log c)
                (trace/with-trace {:op-type   :render
                                   :tags      {:component-path (reagent.impl.component/component-path c)}
                                   :operation (last (str/split name #" > "))}
                                  (real-renderer c)))))

    (set! reagent.impl.component/static-fns static-fns)

    (set! reagent.impl.component/custom-wrapper
          (fn [key f]
            (case key
              :componentWillUnmount
              (fn [] (this-as c
                       (trace/with-trace {:op-type   key
                                          :operation (last (str/split (comp-name c) #" > "))
                                          :tags      {:component-path (reagent.impl.component/component-path c)
                                                      :reaction       (interop/reagent-id ($ c :cljsRatom))}})
                       (.call (real-custom-wrapper key f) c c)))

              (real-custom-wrapper key f))))

    #_(set! reagent.impl.batching/next-tick (fn [f]
                                              (real-next-tick (fn []
                                                                (trace/with-trace {:op-type :raf}
                                                                                (f))))))

    #_(set! reagent.impl.batching/schedule schedule
            #_(fn []
                (reagent.impl.batching/do-after-render (fn [] (trace/with-trace {:op-type :raf-end})))
                (real-schedule)))))

(def traces (interop/ratom []))
(defn log-trace? [trace]
  (let [rendering? (= (:op-type trace) :render)]
    (if-not rendering?
      true
      (not (str/includes? (or (get-in trace [:tags :component-path]) "") "day8.re_frame.trace")))

    #_(if-let [comp-p (get-in trace [:tags :component-path])]
        (println comp-p))))

(defn disable-tracing! []
  (re-frame.trace/remove-trace-cb ::cb))

(defn enable-tracing! []
  (re-frame.trace/register-trace-cb ::cb (fn [new-traces]
                                           (let [new-traces (filter log-trace? new-traces)]
                                             (swap! traces #(reduce conj % new-traces))))))

(defn init-tracing!
  "Sets up any intial state that needs to be there for tracing. Does not enable tracing."
  []
  (monkey-patch-reagent))

(defn search-input [{:keys [title on-save on-change on-stop]}]
  (let [val  (r/atom title)
        save #(let [v (-> @val str str/trim)]
                (when (pos? (count v))
                  (on-save v)))]
    (fn []
      [:input {:style       {:margin-left 7}
               :type        "text"
               :value       @val
               :auto-focus  true
               :on-change   #(do (reset! val (-> % .-target .-value))
                                 (on-change %))
               :on-key-down #(case (.-which %)
                               13 (do
                                    (save)
                                    (reset! val ""))
                               nil)}])))

(defn construct-string [trace]
  (clojure.string/lower-case (str (:operation trace) " " (:op-type trace))))

(defn has-word [traces q]
  (filter #(clojure.string/includes? (construct-string %) (:query q)) traces))

(defn has-duration [traces q]
  (filter #(< (js/parseInt (:query q)) (:duration %)) traces))

(defn filter-by-word [traces queries]
  (mapcat (partial has-word traces) queries))

(defn filter-by-duration [traces queries]
  (mapcat (partial has-duration traces) queries))

(defn run-all-filters [traces queries]
  (let [[word-queries duration-queries] (vals (group-by #(= (:filter-type %) "contains") queries))
        traces-filtered-by-words      (filter-by-word traces word-queries)]
    (if duration-queries
      (filter-by-duration traces-filtered-by-words duration-queries)
      traces-filtered-by-words)))

(defn render-traces [showing-traces]
  (doall
    (for [{:keys [op-type id operation tags duration] :as trace} showing-traces]
      (let [padding   {:padding "0px 5px 0px 5px"}
            row-style (merge padding {:border-top (case op-type :event "1px solid lightgrey" nil)})
            #_#__ (js/console.log (devtools/header-api-call tags))]

        (list [:tr {:key   id
                    :style {:color (case op-type
                                     :sub/create "green"
                                     :sub/run "#fd701e"
                                     :event "blue"
                                     :render "purple"
                                     :re-frame.router/fsm-trigger "#fd701e"
                                     nil)}}
               [:td {:style row-style} (str op-type)]
               [:td {:style row-style} operation]
               [:td
                {:style (merge row-style {:font-weight (if (< slower-than-bold-int duration)
                                                         "bold"
                                                         "")
                                          :white-space "nowrap"})}

                (.toFixed duration 1) " ms"]]
              (when true
                [:tr {:key (str id "-details")}
                 [:td {:col-span 3} (with-out-str (pprint/pprint (dissoc tags :query-v :event :duration)))]]))))))

(defonce app-state [:traces {:filter-input ""
                             :filter-items []}]) ;; [{:id (random-uuid) :query "showing" :filter-type "contains"} {:id (random-uuid) :query "Reagent" :filter-type "contains"}

(defn render-trace-panel []
  (let [filter-input     (r/atom "")
        filter-items     (r/atom [])
        filter-type      (r/atom "contains")]
    (fn []
      (let [showing-traces       (if (= @filter-items [])
                                   @traces
                                   (run-all-filters @traces @filter-items))
            save-query           (fn [_]
                                   (swap! filter-items conj {:id (random-uuid)
                                                             :query (str/lower-case @filter-input)
                                                             :filter-type @filter-type}))]
        [:div
         [:div.filter-control {:style {:margin-bottom 20}}
           [:div.filter-control-input
            {:style {:margin-bottom 10}}
            [:select {:value @filter-type :on-change (fn [e]
                                                         (reset! filter-type (.. e -target -value))
                                                         (println (.. e -target -value)))}
             [:option "contains"]
             [:option "slower than"]]
            [search-input {:on-save save-query
                           :on-change #(reset! filter-input (.. % -target -value))}]
            [:button.button.icon-button {:on-click save-query
                                         :style {:margin 0}}
             [components/icon-add]]
            ;; [:button {:style {:background "#aae0ec"
            ;;                   :padding 7
            ;;                   :margin 5}}
            ;;  "-"]]
            [:br]]
           [:ul.filter-items
             (map (fn [item]
                      ^{:key (:id item)}
                      [:li.filter-item.button
                        {:on-click (fn [event] (swap! filter-items #(remove (comp (partial = (:query item)) :query) %)))}
                        (:filter-type item) ": " [:span.filter-item-string (:query item)]
                        [:button.icon-button [components/icon-remove]]])
                  @filter-items)]]
         [:table
          {:cell-spacing "0" :width "100%"}
          [:thead>tr
           [:th "operations"]
           [:th
             (when (pos? (count showing-traces))
               (str (count showing-traces) " of "))
             (when (pos? (count @traces))
               (str (count @traces)))
             " events "
             (when (pos? (count @traces))
               [:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! traces []))} "clear"] ")"])]
           [:th "meta"]]
          [:tbody (render-traces showing-traces)]]]))))

(defn resizer-style [draggable-area]
  {:position "absolute" :z-index 2 :opacity 0
   :left     (str (- (/ draggable-area 2)) "px") :width "10px" :top "0px" :height "100%" :cursor "col-resize"})

(def ease-transition "left 0.2s ease-out, top 0.2s ease-out, width 0.2s ease-out, height 0.2s ease-out")

(defn devtools []
  ;; Add clear button
  ;; Filter out different trace types
  (let [position       (r/atom :right)
        size           (r/atom 0.35)
        showing?       (r/atom false)
        dragging?      (r/atom false)
        pin-to-bottom? (r/atom true)
        selected-tab   (r/atom :traces)
        handle-keys    (fn [e]
                         (let [combo-key?      (or (.-ctrlKey e) (.-metaKey e) (.-altKey e))
                               tag-name        (.-tagName (.-target e))
                               key             (.-key e)
                               entering-input? (contains? #{"INPUT" "SELECT" "TEXTAREA"} tag-name)]
                           (when (and (not entering-input?) combo-key?)
                             (cond
                               (and (= key "h") (.-ctrlKey e))
                               (do (swap! showing? not)
                                   (if @showing?
                                     (enable-tracing!)
                                     (disable-tracing!))
                                   (.preventDefault e))))))]
    (r/create-class
      {:component-will-mount   #(js/window.addEventListener "keydown" handle-keys)
       :component-will-unmount #(js/window.removeEventListener "keydown" handle-keys)
       :display-name           "devtools outer"
       :reagent-render         (fn []
                                 (let [draggable-area 10
                                       full-width     js/window.innerWidth
                                       full-height    js/window.innerHeight
                                       left           (if @showing? (str (* 100 (- 1 @size)) "%")
                                                                    (str full-width "px"))
                                       transition     (if @showing?
                                                        ease-transition
                                                        (str ease-transition ", opacity 0.01s linear 0.2s"))]
                                   [:div.panel-wrapper
                                    {:style {:position "fixed" :width "0px" :height "0px" :top "0px" :left "0px" :z-index 99999999}}
                                    [:div.panel
                                      {:style {:position   "fixed" :z-index 1 :box-shadow "rgba(0, 0, 0, 0.298039) 0px 0px 4px" :background "white"
                                               :left       left :top "0px" :width (str (* 100 @size) "%") :height "100%"
                                               :transition transition}}
                                      [:div.panel-resizer {:style         (resizer-style draggable-area)
                                                           :on-mouse-down #(reset! dragging? true)
                                                           :on-mouse-up   #(reset! dragging? false)
                                                           :on-mouse-move (fn [e]
                                                                           (when @dragging?
                                                                             (let [x (.-clientX e)
                                                                                y (.-clientY e)]
                                                                               (.preventDefault e)
                                                                               (reset! size (/ (- full-width x)
                                                                                full-width)))))}]
                                      [:div.panel-content
                                        {:style {:width "100%" :height "100%" :display "flex" :flex-direction "column"}}
                                        [:div.panel-content-top
                                          [:div.nav
                                            [:button {:class (str "tab button " (when (= @selected-tab :traces) "active"))
                                                      :on-click #(reset! selected-tab :traces)} "Traces"]
                                            [:button {:class (str "tab button " (when (= @selected-tab :subvis) "active"))
                                                      :on-click #(reset! selected-tab :subvis)} "SubVis"]]]
                                        [:div.panel-content-scrollable
                                          (case @selected-tab
                                            :traces [render-trace-panel]
                                            :subvis [subvis/render-subvis traces]
                                            [render-trace-panel])]]]]))})))

(defn panel-div []
  (let [id    "--re-frame-trace--"
        panel (.getElementById js/document id)]
    (if panel
      panel
      (let [new-panel (.createElement js/document "div")]
        (.setAttribute new-panel "id" id)
        (.appendChild (.-body js/document) new-panel)
        (js/window.focus new-panel)
        new-panel))))

(defn inject-styles []
  (let [id    "--re-frame-trace-styles--"
        styles-el (.getElementById js/document id)
        new-styles-el (.createElement js/document "style")
        new-styles styles/panel-styles]
    (.setAttribute new-styles-el "id" id)
    (-> new-styles-el
        (.-innerHTML)
        (set! new-styles))
    (if styles-el
      (-> styles-el
          (.-parentNode)
          (.replaceChild new-styles-el styles-el))
      (let []
        (.appendChild (.-head js/document) new-styles-el)
        new-styles-el))))

(defn inject-devtools! []
  (inject-styles)
  (r/render [devtools] (panel-div)))

(ns day8.re-frame.trace
  (:require [day8.re-frame.trace.subvis :as subvis]
            [day8.re-frame.trace.styles :as styles]
            [day8.re-frame.trace.components :as components]
            [re-frame.trace :as trace :include-macros true]
            [cljs.pprint :as pprint]
            [clojure.string :as str]
            [reagent.core :as r]
            [reagent.interop :refer-macros [$ $!]]
            [reagent.impl.util :as util]
            [reagent.impl.component :as component]
            [reagent.impl.batching :as batch]
            [reagent.ratom :as ratom]
            [goog.object :as gob]
            [re-frame.interop :as interop]

            [devtools.formatters.core :as devtools]))

(defn comp-name [c]
  (let [n (or (component/component-path c)
              (some-> c .-constructor util/fun-name))]
    (if-not (empty? n)
      n
      "")))

(def static-fns
  {:render
   (fn render []
     (this-as c
       (trace/with-trace {:op-type   :render
                          :tags      {:component-path (reagent.impl.component/component-path c)}
                          :operation (last (str/split (reagent.impl.component/component-path c) #" > "))}
                         (if util/*non-reactive*
                           (reagent.impl.component/do-render c)
                           (let [rat        ($ c :cljsRatom)
                                 _          (batch/mark-rendered c)
                                 res        (if (nil? rat)
                                              (ratom/run-in-reaction #(reagent.impl.component/do-render c) c "cljsRatom"
                                                                     batch/queue-render reagent.impl.component/rat-opts)
                                              (._run rat false))
                                 cljs-ratom ($ c :cljsRatom)] ;; actually a reaction
                             (trace/merge-trace!
                               {:tags {:reaction      (interop/reagent-id cljs-ratom)
                                       :input-signals (when cljs-ratom
                                                        (map interop/reagent-id (gob/get cljs-ratom "watching" :none)))}})
                             res)))))})

(defn monkey-patch-reagent []
  (let [#_#_real-renderer reagent.impl.component/do-render
        real-custom-wrapper reagent.impl.component/custom-wrapper
        real-next-tick      reagent.impl.batching/next-tick
        real-schedule       reagent.impl.batching/schedule]

    #_(set! reagent.impl.component/do-render
            (fn [c]
              (let [name (comp-name c)]
                (js/console.log c)
                (trace/with-trace {:op-type   :render
                                   :tags      {:component-path (reagent.impl.component/component-path c)}
                                   :operation (last (str/split name #" > "))}
                                  (real-renderer c)))))

    (set! reagent.impl.component/static-fns static-fns)

    (set! reagent.impl.component/custom-wrapper
          (fn [key f]
            (case key
              :componentWillUnmount
              (fn [] (this-as c
                       (trace/with-trace {:op-type   key
                                          :operation (last (str/split (comp-name c) #" > "))
                                          :tags      {:component-path (reagent.impl.component/component-path c)
                                                      :reaction       (interop/reagent-id ($ c :cljsRatom))}})
                       (.call (real-custom-wrapper key f) c c)))

              (real-custom-wrapper key f))))

    #_(set! reagent.impl.batching/next-tick (fn [f]
                                              (real-next-tick (fn []
                                                                (trace/with-trace {:op-type :raf}
                                                                                (f))))))

    #_(set! reagent.impl.batching/schedule schedule
            #_(fn []
                (reagent.impl.batching/do-after-render (fn [] (trace/with-trace {:op-type :raf-end})))
                (real-schedule)))))

(def traces (interop/ratom []))
(defn log-trace? [trace]
  (let [rendering? (= (:op-type trace) :render)]
    (if-not rendering?
      true
      (not (str/includes? (or (get-in trace [:tags :component-path]) "") "day8.re_frame.trace")))

    #_(if-let [comp-p (get-in trace [:tags :component-path])]
        (println comp-p))))

(defn disable-tracing! []
  (re-frame.trace/remove-trace-cb ::cb))

(defn enable-tracing! []
  (re-frame.trace/register-trace-cb ::cb (fn [new-traces]
                                           (let [new-traces (filter log-trace? new-traces)]
                                             (swap! traces #(reduce conj % new-traces))))))

(defn init-tracing!
  "Sets up any intial state that needs to be there for tracing. Does not enable tracing."
  []
  (monkey-patch-reagent))

(defn search-input [{:keys [title on-save on-change on-stop]}]
  (let [val  (r/atom title)
        save #(let [v (-> @val str str/trim)]
                (when (pos? (count v))
                  (on-save v)))]
    (fn []
      [:input {:style       {:margin-left 7}
               :type        "text"
               :value       @val
               :auto-focus  true
               :on-change   #(do (reset! val (-> % .-target .-value))
                                 (on-change %))
               :on-key-down #(case (.-which %)
                               13 (do
                                    (save)
                                    (reset! val ""))
                               nil)}])))

(defn query->fn [query]
  (if (= "contains" (:filter-type query))
    (fn [trace]
      (str/includes? (str/lower-case (str (:operation trace) " " (:op-type trace)))
                    (:query query)))
    (fn [trace]
      (< (js/parseInt (:query query)) (:duration trace)))))

(defn render-traces [showing-traces]
  (doall
    (for [{:keys [op-type id operation tags duration] :as trace} showing-traces]
      (let [padding   {:padding "0px 5px 0px 5px"}
            row-style (merge padding {:border-top (case op-type :event "1px solid lightgrey" nil)})
            #_#__ (js/console.log (devtools/header-api-call tags))]

        (list [:tr {:key   id
                    :style {:color (case op-type
                                     :sub/create "green"
                                     :sub/run "#fd701e"
                                     :event "blue"
                                     :render "purple"
                                     :re-frame.router/fsm-trigger "#fd701e"
                                     nil)}}
               [:td {:style row-style} (str op-type)]
               [:td {:style row-style} operation]
               [:td
                {:style (merge row-style {:font-weight (if (< slower-than-bold-int duration)
                                                         "bold"
                                                         "")
                                          :white-space "nowrap"})}

                (.toFixed duration 1) " ms"]]
              (when true
                [:tr {:key (str id "-details")}
                 [:td {:col-span 3} (with-out-str (pprint/pprint (dissoc tags :query-v :event :duration)))]]))))))

(defonce app-state [:traces {:filter-input ""
                             :filter-items []}]) ;; [{:id (random-uuid) :query "showing" :filter-type "contains"} {:id (random-uuid) :query "Reagent" :filter-type "contains"}

(defn render-trace-panel []
  (let [filter-input     (r/atom "")
        filter-items     (r/atom [])
        filter-type      (r/atom "contains")]
    (fn []
      (let [showing-traces       (if (= @filter-items [])
                                   @traces
                                   (filter (apply every-pred (map query->fn @filter-items)) @traces))
            save-query           (fn [_]
                                   (println @filter-type @filter-input)
                                   (swap! filter-items conj {:id (random-uuid)
                                                             :query (if (= @filter-type "contains")
                                                                      (str/lower-case @filter-input)
                                                                      (js/parseInt @filter-input))
                                                             :filter-type @filter-type}))]
        [:div
         [:div.filter-control {:style {:margin-bottom 20}}
           [:div.filter-control-input
            {:style {:margin-bottom 10}}
            [:select {:value @filter-type :on-change (fn [e]
                                                         (reset! filter-type (.. e -target -value))
                                                         (println (.. e -target -value)))}
             [:option "contains"]
             [:option "slower than"]]
            [search-input {:on-save save-query
                           :on-change #(reset! filter-input (.. % -target -value))}]
            [:button.button.icon-button {:on-click save-query
                                         :style {:margin 0}}
             [components/icon-add]]
            ;; [:button {:style {:background "#aae0ec"
            ;;                   :padding 7
            ;;                   :margin 5}}
            ;;  "-"]]
            [:br]]
           [:ul.filter-items
             (map (fn [item]
                      ^{:key (:id item)}
                      [:li.filter-item.button
                        {:on-click (fn [event] (swap! filter-items #(remove (comp (partial = (:query item)) :query) %)))}
                        (:filter-type item) ": " [:span.filter-item-string (:query item)]
                        [:button.icon-button [components/icon-remove]]])
                  @filter-items)]]
         [:table
          {:cell-spacing "0" :width "100%"}
          [:thead>tr
           [:th "operations"]
           [:th
             (when (pos? (count showing-traces))
               (str (count showing-traces) " of "))
             (when (pos? (count @traces))
               (str (count @traces)))
             " events "
             (when (pos? (count @traces))
               [:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! traces []))} "clear"] ")"])]
           [:th "meta"]]
          [:tbody (render-traces showing-traces)]]]))))

(defn resizer-style [draggable-area]
  {:position "absolute" :z-index 2 :opacity 0
   :left     (str (- (/ draggable-area 2)) "px") :width "10px" :top "0px" :height "100%" :cursor "col-resize"})

(def ease-transition "left 0.2s ease-out, top 0.2s ease-out, width 0.2s ease-out, height 0.2s ease-out")

(defn devtools []
  ;; Add clear button
  ;; Filter out different trace types
  (let [position       (r/atom :right)
        size           (r/atom 0.35)
        showing?       (r/atom false)
        dragging?      (r/atom false)
        pin-to-bottom? (r/atom true)
        selected-tab   (r/atom :traces)
        handle-keys    (fn [e]
                         (let [combo-key?      (or (.-ctrlKey e) (.-metaKey e) (.-altKey e))
                               tag-name        (.-tagName (.-target e))
                               key             (.-key e)
                               entering-input? (contains? #{"INPUT" "SELECT" "TEXTAREA"} tag-name)]
                           (when (and (not entering-input?) combo-key?)
                             (cond
                               (and (= key "h") (.-ctrlKey e))
                               (do (swap! showing? not)
                                   (if @showing?
                                     (enable-tracing!)
                                     (disable-tracing!))
                                   (.preventDefault e))))))]
    (r/create-class
      {:component-will-mount   #(js/window.addEventListener "keydown" handle-keys)
       :component-will-unmount #(js/window.removeEventListener "keydown" handle-keys)
       :display-name           "devtools outer"
       :reagent-render         (fn []
                                 (let [draggable-area 10
                                       full-width     js/window.innerWidth
                                       full-height    js/window.innerHeight
                                       left           (if @showing? (str (* 100 (- 1 @size)) "%")
                                                                    (str full-width "px"))
                                       transition     (if @showing?
                                                        ease-transition
                                                        (str ease-transition ", opacity 0.01s linear 0.2s"))]
                                   [:div.panel-wrapper
                                    {:style {:position "fixed" :width "0px" :height "0px" :top "0px" :left "0px" :z-index 99999999}}
                                    [:div.panel
                                      {:style {:position   "fixed" :z-index 1 :box-shadow "rgba(0, 0, 0, 0.298039) 0px 0px 4px" :background "white"
                                               :left       left :top "0px" :width (str (* 100 @size) "%") :height "100%"
                                               :transition transition}}
                                      [:div.panel-resizer {:style         (resizer-style draggable-area)
                                                           :on-mouse-down #(reset! dragging? true)
                                                           :on-mouse-up   #(reset! dragging? false)
                                                           :on-mouse-move (fn [e]
                                                                           (when @dragging?
                                                                             (let [x (.-clientX e)
                                                                                y (.-clientY e)]
                                                                               (.preventDefault e)
                                                                               (reset! size (/ (- full-width x)
                                                                                full-width)))))}]
                                      [:div.panel-content
                                        {:style {:width "100%" :height "100%" :display "flex" :flex-direction "column"}}
                                        [:div.panel-content-top
                                          [:div.nav
                                            [:button {:class (str "tab button " (when (= @selected-tab :traces) "active"))
                                                      :on-click #(reset! selected-tab :traces)} "Traces"]
                                            [:button {:class (str "tab button " (when (= @selected-tab :subvis) "active"))
                                                      :on-click #(reset! selected-tab :subvis)} "SubVis"]]]
                                        [:div.panel-content-scrollable
                                          (case @selected-tab
                                            :traces [render-trace-panel]
                                            :subvis [subvis/render-subvis traces]
                                            [render-trace-panel])]]]]))})))

(defn panel-div []
  (let [id    "--re-frame-trace--"
        panel (.getElementById js/document id)]
    (if panel
      panel
      (let [new-panel (.createElement js/document "div")]
        (.setAttribute new-panel "id" id)
        (.appendChild (.-body js/document) new-panel)
        (js/window.focus new-panel)
        new-panel))))

(defn inject-styles []
  (let [id    "--re-frame-trace-styles--"
        styles-el (.getElementById js/document id)
        new-styles-el (.createElement js/document "style")
        new-styles styles/panel-styles]
    (.setAttribute new-styles-el "id" id)
    (-> new-styles-el
        (.-innerHTML)
        (set! new-styles))
    (if styles-el
      (-> styles-el
          (.-parentNode)
          (.replaceChild new-styles-el styles-el))
      (let []
        (.appendChild (.-head js/document) new-styles-el)
        new-styles-el))))

(defn inject-devtools! []
  (inject-styles)
  (r/render [devtools] (panel-div)))

Refactor filter function

Refactor filter function


(ns c2.core
  (:use-macros [c2.util :only [p pp]])
  (:use [cljs.reader :only [read-string]]
        [c2.dom :only [select select-all node-type append! remove! children build-dom-elem merge-dom! request-animation-frame]])
  (:require [goog.dom :as gdom]
            [clojure.set :as set]
            [clojure.string :as string]))

;;Seq over native JavaScript node collections
(extend-type js/NodeList
  ISeqable
  (-seq [array] (array-seq array 0)))
(extend-type js/HTMLCollection
  ISeqable
  (-seq [array] (array-seq array 0)))

;;This is required so that DOM nodes can be used in sets
(extend-type js/Node
  IHash
  (-hash [x] x))

(def node-data-key "c2")
(defmulti attach-data (fn [node d] (node-type node)))
(defmethod attach-data :chiccup [node d]
  (assoc node :data
         (binding [*print-dup* true] (pr-str d))))

(defmethod attach-data :dom [node d]
  (set! (.-__c2data__ node) d)
  node)

(defmulti read-data (fn [node] (node-type node)))
(defmethod read-data :chiccup [node]
  (read-string (:data node)))
(defmethod read-data :dom [node]
  (let [d (.-__c2data__ node)]
    (if (undefined? d) nil d)))

;;Used to generate unique IDs for auto-unify atom watchers
(def ^:private auto-unify-id (atom 0))

(defmulti unify!
  "Given container, data, and mapping-fn, calls (mapping datum idx) for each datum and appends resulting elements to container.
Automatically updates elements mapped to data according to key-fn (defaults to index) and removes elements that don't match.
Scoped to :selector kwarg if given, otherwise applies to all container's children.

Optional kwargs fns (args prefixed with $ are live DOM nodes):

  (enter d idx $node)
  (update d idx $old new)
  (exit d idx $node)

called before DOM changed; return false to prevent default behavior.

If data implements IWatchable, DOM will update when data changes."
  (fn [container data mapping & kwargs]
    (cond (satisfies? cljs.core.IWatchable data) :atom
          (satisfies? cljs.core.ISeqable data)   :seq
          :else (do (pp data)
                    (throw (js/Error. "Unify! requires data to be seqable or an atom containing seqable"))))))

(defmethod unify! :atom
  [container !data & args]
  (let [redraw! #(apply unify! container % args)]
    ;;add watcher to redraw whenever atom is update
    (add-watch !data (keyword (str "auto-unify" (swap! auto-unify-id inc)))
               (fn [_ _ old new] (when (not= old new)
                                  (redraw! new))))
    ;;initial draw
    (redraw! @!data)))

(defmethod unify! :seq
  [container data mapping & {:keys [selector key-fn pre-fn post-fn update exit enter
                                    defer-attr force-update]
                             :or {key-fn (fn [d idx] idx)
                                  defer-attr false}}]

  (let [container (select container)
        data (if pre-fn (pre-fn data) data)
        existing-nodes-by-key (into {} (map-indexed (fn [idx node]
                                                      (let [datum (read-data node)]
                                                        [(key-fn datum idx) {:node node
                                                                             :idx idx
                                                                             :datum datum}]))
                                                    (if selector
                                                      (select-all selector container)
                                                      (children container))))]

    ;;Remove any stale nodes
    (doseq [k (set/difference (set (keys existing-nodes-by-key))
                              (set (map key-fn data (range))))]
      (let [{:keys [node idx datum]} (existing-nodes-by-key k)]
        (when (or (nil? exit)
                  (exit datum idx node))
          (remove! node))))

    ;;For each datum, update existing nodes and add new ones
    (doseq [[idx d] (map-indexed vector data)]
      (let [new-node (mapping d idx)]
        ;;If there's an existing node
        (if-let [old (existing-nodes-by-key (key-fn d idx))]
          (do
            ;;append it (effectively moving it to the correct index in the container)
            (append! container (:node old))
            (when (and (or (not= d (:datum old))
                           force-update)
                       (or (nil? update)
                           (update d idx (:node old) new-node)))
              (attach-data (merge-dom! (:node old) new-node
                                       :defer-attr defer-attr)
                           d)))

          (let [$new-node (-> new-node
                              (build-dom-elem)
                              (attach-data d))]
            (when (or (nil? enter)
                      (enter d idx $new-node))
              (append! container $new-node))))))

    ;;Run post-fn, if it was given
    (when post-fn
      ;;Give the browser 10 ms to get its shit together, if the post-fn involves advanced layout.
      ;;Without this delay, CSS3 animations sometimes don't happen.
      (request-animation-frame #(post-fn data)))))

(ns c2.core
  (:use-macros [c2.util :only [p pp]])
  (:use [cljs.reader :only [read-string]]
        [c2.dom :only [select select-all node-type append! remove! children build-dom-elem merge-dom! request-animation-frame]])
  (:require [goog.dom :as gdom]
            [clojure.set :as set]
            [clojure.string :as string]))

;;Seq over native JavaScript node collections
(extend-type js/NodeList
  ISeqable
  (-seq [array] (array-seq array 0)))
(extend-type js/HTMLCollection
  ISeqable
  (-seq [array] (array-seq array 0)))

;;This is required so that DOM nodes can be used in sets
(extend-type js/Node
  IHash
  (-hash [x] x))

(def node-data-key "c2")
(defmulti attach-data (fn [node d] (node-type node)))
(defmethod attach-data :chiccup [node d]
  (assoc node :data
         (binding [*print-dup* true] (pr-str d))))

(defmethod attach-data :dom [node d]
  (set! (.-__c2data__ node) d)
  node)

(defmulti read-data (fn [node] (node-type node)))
(defmethod read-data :chiccup [node]
  (read-string (:data node)))
(defmethod read-data :dom [node]
  (let [d (.-__c2data__ node)]
    (if (undefined? d) nil d)))

(defmulti unify!
  "Given container, data, and mapping-fn, calls (mapping datum idx) for each datum and appends resulting elements to container.
Automatically updates elements mapped to data according to key-fn (defaults to index) and removes elements that don't match.
Scoped to :selector kwarg if given, otherwise applies to all container's children.

Optional kwargs fns (args prefixed with $ are live DOM nodes):

  (enter d idx $node)
  (update d idx $old new)
  (exit d idx $node)

called before DOM changed; return false to prevent default behavior.

If data implements IWatchable, DOM will update when data changes."
  (fn [container data mapping & kwargs]
    (cond (satisfies? cljs.core.IWatchable data) :atom
          (satisfies? cljs.core.ISeqable data)   :seq
          :else (do (pp data)
                    (throw (js/Error. "Unify! requires data to be seqable or an atom containing seqable"))))))

(defmethod unify! :atom
  [container !data & args]
  (let [redraw! #(apply unify! container % args)]
    ;;add watcher to redraw whenever atom is update
    (add-watch !data (keyword (gensym "auto-unify!-"))
               (fn [_ _ old new] (when (not= old new)
                                  (redraw! new))))
    ;;initial draw
    (redraw! @!data)))

(defmethod unify! :seq
  [container data mapping & {:keys [selector key-fn pre-fn post-fn update exit enter
                                    defer-attr force-update]
                             :or {key-fn (fn [d idx] idx)
                                  defer-attr false}}]

  (let [container (select container)
        data (if pre-fn (pre-fn data) data)
        existing-nodes-by-key (into {} (map-indexed (fn [idx node]
                                                      (let [datum (read-data node)]
                                                        [(key-fn datum idx) {:node node
                                                                             :idx idx
                                                                             :datum datum}]))
                                                    (if selector
                                                      (select-all selector container)
                                                      (children container))))]

    ;;Remove any stale nodes
    (doseq [k (set/difference (set (keys existing-nodes-by-key))
                              (set (map key-fn data (range))))]
      (let [{:keys [node idx datum]} (existing-nodes-by-key k)]
        (when (or (nil? exit)
                  (exit datum idx node))
          (remove! node))))

    ;;For each datum, update existing nodes and add new ones
    (doseq [[idx d] (map-indexed vector data)]
      (let [new-node (mapping d idx)]
        ;;If there's an existing node
        (if-let [old (existing-nodes-by-key (key-fn d idx))]
          (do
            ;;append it (effectively moving it to the correct index in the container)
            (append! container (:node old))
            (when (and (or (not= d (:datum old))
                           force-update)
                       (or (nil? update)
                           (update d idx (:node old) new-node)))
              (attach-data (merge-dom! (:node old) new-node
                                       :defer-attr defer-attr)
                           d)))

          (let [$new-node (-> new-node
                              (build-dom-elem)
                              (attach-data d))]
            (when (or (nil? enter)
                      (enter d idx $new-node))
              (append! container $new-node))))))

    ;;Run post-fn, if it was given
    (when post-fn
      ;;Give the browser 10 ms to get its shit together, if the post-fn involves advanced layout.
      ;;Without this delay, CSS3 animations sometimes don't happen.
      (request-animation-frame #(post-fn data)))))

Use gensym instead of custom hack to guarantee uniqueness of watcher keys.


(ns foreclojure.problems
  (:use [foreclojure.utils]
        [clojail core testers]
	[somnium.congomongo]
        [hiccup form-helpers])
  (:require [sandbar.stateful-session :as session]
            [clojure.string :as s]
            [clj-github.gists :as gist]))

(defn get-solved [user]
  (set
   (:solved (from-mongo
             (fetch-one :users
                        :where {:user user}
                        :only [:solved])))))

(defn get-problem [x]
  (from-mongo
   (fetch-one :problems :where {:_id x})))

(defn get-problem-list []
  (from-mongo
   (fetch :problems
          :only [:_id :title :tags :times-solved]
          :sort {:id 1})))

(defn gist!
  "Create a new gist containing a user's solution to a problem and
  return its url."
  [user-name problem-num solution]
  (let [user-name (or user-name "anonymous")
        filename (str user-name "-4clojure-solution" problem-num ".clj")
        text (str ";; " user-name
                  "'s solution to http://4clojure.com/problem/" problem-num
                  "\n\n"
                  solution)]
    (try
      (->> (gist/new-gist {} filename text)
           :repo
           (str "https://gist.github.com/"))
      (catch Throwable _ nil))))

(defn mark-completed [id code & [user]]
  (let [user (or user (session/session-get :user))
        gist-url (gist! user id code)
        gist-link (if gist-url
                    (str "
"
                         "Share this "
                         "solution"
                         " on Twitter!"
                         "
")
                    (str "
Failed to create gist of "
                         "your solution
"))

        message
        (if user
          (do
            (when (not-any? #{id} (get-solved user))
              (update! :users {:user user} {:$push {:solved id}})
              (update! :problems {:_id id} {:$inc {:times-solved 1}}))
            "Congratulations, you've solved the problem!")
          "You've solved the problem! If you log in we can track your progress.")]
    (flash-msg (str message " " gist-link) "/problems")))

(defn get-tester [restricted]
  (into secure-tester (map symbol restricted)))

(def sb (sandbox*))

(defn run-code [id raw-code]
  (let [code (.trim raw-code)
	p (get-problem id)
        tests (concat (:tests p) (:secret-tests p))
        func-name (:function-name p)
        sb-tester (get-tester (:restricted p))]
    (if (empty? code)
      (do
	(session/flash-put! :code code)
	(flash-error "Empty input is not allowed"
		     (str "/problem/" id)))
      (try
	(loop [[test & more] tests]
	  (if-not test
	    (mark-completed id code)
	    (let [testcase (s/replace test "__" (str code))]
	      (if (sb sb-tester (read-string testcase))
		(recur more)
		(do
		  (session/flash-put! :code code)
		  (flash-error "You failed the unit tests."
			       (str "/problem/" id)))))))
	(catch Exception e
	  (do
	    (session/flash-put! :code code)
	    (flash-error (.getMessage e) (str "/problem/" id))))))))

(def-page code-box [id]
  (let [problem (get-problem (Integer. id))]
    [:div
     [:span {:id "prob-title"} (problem :title)]
     [:hr]
     [:div {:id "prob-desc"}
      (problem :description)[:br]
      [:div {:id "testcases"}
       (for [test (:tests problem)]
         [:li {:class "testcase"} test])]
      (if-let [restricted (problem :restricted)]
        [:div {:id "restrictions"}
         [:u "Special Restrictions"] [:br]
         (map (partial vector :li) restricted)])]
     [:div
      [:b "Enter your code:" [:br]
       [:span {:class "error"} (session/flash-get :error)]]]
     (form-to [:post "/run-code"]
              (text-area {:id "code-box"
                          :spellcheck "false"}
                         :code (session/flash-get :code))
              (hidden-field :id id)
              (submit-button {:type "image" :src "/run.png"} "Run"))]))

(def-page problem-page []
  [:div {:class "congrats"} (session/flash-get :message)]
  [:table {:class "my-table" :width "60%"}
   [:th "Title"]
   [:th "Tags"]
   [:th "Count"]
   [:th "Solved?"]
   (let [solved (get-solved (session/session-get :user))
         problems (get-problem-list)]
     (map-indexed
      (fn [x {:keys [title times-solved tags], id :_id}]
        [:tr (row-class x)
         [:td {:class "title-link"}
          [:a {:href (str "/problem/" id)}
           title]]
         [:td {:class "centered"}
          (s/join " " (map #(str "" % "")
                           tags))]
         [:td {:class "centered"} (int times-solved)]
         [:td {:class "centered"}
          [:img {:src (if (contains? solved id)
                        "/checkmark.png"
                        "/empty-sq.png")}]]])
      problems))])

(ns foreclojure.problems
  (:use [foreclojure.utils]
        [clojail core testers]
	[somnium.congomongo]
        [hiccup form-helpers]
        [amalloy.utils.debug :only [?]])
  (:require [sandbar.stateful-session :as session]
            [clojure.string :as s]
            [clj-github.gists :as gist])
  (:import (java.net URLEncoder)))

(defn get-solved [user]
  (set
   (:solved (from-mongo
             (fetch-one :users
                        :where {:user user}
                        :only [:solved])))))

(defn get-problem [x]
  (from-mongo
   (fetch-one :problems :where {:_id x})))

(defn get-problem-list []
  (from-mongo
   (fetch :problems
          :only [:_id :title :tags :times-solved]
          :sort {:id 1})))

(defn gist!
  "Create a new gist containing a user's solution to a problem and
  return its url."
  [user-name problem-num solution]
  (let [user-name (or user-name "anonymous")
        filename (str user-name "-4clojure-solution" problem-num ".clj")
        text (str ";; " user-name
                  "'s solution to http://4clojure.com/problem/" problem-num
                  "\n\n"
                  solution)]
    (try
      (->> (gist/new-gist {} filename text)
           :repo
           (str "https://gist.github.com/"))
      (catch Throwable _ nil))))

(defn tweet-link [id gist-url & [link-text]]
  (let [status-msg (str "Check out how I solved http://4clojure.com/problem/"
                        id " - " gist-url " #clojure #4clojure")]
    (str ""
         (or link-text "Twitter")
         "")))

(defn mark-completed [id code & [user]]
  (let [user (or user (session/session-get :user))
        gist-url (gist! user id code)
        gist-link (if gist-url
                    (str "
"
                         "Share this "
                         "solution"
                         " on " (tweet-link id gist-url) "!"
                         "
")
                    (str "
Failed to create gist of "
                         "your solution
"))

        message
        (if user
          (do
            (when (not-any? #{id} (get-solved user))
              (update! :users {:user user} {:$push {:solved id}})
              (update! :problems {:_id id} {:$inc {:times-solved 1}}))
            "Congratulations, you've solved the problem!")
          "You've solved the problem! If you log in we can track your progress.")]
    (flash-msg (str message " " gist-link) "/problems")))

(defn get-tester [restricted]
  (into secure-tester (map symbol restricted)))

(def sb (sandbox*))

(defn run-code [id raw-code]
  (let [code (.trim raw-code)
	p (get-problem id)
        tests (concat (:tests p) (:secret-tests p))
        func-name (:function-name p)
        sb-tester (get-tester (:restricted p))]
    (if (empty? code)
      (do
	(session/flash-put! :code code)
	(flash-error "Empty input is not allowed"
		     (str "/problem/" id)))
      (try
	(loop [[test & more] tests]
	  (if-not test
	    (mark-completed id code)
	    (let [testcase (s/replace test "__" (str code))]
	      (if (sb sb-tester (read-string testcase))
		(recur more)
		(do
		  (session/flash-put! :code code)
		  (flash-error "You failed the unit tests."
			       (str "/problem/" id)))))))
	(catch Exception e
	  (do
	    (session/flash-put! :code code)
	    (flash-error (.getMessage e) (str "/problem/" id))))))))

(def-page code-box [id]
  (let [problem (get-problem (Integer. id))]
    [:div
     [:span {:id "prob-title"} (problem :title)]
     [:hr]
     [:div {:id "prob-desc"}
      (problem :description)[:br]
      [:div {:id "testcases"}
       (for [test (:tests problem)]
         [:li {:class "testcase"} test])]
      (if-let [restricted (problem :restricted)]
        [:div {:id "restrictions"}
         [:u "Special Restrictions"] [:br]
         (map (partial vector :li) restricted)])]
     [:div
      [:b "Enter your code:" [:br]
       [:span {:class "error"} (session/flash-get :error)]]]
     (form-to [:post "/run-code"]
              (text-area {:id "code-box"
                          :spellcheck "false"}
                         :code (session/flash-get :code))
              (hidden-field :id id)
              (submit-button {:type "image" :src "/run.png"} "Run"))]))

(def-page problem-page []
  [:div {:class "congrats"} (session/flash-get :message)]
  [:table {:class "my-table" :width "60%"}
   [:th "Title"]
   [:th "Tags"]
   [:th "Count"]
   [:th "Solved?"]
   (let [solved (get-solved (session/session-get :user))
         problems (get-problem-list)]
     (map-indexed
      (fn [x {:keys [title times-solved tags], id :_id}]
        [:tr (row-class x)
         [:td {:class "title-link"}
          [:a {:href (str "/problem/" id)}
           title]]
         [:td {:class "centered"}
          (s/join " " (map #(str "" % "")
                           tags))]
         [:td {:class "centered"} (int times-solved)]
         [:td {:class "centered"}
          [:img {:src (if (contains? solved id)
                        "/checkmark.png"
                        "/empty-sq.png")}]]])
      problems))])

Make the Twitter link supply a default tweet content


(ns foreclojure.problems
  (:use foreclojure.utils
        [foreclojure.social :only [tweet-link gist!]]
        [clojail core testers]
        somnium.congomongo
        (hiccup form-helpers page-helpers core)
        [amalloy.utils.debug :only [?]]
        compojure.core)
  (:require [sandbar.stateful-session :as session]
            [clojure.string :as s]))

(defn get-solved [user]
  (set
   (:solved (from-mongo
             (fetch-one :users
                        :where {:user user}
                        :only [:solved])))))

(defn get-problem [x]
  (from-mongo
   (fetch-one :problems :where {:_id x})))

(defn get-problem-list []
  (from-mongo
   (fetch :problems
          :only [:_id :title :tags :times-solved]
          :sort {:id 1})))

(defn mark-completed [id code & [user]]
  (let [user (or user (session/session-get :user))
        gist-link (html [:div.share
                         [:a.novisited {:href "/share/code"} "Share"]
                         " this solution with your friends!"])

        message
        (if user
          (do
            (when (not-any? #{id} (get-solved user))
              (update! :users {:user user} {:$addToSet {:solved id}})
              (update! :problems {:_id id} {:$inc {:times-solved 1}}))
            "Congratulations, you've solved the problem!")
          "You've solved the problem! If you log in we can track your progress.")]
    (session/session-put! :code [id code])
    (flash-msg (str message " " gist-link) "/problems")))

(def restricted-list ['use 'require 'in-ns 'future 'agent 'send 'send-off 'pmap 'pcalls])

(defn get-tester [restricted]
  (into secure-tester (concat restricted-list (map symbol restricted))))

(def sb (sandbox*))

(defn run-code [id raw-code]
  (let [code (.trim raw-code)
	p (get-problem id)
        tests (:tests p)
        func-name (:function-name p)
        sb-tester (get-tester (:restricted p))]
    (if (empty? code)
      (do
	(session/flash-put! :code code)
	(flash-error "Empty input is not allowed"
		     (str "/problem/" id)))
      (try
	(loop [[test & more] tests]
	  (if-not test
	    (mark-completed id code)
	    (let [testcase (s/replace test "__" (str code))]
	      (if (sb sb-tester (read-string testcase))
		(recur more)
		(do
		  (session/flash-put! :code code)
		  (flash-error "You failed the unit tests."
			       (str "/problem/" id)))))))
	(catch Exception e
	  (do
	    (session/flash-put! :code code)
	    (flash-error (.getMessage e) (str "/problem/" id))))))))

(def-page code-box [id]
  (let [problem (get-problem (Integer. id))]
    [:div
     [:span {:id "prob-title"} (problem :title)]
     [:hr]
     [:div {:id "prob-desc"}
      (problem :description)[:br]
      [:div {:id "testcases"}
       (for [test (:tests problem)]
         [:li {:class "testcase"} test])]
      (if-let [restricted (problem :restricted)]
        [:div {:id "restrictions"}
         [:u "Special Restrictions"] [:br]
         (map (partial vector :li) restricted)])]
     [:div
      [:b "Enter your code:" [:br]
       [:span {:class "error"} (session/flash-get :error)]]]
     (form-to [:post "/run-code"]
              (text-area {:id "code-box"
                          :spellcheck "false"}
                         :code (session/flash-get :code))
              (hidden-field :id id)
              [:br]
              [:button.large {:type "submit"} "Run"])]))

(def-page problem-page []
  [:div.congrats (session/flash-get :message)]
  [:table#problem-table.my-table
   [:thead
    [:tr
     [:th "Title"]
     [:th "Tags"]
     [:th "Count"]
     [:th "Solved?"]]]
   (let [solved (get-solved (session/session-get :user))
         problems (get-problem-list)]
     (map-indexed
      (fn [x {:keys [title times-solved tags], id :_id}]
        [:tr (row-class x)
         [:td.titlelink
          [:a {:href (str "/problem/" id)}
           title]]
         [:td.centered
          (s/join " " (map #(str "" % "")
                           tags))]
         [:td.centered (int times-solved)]
         [:td.centered
          [:img {:src (if (contains? solved id)
                        "/images/checkmark.png"
                        "/images/empty-sq.png")}]]])
      problems))])

(defroutes problems-routes
  (GET "/problems" [] (problem-page))
  (GET "/problem/:id" [id] (code-box id))
  (POST "/run-code" {{:strs [id code]} :form-params}
        (run-code (Integer. id) code)))

(ns foreclojure.problems
  (:use foreclojure.utils
        [foreclojure.social :only [tweet-link gist!]]
        [clojail core testers]
        somnium.congomongo
        (hiccup form-helpers page-helpers core)
        [amalloy.utils.debug :only [?]]
        compojure.core)
  (:require [sandbar.stateful-session :as session]
            [clojure.string :as s]))

(defn get-solved [user]
  (set
   (:solved (from-mongo
             (fetch-one :users
                        :where {:user user}
                        :only [:solved])))))

(defn get-problem [x]
  (from-mongo
   (fetch-one :problems :where {:_id x})))

(defn get-problem-list []
  (from-mongo
   (fetch :problems
          :only [:_id :title :tags :times-solved]
          :sort {:id 1})))

(defn mark-completed [id code & [user]]
  (let [user (or user (session/session-get :user))
        gist-link (html [:div.share
                         [:a.novisited {:href "/share/code"} "Share"]
                         " this solution with your friends!"])

        message
        (if user
          (do
            (when (not-any? #{id} (get-solved user))
              (update! :users {:user user} {:$addToSet {:solved id}})
              (update! :problems {:_id id} {:$inc {:times-solved 1}}))
            "Congratulations, you've solved the problem!")
          "You've solved the problem! If you log in we can track your progress.")]
    (session/session-put! :code [id code])
    (flash-msg (str message " " gist-link) "/problems")))

(def restricted-list ['use 'require 'in-ns 'future 'agent 'send 'send-off 'pmap 'pcalls])

(defn get-tester [restricted]
  (into secure-tester (concat restricted-list (map symbol restricted))))

(def sb (sandbox*))

(defn run-code [id raw-code]
  (let [code (.trim raw-code)
	{:keys [tests restricted]} (get-problem id)
        sb-tester (get-tester restricted)]
    (if (empty? code)
      (do
	(session/flash-put! :code code)
	(flash-error "Empty input is not allowed"
		     (str "/problem/" id)))
      (try
	(loop [[test & more] tests]
	  (if-not test
	    (mark-completed id code)
	    (let [testcase (s/replace test "__" (str code))]
	      (if (sb sb-tester (read-string testcase))
		(recur more)
		(do
		  (session/flash-put! :code code)
		  (flash-error "You failed the unit tests."
			       (str "/problem/" id)))))))
	(catch Exception e
	  (do
	    (session/flash-put! :code code)
	    (flash-error (.getMessage e) (str "/problem/" id))))))))

(def-page code-box [id]
  (let [problem (get-problem (Integer. id))]
    [:div
     [:span {:id "prob-title"} (problem :title)]
     [:hr]
     [:div {:id "prob-desc"}
      (problem :description)[:br]
      [:div {:id "testcases"}
       (for [test (:tests problem)]
         [:li {:class "testcase"} test])]
      (if-let [restricted (problem :restricted)]
        [:div {:id "restrictions"}
         [:u "Special Restrictions"] [:br]
         (map (partial vector :li) restricted)])]
     [:div
      [:b "Enter your code:" [:br]
       [:span {:class "error"} (session/flash-get :error)]]]
     (form-to [:post "/run-code"]
              (text-area {:id "code-box"
                          :spellcheck "false"}
                         :code (session/flash-get :code))
              (hidden-field :id id)
              [:br]
              [:button.large {:type "submit"} "Run"])]))

(def-page problem-page []
  [:div.congrats (session/flash-get :message)]
  [:table#problem-table.my-table
   [:thead
    [:tr
     [:th "Title"]
     [:th "Tags"]
     [:th "Count"]
     [:th "Solved?"]]]
   (let [solved (get-solved (session/session-get :user))
         problems (get-problem-list)]
     (map-indexed
      (fn [x {:keys [title times-solved tags], id :_id}]
        [:tr (row-class x)
         [:td.titlelink
          [:a {:href (str "/problem/" id)}
           title]]
         [:td.centered
          (s/join " " (map #(str "" % "")
                           tags))]
         [:td.centered (int times-solved)]
         [:td.centered
          [:img {:src (if (contains? solved id)
                        "/images/checkmark.png"
                        "/images/empty-sq.png")}]]])
      problems))])

(defroutes problems-routes
  (GET "/problems" [] (problem-page))
  (GET "/problem/:id" [id] (code-box id))
  (POST "/run-code" {{:strs [id code]} :form-params}
        (run-code (Integer. id) code)))

Tidy up a little with destructuring

Tidy up a little with destructuring


(ns i18n-word-guess.game)

(defn- code->re [code]
  (re-pattern (str "^"
                   (clojure.string/replace code #"\d+" #(str "\\D{" % "}"))
                   "$")))

(defn- check-guess [code guess]
  (let [prev-re (code->re code)]
    (re-seq prev-re guess)))

(defn- opaque-mask [word]
  (apply str (repeat (count word) \*)))

(defn- transparent-mask [word]
  (apply str (repeat (count word) \_)))

(defn- transparent? [mask]
  (not-any? #{\*} mask))

(defn- set-at [string idx chr]
  (apply str (assoc (vec string) idx chr)))

(defn- reveal [side mask]
  (let [edge (case side
               :front (.indexOf mask "*")
               :back  (.lastIndexOf mask "*"))]
    (if (neg? edge)
      mask
      (set-at mask edge \_))))

(defn- encode [mask word]
  {:pre [(= (count mask) (count word))]}
  (letfn [(apply-mask [m w]
                      (apply str (map #(if (= %1 \*) \* %2) m w)))
          (collapse-stars [mw]
                          (clojure.string/replace mw #"\*+" #(str (count %))))]
    (->> word
         (apply-mask mask)
         collapse-stars)))

(defn create-game [word]
  (let [mask (->> (opaque-mask word)
                  (reveal :front)
                  (reveal :back))]
    [{:timestamp (java.util.Date.)
      :word word
      :mask mask
      :code (encode mask word)
      :status :start}]))

(defn step
  ([game new-guess]
   (step game new-guess (rand-nth [:front :back])))
  ([game new-guess reveal-side]
   (let [{:keys [word mask code status] :as prev-step} (last game)]
     (conj game
           (merge {:timestamp (java.util.Date.)
                   :word word
                   :guess new-guess}
                  (cond
                   (= new-guess word) {:mask (transparent-mask word)
                                       :code word
                                       :status (if (= status :win) :over :win)}
                   (some #{new-guess} (map :guess game)) {:mask mask
                                                          :code code
                                                          :status :repeat}
                   (check-guess code new-guess) (let [new-mask (reveal reveal-side mask)
                                                      new-mask (if (transparent? new-mask) mask new-mask)]
                                                  {:mask new-mask
                                                   :code (encode new-mask word)
                                                   :status :ok})
                   :else {:mask mask
                          :code code
                          :status :no-match}))))))

;;-----------------------------------------------------------------------------
;; Hints

(def vowels (into #{} "аеиоуыэюя"))

(defn- char-phon-class [c]
  (if (contains? vowels c) :vowel :consonant))

(defn- encode-hint [idx char-seq]
  (case (char-phon-class (first char-seq))
    :vowel (case (count char-seq)
             1 "A"
             2 "AO"
             3 "UAO")
    :consonant (case (count char-seq)
                 1 "T"
                 2 (if (pos? idx) "RT" "TR")
                 3 "STR"
                 4 "RNTK"
                 5 "FRNTK"
                 6 "PFRNTK")))

;; загвоздка -> TARTARTKA
;; баобаб -> TAOTAT
;; коэффициент -> TAORTATAORT

(defn word->phon [^String word]
  (->> (partition-by char-phon-class word)
       (map-indexed encode-hint)
       flatten
       (apply str)))

(defn code-hints [dict code]
  (->> dict
       (filter #(re-seq (code->re code) %))
       (map word->phon)
       distinct))

(ns i18n-word-guess.game)

(defn- code->re [code]
  (re-pattern (str "^"
                   (clojure.string/replace code #"\d+" #(str "\\D{" % "}"))
                   "$")))

(defn- check-guess [code guess]
  (let [prev-re (code->re code)]
    (re-seq prev-re guess)))

(defn- opaque-mask [word]
  (apply str (repeat (count word) \*)))

(defn- transparent-mask [word]
  (apply str (repeat (count word) \_)))

(defn- transparent? [mask]
  (not-any? #{\*} mask))

(defn- set-at [string idx chr]
  (apply str (assoc (vec string) idx chr)))

(defn- reveal [side mask]
  (let [edge (case side
               :front (.indexOf mask "*")
               :back  (.lastIndexOf mask "*"))]
    (if (neg? edge)
      mask
      (set-at mask edge \_))))

(defn- encode [mask word]
  {:pre [(= (count mask) (count word))]}
  (letfn [(apply-mask [m w]
                      (apply str (map #(if (= %1 \*) \* %2) m w)))
          (collapse-stars [mw]
                          (clojure.string/replace mw #"\*+" #(str (count %))))]
    (->> word
         (apply-mask mask)
         collapse-stars)))

(defn create-game [word]
  (let [mask (->> (opaque-mask word)
                  (reveal :front)
                  (reveal :back))]
    [{:timestamp (java.util.Date.)
      :word      word
      :mask      mask
      :code      (encode mask word)
      :status    :start}]))

(defn step
  ([game new-guess]
   (step game new-guess (rand-nth [:front :back])))
  ([game new-guess reveal-side]
   (let [{:keys [word mask code status] :as prev-step} (last game)]
     (conj game
           (merge {:word      word
                   :guess     new-guess
                   :timestamp (java.util.Date.)}
                  (cond
                   (= new-guess word) {:status (if (= status :win) :over :win)
                                       :mask   (transparent-mask word)
                                       :code   word}
                   (some #{new-guess} (map :guess game)) {:status :repeat
                                                          :mask   mask
                                                          :code   code}
                   (check-guess code new-guess) (let [new-mask (reveal reveal-side mask)
                                                      new-mask (if (transparent? new-mask) mask new-mask)]
                                                  {:status :ok
                                                   :mask   new-mask
                                                   :code   (encode new-mask word)})
                   :else {:status :no-match
                          :mask   mask
                          :code   code}))))))

;;-----------------------------------------------------------------------------
;; Hints

(def vowels (into #{} "аеиоуыэюя"))

(defn- char-phon-class [c]
  (if (contains? vowels c) :vowel :consonant))

(defn- encode-hint [idx char-seq]
  (case (char-phon-class (first char-seq))
    :vowel (case (count char-seq)
             1 "A"
             2 "AO"
             3 "UAO")
    :consonant (case (count char-seq)
                 1 "T"
                 2 (if (pos? idx) "RT" "TR")
                 3 "STR"
                 4 "RNTK"
                 5 "FRNTK"
                 6 "PFRNTK")))

;; загвоздка -> TARTARTKA
;; баобаб -> TAOTAT
;; коэффициент -> TAORTATAORT

(defn word->phon [^String word]
  (->> (partition-by char-phon-class word)
       (map-indexed encode-hint)
       flatten
       (apply str)))

(defn code-hints [dict code]
  (->> dict
       (filter #(re-seq (code->re code) %))
       (map word->phon)
       distinct))

Clean up

Clean up


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

(ns uxbox.main.ui.shapes.path
  (:require [potok.core :as ptk]
            [cuerdas.core :as str :include-macros true]
            [uxbox.main.store :as st]
            [uxbox.main.ui.shapes.common :as common]
            [uxbox.main.ui.shapes.attrs :as attrs]
            [uxbox.main.data.shapes :as uds]
            [uxbox.main.geom :as geom]
            [uxbox.util.geom.matrix :as gmt]
            [uxbox.util.geom.point :as gpt]
            [uxbox.util.mixins :as mx :include-macros true]))
;; --- Path Component

(declare path-shape)

(mx/defc path-component
  {:mixins [mx/static mx/reactive]}
  [{:keys [id] :as shape}]
  (let [modifiers (mx/react (common/modifiers-ref id))
        selected (mx/react common/selected-ref)
        selected? (contains? selected id)
        shape (assoc shape :modifiers modifiers)]
    (letfn [(on-mouse-down [event]
              (common/on-mouse-down event shape selected))
            (on-double-click [event]
              (when selected?
                (st/emit! (uds/start-edition-mode id))))]
      [:g.shape {:class (when selected? "selected")
                 :on-double-click on-double-click
                 :on-mouse-down on-mouse-down}
       (path-shape shape)])))

;; --- Path Shape

(defn- render-path
  [{:keys [segments close?] :as shape}]
  (let [numsegs (count segments)]
    (loop [buffer []
           index 0]
      (cond
        (>= index numsegs)
        (if close?
          (str/join " " (conj buffer "Z"))
          (str/join " " buffer))

        (zero? index)
        (let [{:keys [x y] :as segment} (nth segments index)
              buffer (conj buffer (str/istr "M~{x},~{y}"))]
          (recur buffer (inc index)))

        :else
        (let [{:keys [x y] :as segment} (nth segments index)
              buffer (conj buffer (str/istr "L~{x},~{y}"))]
          (recur buffer (inc index)))))))

(mx/defc path-shape
  {:mixins [mx/static]}
  [{:keys [id modifiers rotation] :as shape}]
  (let [{:keys [resize displacement]} modifiers
        shape (cond-> shape
                displacement (geom/transform displacement)
                resize (geom/transform resize)
                (pos? rotation) (geom/rotate-shape))

        props {:id (str id)
               :d (render-path shape)}
        attrs (merge props (attrs/extract-style-attrs shape))]
    [:path attrs]))

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

(ns uxbox.main.ui.shapes.path
  (:require [potok.core :as ptk]
            [cuerdas.core :as str :include-macros true]
            [uxbox.main.store :as st]
            [uxbox.main.ui.shapes.common :as common]
            [uxbox.main.ui.shapes.attrs :as attrs]
            [uxbox.main.data.shapes :as uds]
            [uxbox.main.geom :as geom]
            [uxbox.util.geom.matrix :as gmt]
            [uxbox.util.geom.point :as gpt]
            [uxbox.util.mixins :as mx :include-macros true]))
;; --- Path Component

(declare path-shape)

(mx/defc path-component
  {:mixins [mx/static mx/reactive]}
  [{:keys [id] :as shape}]
  (let [modifiers (mx/react (common/modifiers-ref id))
        selected (mx/react common/selected-ref)
        selected? (contains? selected id)
        shape (assoc shape
                     :modifiers modifiers
                     :background? true)]
    (letfn [(on-mouse-down [event]
              (common/on-mouse-down event shape selected))
            (on-double-click [event]
              (when selected?
                (st/emit! (uds/start-edition-mode id))))]
      [:g.shape {:class (when selected? "selected")
                 :on-double-click on-double-click
                 :on-mouse-down on-mouse-down}
       (path-shape shape)])))

;; --- Path Shape

(defn- render-path
  [{:keys [segments close?] :as shape}]
  (let [numsegs (count segments)]
    (loop [buffer []
           index 0]
      (cond
        (>= index numsegs)
        (if close?
          (str/join " " (conj buffer "Z"))
          (str/join " " buffer))

        (zero? index)
        (let [{:keys [x y] :as segment} (nth segments index)
              buffer (conj buffer (str/istr "M~{x},~{y}"))]
          (recur buffer (inc index)))

        :else
        (let [{:keys [x y] :as segment} (nth segments index)
              buffer (conj buffer (str/istr "L~{x},~{y}"))]
          (recur buffer (inc index)))))))

(mx/defc path-shape
  {:mixins [mx/static]}
  [{:keys [id modifiers background?] :as shape}]
  (let [{:keys [resize displacement]} modifiers
        shape (cond-> shape
                displacement (geom/transform displacement)
                resize (geom/transform resize))
        pdata (render-path shape)
        attrs (merge {:id (str id) :d pdata}
                     (attrs/extract-style-attrs shape))]
    (if background?
      [:g {}
       [:path {:stroke "transparent"
               :fill "transparent"
               :stroke-width "20px"
               :d pdata}]
       [:path attrs]]
      [:path attrs])))

Add invisible background to paths.

Add invisible background to paths.

In order to make more easy to the
user select and move them.