(ns com.wsscode.pathom.fulcro.network
  (:require [clojure.core.async :refer [go <! >! put! promise-chan close!]]
            [com.wsscode.common.async-cljs :refer [<? go-catch <!p]]
            [com.wsscode.pathom.core :as p]
            [com.wsscode.pathom.profile :as pp]
            [com.wsscode.pathom.graphql :as pg]
            [com.wsscode.pathom.diplomat.http :as http]
            [com.wsscode.pathom.diplomat.http.fetch :as fetch]
            [fulcro.client.network :as fulcro.network]
            [fulcro.client.primitives :as fp])
  (:import [goog.net XhrIo EventType]))

;; EXPERIMENTAL - all features here are experimental and subject to API changes and breakages

;; Local Network

(defrecord PathomRemote [parser]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_] true)

  fulcro.network/FulcroRemoteI
  (transmit [this {::fulcro.network/keys [edn ok-handler error-handler progress-handler]}]
    (go
      (try
        (ok-handler {:transaction edn :body (<? (parser {} edn))})
        (catch :default e
          (js/console.error "PathomRemote error:" e)
          (error-handler {:body e}))))))

(defn pathom-remote
  "Create a Fulcro remote that will use a Pathom async parser to process the query."
  [parser]
  (map->PathomRemote {:parser parser}))

;; FN Network, create a network from a simple function

(defrecord FnNetwork [f serialize?]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_] serialize?)

  fulcro.network/FulcroNetwork
  (send [this edn ok error] (f this edn ok error))

  (start [_]))

(defn fn-network
  "Creates a simple Fulcro network out a function, the function will reeive the params:
  [network edn ok-callback error-callback]"
  ([f] (fn-network f true))
  ([f serialize?]
   (map->FnNetwork {:f          f
                    :serialize? serialize?})))

;; Transform Network

(defrecord TransformNetwork [network options]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_]
    (try
      (fulcro.network/serialize-requests? network)
      (catch :default _ true)))

  fulcro.network/FulcroNetwork
  (send [_ edn ok error]
    (let [{::keys [transform-query transform-response transform-error transform-transmission app*]
           :or    {transform-query    (fn [_ x] x)
                   transform-response (fn [_ x] x)
                   transform-error    (fn [_ x] x)}} options
          req-id (random-uuid)
          env    {::request-id req-id
                  ::app        @app*}]
      (if-let [edn' (transform-query env edn)]
        (if transform-transmission
          (transform-transmission edn'
            (fn [edn']
              (fulcro.network/send network edn'
                #(->> % (transform-response env) ok)
                #(->> % (transform-error env) error))))
          (fulcro.network/send network edn'
            #(->> % (transform-response env) ok)
            #(->> % (transform-error env) error)))
        (ok nil))))

  (start [this]
    (fulcro.network/start network)
    this))

(defrecord TransformRemoteI [network options]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_]
    (try
      (fulcro.network/serialize-requests? network)
      (catch :default _ true)))

  fulcro.network/FulcroRemoteI
  (transmit [this {::fulcro.network/keys [edn ok-handler error-handler progress-handler]}]
    (let [{::keys [transform-query transform-response transform-error
                   transform-progress transform-transmission app*]
           :or    {transform-query    (fn [_ x] x)
                   transform-response (fn [_ x] x)
                   transform-error    (fn [_ x] x)
                   transform-progress (fn [_ x] x)}} options
          req-id (random-uuid)
          env    {::request-id req-id
                  ::app        @app*}]
      (if-let [edn' (transform-query env edn)]
        (if transform-transmission
          (transform-transmission env edn'
            (fn [edn']
              (fulcro.network/transmit network
                {::fulcro.network/edn              edn'
                 ::fulcro.network/ok-handler       (fn [response] (ok-handler (update response :body #(transform-response env %))))
                 ::fulcro.network/error-handler    (fn [error] (error-handler (update error :body #(transform-error env %))))
                 ::fulcro.network/progress-handler (fn [progress] (progress-handler (transform-progress env progress)))})))
          (fulcro.network/transmit network
            {::fulcro.network/edn              edn'
             ::fulcro.network/ok-handler       (fn [response] (ok-handler (update response :body #(transform-response env %))))
             ::fulcro.network/error-handler    (fn [error] (error-handler (update error :body #(transform-error env %))))
             ::fulcro.network/progress-handler (fn [progress] (progress-handler (transform-progress env progress)))}))
        (ok-handler nil)))))

(defn transform-remote
  "Given a network, provides some hooks to modify the network behavior.

  ::transform-query [env edn] -> edn
  Receives the EDN query so you can modify before it's transmited. If you return nil the send will be cancelled, and the
  network ok handler will be triggered with nil.

  ::transform-response [env response] -> response
  ::transform-error [env error] -> error
  ::transform-progress [env progress] -> progress (for FulcroRemoteI only)

  ::transform-transmission [env transmit]
  Transmit is a function with zero arguments, this can be used to wrap some operation around the data
  transmission entirely, but you can't affect the parameters from here.

  env is a map with the keys `::request-id` and `::app`

  `::request-id` is a uuid generated on the request, it will
  be the same during all transform hooks, you can use this to correlate the hook steps.

  The `::app` is an atom with the app, to have this you must initialize it during the Fulcro :started-callback using
  the following code:

  (fn [app] (pathom.network/transform-remote-init remote app))

  This helper is compatible with both fulcro network work interfaces FulcroNetwork and FulcroRemoteI."
  [remote options]
  (let [options (assoc options ::app* (atom nil))]
    (cond
      (implements? fulcro.network/FulcroRemoteI remote)
      (->TransformRemoteI remote options)

      (implements? fulcro.network/FulcroNetwork remote)
      (->TransformNetwork remote options))))

(defn transform-remote-init
  "Set the transform remote app reference, this is needed if your remote needs access to the app."
  [network app]
  (some-> network :options ::app* (reset! app)))

;; Profile network

(defn trace-remote
  "Wrap a Remote so it always ask for the pathom profile."
  [network]
  (transform-remote network
    {::transform-query (fn [_ query] (conj query :com.wsscode.pathom/trace))}))

(defn profile-remote
  "Wrap a Remote so it always ask for the pathom profile."
  [network]
  (transform-remote network
    {::transform-query (fn [_ query] (conj query :com.wsscode.pathom.profile/profile))}))

;; GraphQL Simple Network

(def graphql-response-key (comp keyword pg/camel-case name))

(def graphql-response-parser
  (p/parser {::p/env    {::p/reader (p/map-reader* {::p/map-key-transform graphql-response-key})}
             ::p/mutate (fn [env k _]
                          {:action
                           (fn []
                             (let [response (-> (p/entity env) (get (graphql-response-key k)))
                                   id-param (pg/find-id (get-in env [:ast :params]) fp/tempid?)]
                               (cond-> response
                                 id-param (assoc ::fp/tempids {(val id-param) (get response (graphql-response-key (key id-param)))}))))})}))

(defn graphql-network
      ([url]
        (graphql-network url {}))
      ([url {update-http-request ::update-http-request}]
        (fn-network
          (fn [this edn ok error]
              (go
                (try
                  (let [edn (-> edn
                                p/query->ast
                                (p/elide-ast-nodes #{::pp/profile})
                                p/ast->query)
                        query (pg/query->graphql edn {::pg/js-name (comp pg/camel-case name)})
                        response (<? (fetch/request-async
                                       (cond-> {::http/url         url
                                                ::http/method      ::http/post
                                                ::http/as          ::http/json
                                                ::http/form-params {:query query}}
                                               update-http-request update-http-request)))
                        {:keys [data errors]} (::http/body response)]
                       (ok (graphql-response-parser {::p/entity data} edn)))
                  (catch :default e
                    (error e))))))))

(def graphql-response-parser2
  (let [simple-keyword (comp keyword name)]
    (p/parser {::p/env    {::p/reader (p/map-reader* {::p/map-key-transform simple-keyword})}
               ::p/mutate (fn [env k _]
                            {:action
                             (fn []
                               (let [response (-> (p/entity env) (get (simple-keyword k)))
                                     id-param (pg/find-id (get-in env [:ast :params]) fp/tempid?)]
                                 (js/console.log "VOLTA" id-param (p/entity env) response)
                                 (cond-> response
                                   id-param (assoc ::fp/tempids {(val id-param) (get response (simple-keyword (key id-param)))}))))})})))

(defn graphql-network2
  ([url] (graphql-network2 url {}))
  ([url config]
   (fn-network
     (fn [this edn ok error]
       (go
         (try
           (let [edn      (-> edn
                              p/query->ast
                              (p/elide-ast-nodes #{::pp/profile})
                              p/ast->query)
                 query    (pg/query->graphql edn (merge {::pg/tempid? fp/tempid?} config))
                 response (<? (fetch/request-async {::http/url         url
                                                    ::http/method      ::http/post
                                                    ::http/as          ::http/json
                                                    ::http/form-params {:query query}}))
                 {:keys [data errors]} (::http/body response)]
             (ok (graphql-response-parser2 {::p/entity data} edn)))
           (catch :default e
             (error e))))))))

;; Batch Networking

(defn debounce
  "Debounce calls, all the call inputs will be stored and the final call will receive a vector with every
  collected input during the debounce."
  [f interval]
  (let [timer (atom 0)
        calls (atom [])]
    (fn [& args]
      (js/clearTimeout @timer)
      (swap! calls conj args)
      (reset! timer (js/setTimeout #(do
                                      (f @calls)
                                      (reset! calls []))
                      interval)))))

(defn group-mergeable-requests
  "Given a list of requests [query ok-callback error-callback], reduces the number of requests to the minimum by merging
  the requests. Not all requests are mergeable, so this still might output multiple requests."
  [requests]
  (if (seq requests)
    (let [[[q ok err] & tail] requests
          groups [{::query q ::ok [ok] ::err [err]}]]
      (loop [left       tail
             groups     groups
             current    0
             next-cycle []]
        (if-let [[query ok err :as req] (first left)]
          (let [cur-group (get groups current)
                merged    (p/merge-queries (::query cur-group) query)]
            (if merged
              (recur (next left)
                (-> groups
                    (assoc-in [current ::query] merged)
                    (update-in [current ::ok] conj ok)
                    (update-in [current ::err] conj err))
                current
                next-cycle)
              (recur (next left)
                groups
                current
                (conj next-cycle req))))
          (if (seq next-cycle)
            (let [[[q ok err] & tail] next-cycle]
              (recur tail
                (conj groups {::query q ::ok [ok] ::err [err]})
                (inc current)
                []))
            groups))))
    []))

(defn batch-send
  "Setup a debounce to batch network requests. The callback function f will be called with a list of requests to be made
  after merging as max as possible."
  [f delay]
  (debounce #(f (group-mergeable-requests %)) delay))

(defrecord BatchNetwork [send-fn]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_] true)

  fulcro.network/FulcroNetwork
  (send [_ edn ok error] (send-fn edn ok error))
  (start [_]))

(defn batch-network
  "Wraps a network send calls with a debounce that will accumulate, merge and batch send requests in a time frame
  interval."
  ([network] (batch-network network 10))
  ([network delay]
   (let [send-fn (batch-send (fn [reqs]
                               (doseq [{::keys [query ok err]} reqs]
                                 (fulcro.network/send network query #(doseq [f ok] (f %)) #(doseq [f err] (f %)))))
                   delay)]
     (map->BatchNetwork {:send-fn send-fn}))))

(defn fulcro-union-path
  "Decide the union branch based on the Fulcro union component ident dispatch. This is
  useful if you are using a parser in the Clojurescript side living in the same process
  as the client app, this makes the union picking automatic on those cases."
  [{:keys [ast] :as env}]
  (let [component (:component ast)
        props     (p/entity env)
        [type _]  (fp/get-ident component props)]
    type))

(ns com.wsscode.pathom.fulcro.network
  (:require [clojure.core.async :refer [go <! >! put! promise-chan close!]]
            [com.wsscode.common.async-cljs :refer [<? go-catch <!p]]
            [com.wsscode.pathom.core :as p]
            [com.wsscode.pathom.profile :as pp]
            [com.wsscode.pathom.graphql :as pg]
            [com.wsscode.pathom.diplomat.http :as http]
            [com.wsscode.pathom.diplomat.http.fetch :as fetch]
            [fulcro.client.network :as fulcro.network]
            [fulcro.client.primitives :as fp])
  (:import [goog.net XhrIo EventType]))

;; EXPERIMENTAL - all features here are experimental and subject to API changes and breakages

;; Local Network

(defrecord PathomRemote [parser]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_] true)

  fulcro.network/FulcroRemoteI
  (transmit [this {::fulcro.network/keys [edn ok-handler error-handler progress-handler]}]
    (go
      (try
        (ok-handler {:transaction edn :body (<? (parser {} edn))})
        (catch :default e
          (js/console.error "PathomRemote error:" e)
          (error-handler {:body e}))))))

(defn pathom-remote
  "Create a Fulcro remote that will use a Pathom async parser to process the query."
  [parser]
  (map->PathomRemote {:parser parser}))

;; FN Network, create a network from a simple function

(defrecord FnNetwork [f serialize?]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_] serialize?)

  fulcro.network/FulcroNetwork
  (send [this edn ok error] (f this edn ok error))

  (start [_]))

(defn fn-network
  "Creates a simple Fulcro network out a function, the function will reeive the params:
  [network edn ok-callback error-callback]"
  ([f] (fn-network f true))
  ([f serialize?]
   (map->FnNetwork {:f          f
                    :serialize? serialize?})))

;; Transform Network

(defrecord TransformNetwork [network options]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_]
    (try
      (fulcro.network/serialize-requests? network)
      (catch :default _ true)))

  fulcro.network/FulcroNetwork
  (send [_ edn ok error]
    (let [{::keys [transform-query transform-response transform-error transform-transmission app*]
           :or    {transform-query    (fn [_ x] x)
                   transform-response (fn [_ x] x)
                   transform-error    (fn [_ x] x)}} options
          req-id (random-uuid)
          env    {::request-id req-id
                  ::app        @app*}]
      (if-let [edn' (transform-query env edn)]
        (if transform-transmission
          (transform-transmission edn'
            (fn [edn']
              (fulcro.network/send network edn'
                #(->> % (transform-response env) ok)
                #(->> % (transform-error env) error))))
          (fulcro.network/send network edn'
            #(->> % (transform-response env) ok)
            #(->> % (transform-error env) error)))
        (ok nil))))

  (start [this]
    (fulcro.network/start network)
    this))

(defrecord TransformRemoteI [network options]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_]
    (try
      (fulcro.network/serialize-requests? network)
      (catch :default _ true)))

  fulcro.network/FulcroRemoteI
  (transmit [this {::fulcro.network/keys [edn ok-handler error-handler progress-handler]}]
    (let [{::keys [transform-query transform-response transform-error
                   transform-progress transform-transmission app*]
           :or    {transform-query    (fn [_ x] x)
                   transform-response (fn [_ x] x)
                   transform-error    (fn [_ x] x)
                   transform-progress (fn [_ x] x)}} options
          req-id (random-uuid)
          env    {::request-id req-id
                  ::app        @app*}]
      (if-let [edn' (transform-query env edn)]
        (if transform-transmission
          (transform-transmission env edn'
            (fn [edn']
              (fulcro.network/transmit network
                {::fulcro.network/edn              edn'
                 ::fulcro.network/ok-handler       (fn [response] (ok-handler (update response :body #(transform-response env %))))
                 ::fulcro.network/error-handler    (fn [error] (error-handler (update error :body #(transform-error env %))))
                 ::fulcro.network/progress-handler (fn [progress] (progress-handler (transform-progress env progress)))})))
          (fulcro.network/transmit network
            {::fulcro.network/edn              edn'
             ::fulcro.network/ok-handler       (fn [response] (ok-handler (update response :body #(transform-response env %))))
             ::fulcro.network/error-handler    (fn [error] (error-handler (update error :body #(transform-error env %))))
             ::fulcro.network/progress-handler (fn [progress] (progress-handler (transform-progress env progress)))}))
        (ok-handler nil))))

  (abort [this abort-id]
    (fulcro.network/abort network abort-id)))

(defn transform-remote
  "Given a network, provides some hooks to modify the network behavior.

  ::transform-query [env edn] -> edn
  Receives the EDN query so you can modify before it's transmited. If you return nil the send will be cancelled, and the
  network ok handler will be triggered with nil.

  ::transform-response [env response] -> response
  ::transform-error [env error] -> error
  ::transform-progress [env progress] -> progress (for FulcroRemoteI only)

  ::transform-transmission [env transmit]
  Transmit is a function with zero arguments, this can be used to wrap some operation around the data
  transmission entirely, but you can't affect the parameters from here.

  env is a map with the keys `::request-id` and `::app`

  `::request-id` is a uuid generated on the request, it will
  be the same during all transform hooks, you can use this to correlate the hook steps.

  The `::app` is an atom with the app, to have this you must initialize it during the Fulcro :started-callback using
  the following code:

  (fn [app] (pathom.network/transform-remote-init remote app))

  This helper is compatible with both fulcro network work interfaces FulcroNetwork and FulcroRemoteI."
  [remote options]
  (let [options (assoc options ::app* (atom nil))]
    (cond
      (implements? fulcro.network/FulcroRemoteI remote)
      (->TransformRemoteI remote options)

      (implements? fulcro.network/FulcroNetwork remote)
      (->TransformNetwork remote options))))

(defn transform-remote-init
  "Set the transform remote app reference, this is needed if your remote needs access to the app."
  [network app]
  (some-> network :options ::app* (reset! app)))

;; Profile network

(defn trace-remote
  "Wrap a Remote so it always ask for the pathom profile."
  [network]
  (transform-remote network
    {::transform-query (fn [_ query] (conj query :com.wsscode.pathom/trace))}))

(defn profile-remote
  "Wrap a Remote so it always ask for the pathom profile."
  [network]
  (transform-remote network
    {::transform-query (fn [_ query] (conj query :com.wsscode.pathom.profile/profile))}))

;; GraphQL Simple Network

(def graphql-response-key (comp keyword pg/camel-case name))

(def graphql-response-parser
  (p/parser {::p/env    {::p/reader (p/map-reader* {::p/map-key-transform graphql-response-key})}
             ::p/mutate (fn [env k _]
                          {:action
                           (fn []
                             (let [response (-> (p/entity env) (get (graphql-response-key k)))
                                   id-param (pg/find-id (get-in env [:ast :params]) fp/tempid?)]
                               (cond-> response
                                 id-param (assoc ::fp/tempids {(val id-param) (get response (graphql-response-key (key id-param)))}))))})}))

(defn graphql-network
      ([url]
        (graphql-network url {}))
      ([url {update-http-request ::update-http-request}]
        (fn-network
          (fn [this edn ok error]
              (go
                (try
                  (let [edn (-> edn
                                p/query->ast
                                (p/elide-ast-nodes #{::pp/profile})
                                p/ast->query)
                        query (pg/query->graphql edn {::pg/js-name (comp pg/camel-case name)})
                        response (<? (fetch/request-async
                                       (cond-> {::http/url         url
                                                ::http/method      ::http/post
                                                ::http/as          ::http/json
                                                ::http/form-params {:query query}}
                                               update-http-request update-http-request)))
                        {:keys [data errors]} (::http/body response)]
                       (ok (graphql-response-parser {::p/entity data} edn)))
                  (catch :default e
                    (error e))))))))

(def graphql-response-parser2
  (let [simple-keyword (comp keyword name)]
    (p/parser {::p/env    {::p/reader (p/map-reader* {::p/map-key-transform simple-keyword})}
               ::p/mutate (fn [env k _]
                            {:action
                             (fn []
                               (let [response (-> (p/entity env) (get (simple-keyword k)))
                                     id-param (pg/find-id (get-in env [:ast :params]) fp/tempid?)]
                                 (js/console.log "VOLTA" id-param (p/entity env) response)
                                 (cond-> response
                                   id-param (assoc ::fp/tempids {(val id-param) (get response (simple-keyword (key id-param)))}))))})})))

(defn graphql-network2
  ([url] (graphql-network2 url {}))
  ([url config]
   (fn-network
     (fn [this edn ok error]
       (go
         (try
           (let [edn      (-> edn
                              p/query->ast
                              (p/elide-ast-nodes #{::pp/profile})
                              p/ast->query)
                 query    (pg/query->graphql edn (merge {::pg/tempid? fp/tempid?} config))
                 response (<? (fetch/request-async {::http/url         url
                                                    ::http/method      ::http/post
                                                    ::http/as          ::http/json
                                                    ::http/form-params {:query query}}))
                 {:keys [data errors]} (::http/body response)]
             (ok (graphql-response-parser2 {::p/entity data} edn)))
           (catch :default e
             (error e))))))))

;; Batch Networking

(defn debounce
  "Debounce calls, all the call inputs will be stored and the final call will receive a vector with every
  collected input during the debounce."
  [f interval]
  (let [timer (atom 0)
        calls (atom [])]
    (fn [& args]
      (js/clearTimeout @timer)
      (swap! calls conj args)
      (reset! timer (js/setTimeout #(do
                                      (f @calls)
                                      (reset! calls []))
                      interval)))))

(defn group-mergeable-requests
  "Given a list of requests [query ok-callback error-callback], reduces the number of requests to the minimum by merging
  the requests. Not all requests are mergeable, so this still might output multiple requests."
  [requests]
  (if (seq requests)
    (let [[[q ok err] & tail] requests
          groups [{::query q ::ok [ok] ::err [err]}]]
      (loop [left       tail
             groups     groups
             current    0
             next-cycle []]
        (if-let [[query ok err :as req] (first left)]
          (let [cur-group (get groups current)
                merged    (p/merge-queries (::query cur-group) query)]
            (if merged
              (recur (next left)
                (-> groups
                    (assoc-in [current ::query] merged)
                    (update-in [current ::ok] conj ok)
                    (update-in [current ::err] conj err))
                current
                next-cycle)
              (recur (next left)
                groups
                current
                (conj next-cycle req))))
          (if (seq next-cycle)
            (let [[[q ok err] & tail] next-cycle]
              (recur tail
                (conj groups {::query q ::ok [ok] ::err [err]})
                (inc current)
                []))
            groups))))
    []))

(defn batch-send
  "Setup a debounce to batch network requests. The callback function f will be called with a list of requests to be made
  after merging as max as possible."
  [f delay]
  (debounce #(f (group-mergeable-requests %)) delay))

(defrecord BatchNetwork [send-fn]
  fulcro.network/NetworkBehavior
  (serialize-requests? [_] true)

  fulcro.network/FulcroNetwork
  (send [_ edn ok error] (send-fn edn ok error))
  (start [_]))

(defn batch-network
  "Wraps a network send calls with a debounce that will accumulate, merge and batch send requests in a time frame
  interval."
  ([network] (batch-network network 10))
  ([network delay]
   (let [send-fn (batch-send (fn [reqs]
                               (doseq [{::keys [query ok err]} reqs]
                                 (fulcro.network/send network query #(doseq [f ok] (f %)) #(doseq [f err] (f %)))))
                   delay)]
     (map->BatchNetwork {:send-fn send-fn}))))

(defn fulcro-union-path
  "Decide the union branch based on the Fulcro union component ident dispatch. This is
  useful if you are using a parser in the Clojurescript side living in the same process
  as the client app, this makes the union picking automatic on those cases."
  [{:keys [ast] :as env}]
  (let [component (:component ast)
        props     (p/entity env)
        [type _]  (fp/get-ident component props)]
    type))

Add abort impl for fulcro network transform


(ns chat.client.views.pills
  (:require [om.core :as om]
            [om.dom :as dom]
            [chat.client.store :as store]))

(defn id->color [id]
  ; normalized is approximately evenly distributed between 0 and 1
  (let [normalized (-> id
                       str
                       (.substring 33 36)
                       (js/parseInt 16)
                       (/ 4096))]
    (str "hsl(" (* 360 normalized) ",70%,35%)")))

(defn tag-view [tag owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (str "tag pill"
                                    (if (store/is-subscribed-to-tag? (tag :id))
                                      " on"
                                      " off"))
                    :style #js {:backgroundColor (id->color (tag :id))
                                :color (id->color (tag :id))
                                :borderColor (id->color (tag :id))}
                    :onClick (fn [e]
                               (store/set-page! {:type :channel
                                                 :id (tag :id)}))}
        (dom/span #js {:className "name"} "#" (tag :name))))))

(defn user-view [user owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (str "user pill" (case (user :state)
                                                   :online " on"
                                                   " off"))
                    :style #js {:backgroundColor (id->color (user :id))
                                :color (id->color (user :id))
                                :borderColor (id->color (user :id))}
                    :onClick (fn [e]
                               (store/set-page! {:type :user
                                                 :id (user :id)}))}
        (dom/span #js {:className "name"} (str "@" (user :nickname)))
        #_(dom/div #js {:className (str "status " ((fnil name "") (user :status)))})))))

(ns chat.client.views.pills
  (:require [om.core :as om]
            [om.dom :as dom]
            [chat.client.store :as store]))

(defn id->color [id]
  ; normalized is approximately evenly distributed between 0 and 1
  (let [normalized (-> id
                       str
                       (.substring 33 36)
                       (js/parseInt 16)
                       (/ 4096))]
    (str "hsl(" (* 360 normalized) ",70%,35%)")))

(defn tag-view [tag owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (str "tag pill"
                                    (if (store/is-subscribed-to-tag? (tag :id))
                                      " on"
                                      " off"))
                    :style #js {:backgroundColor (id->color (tag :id))
                                :color (id->color (tag :id))
                                :borderColor (id->color (tag :id))}
                    :onClick (fn [e]
                               (store/set-page! {:type :channel
                                                 :id (tag :id)}))}
        (dom/span #js {:className "name"} "#" (tag :name))))))

(defn user-view [user owner]
  (reify
    om/IRender
    (render [_]
      (dom/div #js {:className (str "user pill" (case (user :status)
                                                   :online " on"
                                                   " off"))
                    :style #js {:backgroundColor (id->color (user :id))
                                :color (id->color (user :id))
                                :borderColor (id->color (user :id))}
                    :onClick (fn [e]
                               (store/set-page! {:type :user
                                                 :id (user :id)}))}
        (dom/span #js {:className "name"} (str "@" (user :nickname)))
        #_(dom/div #js {:className (str "status " ((fnil name "") (user :status)))})))))

fix user status display

fix user status display


; Copyright (C) 2013, 2014, 2015 Dr. Thomas Schank  (DrTom@schank.ch, Thomas.Schank@algocon.ch)
; Licensed under the terms of the GNU Affero General Public License v3.
; See the "LICENSE.txt" file provided with this software.

(ns cider-ci.ex.scripts.exec
  (:import
    [org.apache.commons.exec ExecuteWatchdog]
    [java.io File]
    )

  (:require
    [cider-ci.utils.config :as config :refer [get-config]]
    [clojure.string :as string]
    [clj-commons-exec :as commons-exec]
    [clj-logging-config.log4j :as logging-config]
    [drtom.logbug.debug :as debug]
    [clojure.tools.logging :as logging]
    [clj-time.core :as time]
    [drtom.logbug.thrown :as thrown]

    ))

; TODO us clj-fs or our fs ..
(defn- working-dir [params]
  (.getAbsolutePath (File. (:working_dir params))))

; TODO:
; * remove (or ... ) not needed with conj
(defn- prepare-env-variables [params]
  (->> (conj { }
             {:CIDER_CI_WORKING_DIR (working-dir params)}
             (or (:ports params) {})
             (or (:environment_variables params) {}))
       (filter (fn [[k v]] (not= nil v)))
       (map (fn [[k v]] [(name k) (str v)]))
       (map (fn [[k v]] [(string/upper-case k) v])) ; TODO,  remove this with Cider-CI version 3.0.0
       (into {})))

; TODO use doto ...
(defn- prepare-script-file [script]
  (let [script-file (File/createTempFile "cider-ci_", ".script")]
    (.deleteOnExit script-file)
    (spit script-file script)
    (.setExecutable script-file true false)
    script-file))

(defn- get-current-user-name []
  (System/getProperty "user.name"))

(defn- get-exec-user []
  (or (-> (get-config) :sudo :user)
      (get-current-user-name)))

(defn- sudo-env [vars]
  (->> vars
       (map (fn [[k v]]
              (str k "=" v )))))

(defn- interpreter [env_vars]
  (flatten ["sudo" "-u" (get-exec-user) env_vars  "-n" "-i"]))

(defn- create-command-wrapper-file [working-dir script-file]
  (let [command-wrapper-file (File/createTempFile "cider-ci_", ".command_wrapper")
        script (str "cd '" working-dir "' && " (.getAbsolutePath script-file)) ]
    (.deleteOnExit command-wrapper-file)
    (spit command-wrapper-file script)
    (.setExecutable command-wrapper-file true false)
    (.getAbsolutePath command-wrapper-file)))

(defn- command [script-file working-dir env-variables]
  (flatten (concat (interpreter (sudo-env env-variables))
                   [(create-command-wrapper-file working-dir script-file)])))

(defn- commons-exec-sh [command env-variables watchdog]
  (commons-exec/sh
    command
    {:env (conj {} (System/getenv) env-variables)
     :watchdog watchdog}))

(defn exec-future [params timeout-or-watchdog]
  (let [env-variables (prepare-env-variables params)
        script-file (prepare-script-file (:body params))
        command (command script-file (working-dir params) env-variables)]
    (logging/debug {:command command})
    (commons-exec-sh command env-variables timeout-or-watchdog)))

(defn- get-final-parameters [exec-res]
  {:finished_at (time/now)
   :exit_status (:exit exec-res)
   :state (condp = (:exit exec-res)
            0 "passed"
            "failed")
   :stdout (:out exec-res)
   :stderr (:err exec-res)
   :error (:error exec-res)
   })

(defn- set-script-atom-for-execption [script-atom e]
  (let [e-str (thrown/stringify e)]
    (logging/warn e-str)
    (swap! script-atom
           (fn [params e-str]
             (conj params
                   {:state "failed"
                    :error e-str }))
           e-str )))

(def ^:private debug-recent-execs (atom '()))
(defn- debug-recent-execs-push [exec]
  (swap! debug-recent-execs (fn [re e] (conj (take 5 re ) e)) exec))

(defn execute [script-atom]
  (debug-recent-execs-push script-atom)
  (try (let [params @script-atom
             timeout (or (:timeout params) 200)
             watchdog (ExecuteWatchdog. (* 1000 timeout))]
         (swap! script-atom
                (fn [params watchdog]
                  (assoc params
                         :started_at (time/now)
                         :state "executing"
                         :watchdog watchdog))
                watchdog)
         (let [exec-res @(exec-future params watchdog)]
           (swap! script-atom
                  (fn [params res]
                    (conj params res))
                  (get-final-parameters exec-res))))
       (catch Exception e
         (set-script-atom-for-execption script-atom e))))

;### Debug ####################################################################
;(logging-config/set-logger! :level :debug)
;(logging-config/set-logger! :level :info)
;(debug/debug-ns *ns*)

; Copyright (C) 2013, 2014, 2015 Dr. Thomas Schank  (DrTom@schank.ch, Thomas.Schank@algocon.ch)
; Licensed under the terms of the GNU Affero General Public License v3.
; See the "LICENSE.txt" file provided with this software.
(ns cider-ci.ex.scripts.exec
  (:import
    [org.apache.commons.exec ExecuteWatchdog]
    [java.io File]
    )
  (:require
    [cider-ci.utils.config :as config :refer [get-config]]
    [clj-commons-exec :as commons-exec]
    [clj-logging-config.log4j :as logging-config]
    [clj-time.core :as time]
    [clojure.set :refer [difference union]]
    [clojure.string :as string :refer [split trim]]
    [clojure.tools.logging :as logging]
    [drtom.logbug.debug :as debug]
    [drtom.logbug.thrown :as thrown]
    ))

; TODO us clj-fs or our fs ..
(defn- working-dir [params]
  (.getAbsolutePath (File. (:working_dir params))))

; TODO:
; * remove (or ... ) not needed with conj
(defn- prepare-env-variables [params]
  (->> (conj { }
             {:CIDER_CI_WORKING_DIR (working-dir params)}
             (or (:ports params) {})
             (or (:environment_variables params) {}))
       (filter (fn [[k v]] (not= nil v)))
       (map (fn [[k v]] [(name k) (str v)]))
       (map (fn [[k v]] [(string/upper-case k) v])) ; TODO,  remove this with Cider-CI version 3.0.0
       (into {})))

; TODO use doto ...
(defn- prepare-script-file [script]
  (let [script-file (File/createTempFile "cider-ci_", ".script")]
    (.deleteOnExit script-file)
    (spit script-file script)
    (.setExecutable script-file true false)
    script-file))

(defn- get-current-user-name []
  (System/getProperty "user.name"))

(defn- get-exec-user []
  (or (-> (get-config) :sudo :user)
      (get-current-user-name)))

(defn- sudo-env [vars]
  (->> vars
       (map (fn [[k v]]
              (str k "=" v )))))

(defn- interpreter [env_vars]
  (flatten ["sudo" "-u" (get-exec-user) env_vars  "-n" "-i"]))

;### termination ##############################################################
; It seems not possible to guarantee that all subprocesses are killed.  The
; default strategy is to rely on "Apache Commons Exec"  which sometimes works
; but is unreliable in many cases, e.g. when the script starts in a new
; sub-shell.  On Linux we recursively find all subprocesses via `ps`, see also
; `ps axf -o user,pid,ppid,pgrp,args`, and then kill those. This works well
; unless double forks are used which are nearly impossible to track with
; reasonable effort.

(defn create-watchdog [timeout]
  (case (System/getProperty "os.name")
    "Linux" nil
    (ExecuteWatchdog. (* 1000 timeout))))

(defn get-child-pids [pids]
  "This is known to work under linux. Due to the variations in ps it may not
  work under other Unixes, certainly not under Mac OS X."
  (try (-> (commons-exec/sh
             ["ps" "--no-headers" "-o" "pid" "--ppid" (clojure.string/join "," pids)])
           deref
           :out
           trim
           (split #"\n")
           (#(map trim %))
           set)
       (catch Exception _
         (set []))))

(defn add-descendant-pids [pids]
  (logging/debug 'add-descendant-pids pids)
  (let [child-pids (get-child-pids pids)
        result-pids (union pids child-pids)]
    (logging/info {:pids pids :result-pids result-pids})
    (if (= pids result-pids)
      result-pids
      (add-descendant-pids result-pids))))

(defn terminate-via-process-tree [exec-future script-atom]
  (let [working-dir  (-> script-atom deref :working_dir)
        pid (-> (str working-dir "/._cider-ci.pid") slurp clojure.string/trim)
        pids (add-descendant-pids #{pid})
        descendant-pids (difference pids #{pid})]
    (commons-exec/sh
      (concat ["kill" "-KILL"]
              (into [] descendant-pids)))))

(defn terminate [exec-future script-atom]
  (case (System/getProperty "os.name")
    "Linux" (terminate-via-process-tree exec-future script-atom)
    nil))

(defn preper-terminate-script-prefix [working-dir]
  (case (System/getProperty "os.name")
    "Linux" (str "echo $$ > '" working-dir "/._cider-ci.pid' && ")
    "Mac OS X" (str "echo $$ > '" working-dir "/._cider-ci.pid' && ")
    ""))

;##############################################################################

(defn- create-command-wrapper-file [working-dir script-file]
  (let [wrapper-file (doto (File/createTempFile "cider-ci_", ".command_wrapper")
                       .deleteOnExit
                       (.setExecutable true false)
                       (spit  (str (preper-terminate-script-prefix working-dir)
                                   "cd '" working-dir "' "
                                   "&& " (.getAbsolutePath script-file))))]
    (logging/info {:WRAPPER-FILE (.getAbsolutePath wrapper-file)})
    (.getAbsolutePath wrapper-file)))

(defn- command [script-file working-dir env-variables]
  (flatten (concat (interpreter (sudo-env env-variables))
                   [(create-command-wrapper-file working-dir script-file)])))

(defn- commons-exec-sh [command env-variables watchdog]
  (commons-exec/sh
    command
    (conj {:env (conj {} (System/getenv) env-variables)}
          (when watchdog
            {:watchdog watchdog }))))

(defn exec-sh [params timeout-or-watchdog]
  (let [env-variables (prepare-env-variables params)
        script-file (prepare-script-file (:body params))
        command (command script-file (working-dir params) env-variables)]
    (logging/debug {:command command})
    (commons-exec-sh command env-variables timeout-or-watchdog)))

(defn- get-final-parameters [exec-res]
  {:finished_at (time/now)
   :exit_status (:exit exec-res)
   :state (condp = (:exit exec-res)
            0 "passed"
            "failed")
   :stdout (:out exec-res)
   :stderr (:err exec-res)
   :error (:error exec-res)
   })

(defn- set-script-atom-for-execption [script-atom e]
  (let [e-str (thrown/stringify e)]
    (logging/warn e-str)
    (swap! script-atom
           (fn [params e-str]
             (conj params
                   {:state "failed"
                    :error e-str }))
           e-str )))

(def ^:private debug-recent-execs (atom '()))
(defn- debug-recent-execs-push [exec]
  (swap! debug-recent-execs (fn [re e] (conj (take 5 re ) e)) exec))

(defn execute [script-atom]
  (debug-recent-execs-push script-atom)
  (try (let [params @script-atom
             timeout (or (:timeout params) 200)
             started-at (time/now)
             watchdog (create-watchdog timeout)]
         (logging/debug "TIMEOUT" timeout)
         (swap! script-atom
                (fn [params watchdog started-at]
                  (conj params
                        {:started_at started-at
                         :state "executing"}
                        (when watchdog
                          {:watchdog watchdog})))
                watchdog started-at)
         (let [exec-future (exec-sh params watchdog)]
           (loop []
             (when (time/after? (time/now)
                                (time/plus started-at (time/seconds timeout)))
               (terminate exec-future script-atom))
             (when-not (realized? exec-future)
               (Thread/sleep 500)
               (recur)))
           (swap! script-atom
                  (fn [params res]
                    (conj params res))
                  (get-final-parameters @exec-future))))
       (catch Exception e
         (set-script-atom-for-execption script-atom e))))

;### Debug ####################################################################
;(logging-config/set-logger! :level :debug)
;(logging-config/set-logger! :level :info)
;(debug/debug-ns *ns*)

Improve (sub-)process killing wrt. timeouts (only under Linux for now)


(ns clj-templates.search
  (:require [integrant.core :as ig]
            [qbits.spandex :as es]
            [qbits.spandex.utils :as es-utils]
            [clojure.spec :as s]
            [clj-templates.specs.common :as c]))

(def base-url [:clj_templates])
(def index-url (conj base-url :template))
(def search-url (conj index-url :_search))

(defn templates-from-es-response [es-response]
  (map :_source (get-in es-response [:body :hits :hits])))

(defn index-template
  ([es-client {:keys [template-name build-system] :as template} {:keys [refresh?]}]
   (es/request es-client {:url    (es-utils/url (conj index-url (str template-name "-" build-system) (when refresh? "?refresh=true")))
                          :method :post
                          :body   template}))
  ([es-client template]
   (index-template es-client template {})))

(defn match-all-templates [es-client]
  (templates-from-es-response
    (es/request es-client {:url    (es-utils/url search-url)
                           :method :get
                           :body   {:query {:function_score {:query              {:match_all {}}
                                                             :field_value_factor {:field "downloads"}}}
                                    :from  0
                                    :size  50}})))

(defn search-templates [es-client search-string]
  (templates-from-es-response
    (es/request es-client {:url    (es-utils/url search-url)
                           :method :get
                           :body   {:query {:function_score
                                            {:query              {:multi_match {:query  search-string
                                                                                :type   :best_fields
                                                                                :fields ["template-name.raw^3"
                                                                                "template-name^3"
                                                                                "description^2"
                                                                                "github-readme"]}}
                                             :field_value_factor {:field    "downloads"
                                                                  :modifier "log1p"}}}
                                    :from  0
                                    :size  50}})))

(defn delete-index [es-client]
  (es/request es-client {:url    (es-utils/url base-url)
                         :method :delete
                         :body   {}}))

(defn create-index [es-client]
  (es/request es-client {:url    (es-utils/url base-url)
                         :method :put
                         :body   {:settings {:analysis
                                             {:filter   {:autocomplete_filter
                                                         {:type     "edge_ngram"
                                                          :min_gram 1
                                                          :max_gram 20}}
                                              :analyzer {:autocomplete
                                                         {:type      "custom"
                                                          :tokenizer "standard"
                                                          :filter    ["lowercase" "autocomplete_filter"]}}}}
                                  :mappings {:template
                                             {:properties
                                              {:template-name {:type            "text"
                                                               :analyzer        "autocomplete"
                                                               :search_analyzer "standard"
                                                               :fields          {:raw {:type "keyword"}}}
                                               :description   {:type            "text"
                                                               :analyzer        "autocomplete"
                                                               :search_analyzer "standard"}
                                               :build-system  {:type "keyword"}
                                               :github-url    {:type "keyword"}
                                               :github-id     {:type "keyword"}
                                               :github-stars  {:type "integer"}
                                               :github-readme {:type            "text"
                                                               :analyzer        "autocomplete"
                                                               :search_analyzer "standard"}
                                               :homepage      {:type "keyword"}
                                               :downloads     {:type "integer"}}}}}}))

(defmethod ig/init-key :search/elastic [_ {:keys [hosts default-headers]}]
  (let [es-client (es/client {:default-headers default-headers
                              :hosts           hosts})]
    (try
      (create-index es-client)
      (catch Exception e))
    es-client))

(defmethod ig/halt-key! :search/elastic [_ es-client]
  (es/close! es-client))

(s/fdef index-template
        :args (s/cat :es-client ::c/es-client :template ::c/template)
        :ret ::c/spandex-response)

(s/fdef match-all-templates
        :args (s/cat :es-client ::c/es-client)
        :ret ::c/spandex-response)

(s/fdef search-templates
        :args (s/cat :es-client ::c/es-client :search-string string?)
        :ret ::c/spandex-response)

(ns clj-templates.search
  (:require [integrant.core :as ig]
            [qbits.spandex :as es]
            [qbits.spandex.utils :as es-utils]
            [clojure.spec :as s]
            [clj-templates.specs.common :as c]))

(def base-url [:clj_templates])
(def index-url (conj base-url :template))
(def search-url (conj index-url :_search))

(defn templates-from-es-response [es-response]
  (map :_source (get-in es-response [:body :hits :hits])))

(defn index-template
  ([es-client {:keys [template-name build-system] :as template} {:keys [refresh?]}]
   (es/request es-client {:url    (es-utils/url (conj index-url (str template-name "-" build-system) (when refresh? "?refresh=true")))
                          :method :post
                          :body   template}))
  ([es-client template]
   (index-template es-client template {})))

(defn match-all-templates [es-client]
  (templates-from-es-response
    (es/request es-client {:url    (es-utils/url search-url)
                           :method :get
                           :body   {:query {:function_score {:query              {:match_all {}}
                                                             :field_value_factor {:field "downloads"}}}
                                    :from  0
                                    :size  50}})))

(defn search-templates [es-client search-string]
  (templates-from-es-response
    (es/request es-client {:url    (es-utils/url search-url)
                           :method :get
                           :body   {:query {:function_score
                                            {:query              {:multi_match {:query  search-string
                                                                                :type   :best_fields
                                                                                :fields ["template-name.raw^3"
                                                                                "template-name^3"
                                                                                "description^2"
                                                                                "github-readme"]}}
                                             :field_value_factor {:field    "downloads"
                                                                  :modifier "log1p"}}}
                                    :from  0
                                    :size  50}})))

(defn delete-index [es-client]
  (es/request es-client {:url    (es-utils/url base-url)
                         :method :delete
                         :body   {}}))

(defn create-index [es-client]
  (es/request es-client {:url    (es-utils/url base-url)
                         :method :put
                         :body   {:settings {:analysis
                                             {:filter   {:autocomplete_filter
                                                         {:type     "ngram"
                                                          :min_gram 1
                                                          :max_gram 20}}
                                              :analyzer {:autocomplete
                                                         {:type      "custom"
                                                          :tokenizer "standard"
                                                          :filter    ["lowercase" "autocomplete_filter"]}}}}
                                  :mappings {:template
                                             {:properties
                                              {:template-name {:type            "text"
                                                               :analyzer        "autocomplete"
                                                               :search_analyzer "standard"
                                                               :fields          {:raw {:type "keyword"}}}
                                               :description   {:type            "text"
                                                               :analyzer        "autocomplete"
                                                               :search_analyzer "standard"}
                                               :build-system  {:type "keyword"}
                                               :github-url    {:type "keyword"}
                                               :github-id     {:type "keyword"}
                                               :github-stars  {:type "integer"}
                                               :github-readme {:type            "text"
                                                               :analyzer        "autocomplete"
                                                               :search_analyzer "standard"}
                                               :homepage      {:type "keyword"}
                                               :downloads     {:type "integer"}}}}}}))

(defmethod ig/init-key :search/elastic [_ {:keys [hosts default-headers]}]
  (let [es-client (es/client {:default-headers default-headers
                              :hosts           hosts})]
    (try
      (create-index es-client)
      (catch Exception e))
    es-client))

(defmethod ig/halt-key! :search/elastic [_ es-client]
  (es/close! es-client))

(s/fdef index-template
        :args (s/cat :es-client ::c/es-client :template ::c/template)
        :ret ::c/spandex-response)

(s/fdef match-all-templates
        :args (s/cat :es-client ::c/es-client)
        :ret ::c/spandex-response)

(s/fdef search-templates
        :args (s/cat :es-client ::c/es-client :search-string string?)
        :ret ::c/spandex-response)

Use ngram instead of edge_ngram.

Use ngram instead of edge_ngram.


(ns hyphen-keeper.core
  (:require [accountant.core :as accountant]
            [ajax.core :as ajax]
            [clojure.string :as string]
            [reagent.core :as reagent]
            [reagent.session :as session]
            [secretary.core :as secretary :include-macros true]))

(defonce app-state
  (reagent/atom
   {:hyphenations {}
    :spelling 1
    :word ""
    :hyphenation ""
    :suggested-hyphenation ""}))

(def spelling (reagent/cursor app-state [:spelling]))
(def word (reagent/cursor app-state [:word]))
(def hyphenation (reagent/cursor app-state [:hyphenation]))
(def suggested-hyphenation (reagent/cursor app-state [:suggested-hyphenation]))

(defn update-hyphenations! [f & args]
  (apply swap! app-state update-in [:hyphenations] f args))

(defn remove-hyphenation! [{:keys [word]}]
  (update-hyphenations! dissoc word))

(defn load-hyphenation-patterns!
  [spelling word]
  (ajax/GET "/api/words"
            :params {:spelling spelling :search word}
            :handler (fn [hyphenations] (swap! app-state assoc :hyphenations
                                               (into (sorted-map)
                                                     (map (fn [{:keys [word] :as pattern}] [word pattern])
                                                          hyphenations))))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to refresh hyphenation patterns from server: " details)))
            :response-format :json
            :keywords? true))

(defn reset-all! []
  (reset! feedback {:message "Word successfully added" :kind :success})
  (reset! word "")
  (reset! hyphenation "")
  (reset! suggested-hyphenation "")
  (load-hyphenation-patterns! @spelling @word))

(defn add-hyphenation-pattern!
  [pattern]
  (ajax/POST "/api/words"
             :params pattern
             :handler (fn [] (reset-all!))
             :error-handler (fn [details]
                              (.warn js/console
                                     (str "Failed to add hyphenation pattern: " details)))
             :format :json))

(defn remove-hyphenation-pattern!
  [pattern]
  (ajax/DELETE (str "/api/words/" (:word pattern))
               :params pattern
               :handler (fn [] (remove-hyphenation! pattern))
               :error-handler (fn [details]
                                (.warn js/console
                                       (str "Failed to remove hyphenation pattern: " details)))
               :format :json))

(defn lookup-hyphenation-pattern!
  [spelling word]
  (ajax/GET "/api/hyphenate"
            :params {:word word :spelling spelling}
            :handler (fn [hyphenated] (do
                                        (swap! app-state assoc :suggested-hyphenation hyphenated)
                                        (swap! app-state assoc :hyphenation hyphenated)))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to lookup hyphenation patterns for word: " details)))))

(defn hyphenation-pattern [{:keys [word hyphenation] :as pattern}]
  [:tr
   [:td word]
   [:td hyphenation]
   [:td
    [:div.btn-group
     [:button.btn.btn-default
      [:span.glyphicon.glyphicon-edit {:aria-hidden true}] " Edit"]
     [:button.btn.btn-default
      {:on-click #(remove-hyphenation-pattern! pattern)}
      [:span.glyphicon.glyphicon-trash {:aria-hidden true}] " Delete"]]]])

(defn word-field []
  [:div.form-group
   [:label {:for "wordInput"} "Word"]
   [:input.form-control
    {:id "wordInput"
     :type "text"
     :placeholder "Word"
     :value @word
     :on-change (fn [e]
                  (reset! word (-> e .-target .-value string/lower-case))
                  (load-hyphenation-patterns! @spelling @word))
     :on-blur #(lookup-hyphenation-pattern! @spelling @word)}]])

(defn- hyphenation-valid? [s]
  (and (not (string/blank? s))
       (string/includes? s "-")
       (re-matches #"[a-z\xDF-\xFF-]+" s)))

(defn hyphenation-field []
  (let [label "Corrected Hyphenation"
        valid? (or (string/blank? @hyphenation) (hyphenation-valid? @hyphenation))
        klass (if valid? "form-group" "form-group has-error")]
    [:div
     {:class klass}
     [:label {:for "hyphenationInput"} label]
     [:input.form-control
      {:type "text"
       :placeholder label
       :value @hyphenation
       :on-change #(reset! hyphenation (-> % .-target .-value string/lower-case))}]]))

(defn- hyphenation-add-button []
  [:div.form-group
   [:button.btn.btn-default
    {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
                  (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling}))
     :disabled (when (or (string/blank? @word)
                         (not (hyphenation-valid? @hyphenation))
                         (= @hyphenation @suggested-hyphenation))
                 "disabled")}
    "Add"]])

(defn spelling-filter []
  [:div.form-group
   [:select {:value @spelling
             :on-change (fn [e]
                          (reset! spelling (-> e .-target .-value))
                          (load-hyphenation-patterns! @spelling @word)
                          (lookup-hyphenation-pattern! @spelling @word))}
    [:option {:value 0} "Old Spelling"]
    [:option {:value 1} "New Spelling"]]])

(defn suggested-hyphenation-field []
  (let [id "suggestedHyphenation"
        label "Suggested Hyphenation"]
    [:div.form-group
     [:label {:for id} label]
     [:input.form-control
      {:id id
       :type "text"
       :placeholder label
       :disabled "disabled"
       :value @suggested-hyphenation}]]))

(defn new-hyphenation []
  [:div.form
   [spelling-filter]
   [word-field]
   [suggested-hyphenation-field]
   [hyphenation-field]
   [hyphenation-add-button]])

(defn hyphenation-list []
  [:div.container
   [:h1 "Hyphenation"]
   [:div.row
    [:div.col-md-6
     [new-hyphenation]]]
   [:h1 "Similar words"]
   [:div.row
    [:table#hyphenations.table.table-striped
     [:thead [:tr [:th "Word"] [:th "Hyphenation"]]]
     [:tbody
      (for [[word pattern] (:hyphenations @app-state)]
        ^{:key word} [hyphenation-pattern pattern])]]]])

;; -------------------------
;; Views

(defn home-page []
  [hyphenation-list])

(defn about-page []
  [:div [:h2 "About hyphen-keeper"]
   [:div [:a {:href "/"} "go to the home page"]]])

(defn current-page []
  [:div [(session/get :current-page)]])

;; -------------------------
;; Routes

(secretary/defroute "/" []
  (session/put! :current-page #'home-page))

(secretary/defroute "/about" []
  (session/put! :current-page #'about-page))

;; -------------------------
;; Initialize app

(defn mount-root []
  (reagent/render [current-page] (.getElementById js/document "app")))

(defn init! []
  (load-hyphenation-patterns! @spelling @word)
  (accountant/configure-navigation!
    {:nav-handler
     (fn [path]
       (secretary/dispatch! path))
     :path-exists?
     (fn [path]
       (secretary/locate-route path))})
  (accountant/dispatch-current!)
  (mount-root))

(ns hyphen-keeper.core
  (:require [accountant.core :as accountant]
            [ajax.core :as ajax]
            [clojure.string :as string]
            [reagent.core :as reagent]
            [reagent.session :as session]
            [secretary.core :as secretary :include-macros true]))

(defonce app-state
  (reagent/atom
   {:hyphenations {}
    :spelling 1
    :word ""
    :hyphenation ""
    :suggested-hyphenation ""
    :feedback {:message "" :kind :none}}))

(def spelling (reagent/cursor app-state [:spelling]))
(def word (reagent/cursor app-state [:word]))
(def hyphenation (reagent/cursor app-state [:hyphenation]))
(def suggested-hyphenation (reagent/cursor app-state [:suggested-hyphenation]))
(def feedback (reagent/cursor app-state [:feedback]))

(defn update-hyphenations! [f & args]
  (apply swap! app-state update-in [:hyphenations] f args))

(defn remove-hyphenation! [{:keys [word]}]
  (update-hyphenations! dissoc word))

(defn load-hyphenation-patterns!
  [spelling word]
  (ajax/GET "/api/words"
            :params {:spelling spelling :search word}
            :handler (fn [hyphenations] (swap! app-state assoc :hyphenations
                                               (into (sorted-map)
                                                     (map (fn [{:keys [word] :as pattern}] [word pattern])
                                                          hyphenations))))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to refresh hyphenation patterns from server: " details)))
            :response-format :json
            :keywords? true))

(defn set-feedback! [message kind]
  (reset! feedback {:message message :kind kind})
  (.setTimeout js/window #(reset! feedback {:message "" :kind :none}) 2000)
  )

(defn reset-all! []
  (set-feedback! "Word successfully added" :success)
  (reset! word "")
  (reset! hyphenation "")
  (reset! suggested-hyphenation "")
  (load-hyphenation-patterns! @spelling @word))

(defn add-hyphenation-pattern!
  [pattern]
  (ajax/POST "/api/words"
             :params pattern
             :handler (fn [] (reset-all!))
             :error-handler (fn [details]
                              (.warn js/console
                                     (str "Failed to add hyphenation pattern: " details)))
             :format :json))

(defn remove-hyphenation-pattern!
  [pattern]
  (ajax/DELETE (str "/api/words/" (:word pattern))
               :params pattern
               :handler (fn [] (remove-hyphenation! pattern))
               :error-handler (fn [details]
                                (.warn js/console
                                       (str "Failed to remove hyphenation pattern: " details)))
               :format :json))

(defn lookup-hyphenation-pattern!
  [spelling word]
  (ajax/GET "/api/hyphenate"
            :params {:word word :spelling spelling}
            :handler (fn [hyphenated] (do
                                        (swap! app-state assoc :suggested-hyphenation hyphenated)
                                        (swap! app-state assoc :hyphenation hyphenated)))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to lookup hyphenation patterns for word: " details)))))

(defn hyphenation-pattern [{:keys [word hyphenation] :as pattern}]
  [:tr
   [:td word]
   [:td hyphenation]
   [:td
    [:div.btn-group
     [:button.btn.btn-default
      [:span.glyphicon.glyphicon-edit {:aria-hidden true}] " Edit"]
     [:button.btn.btn-default
      {:on-click #(remove-hyphenation-pattern! pattern)}
      [:span.glyphicon.glyphicon-trash {:aria-hidden true}] " Delete"]]]])

(defn word-field []
  [:div.form-group
   [:label {:for "wordInput"} "Word"]
   [:input.form-control
    {:id "wordInput"
     :type "text"
     :placeholder "Word"
     :value @word
     :on-change (fn [e]
                  (reset! word (-> e .-target .-value string/lower-case))
                  (load-hyphenation-patterns! @spelling @word))
     :on-blur #(lookup-hyphenation-pattern! @spelling @word)}]])

(defn- hyphenation-valid? [s]
  (and (not (string/blank? s))
       (string/includes? s "-")
       (re-matches #"[a-z\xDF-\xFF-]+" s)))

(defn hyphenation-field []
  (let [label "Corrected Hyphenation"
        valid? (or (string/blank? @hyphenation) (hyphenation-valid? @hyphenation))
        klass (if valid? "form-group" "form-group has-error")]
    [:div
     {:class klass}
     [:label {:for "hyphenationInput"} label]
     [:input.form-control
      {:type "text"
       :placeholder label
       :value @hyphenation
       :on-change #(reset! hyphenation (-> % .-target .-value string/lower-case))}]]))

(defn- hyphenation-add-button []
  [:div.form-group
   [:button.btn.btn-default
    {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
                  (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling}))
     :disabled (when (or (string/blank? @word)
                         (not (hyphenation-valid? @hyphenation))
                         (= @hyphenation @suggested-hyphenation))
                 "disabled")}
    "Add"]])

(defn spelling-filter []
  [:div.form-group
   [:select {:value @spelling
             :on-change (fn [e]
                          (reset! spelling (-> e .-target .-value))
                          (load-hyphenation-patterns! @spelling @word)
                          (lookup-hyphenation-pattern! @spelling @word))}
    [:option {:value 0} "Old Spelling"]
    [:option {:value 1} "New Spelling"]]])

(defn suggested-hyphenation-field []
  (let [id "suggestedHyphenation"
        label "Suggested Hyphenation"]
    [:div.form-group
     [:label {:for id} label]
     [:input.form-control
      {:id id
       :type "text"
       :placeholder label
       :disabled "disabled"
       :value @suggested-hyphenation}]]))

(defn feedback-alert []
  (let [msg (:message @feedback)
        klass (if-let [kind (:kind @feedback)]
                (str "alert alert-" (name kind))
                "alert")]
    [:div {:class klass :role "alert"} msg]))

(defn new-hyphenation []
  [:div.form
   [spelling-filter]
   [word-field]
   [suggested-hyphenation-field]
   [hyphenation-field]
   [hyphenation-add-button]
   (when (not= :none (:kind @feedback))
     [feedback-alert])])

(defn hyphenation-list []
  [:div.container
   [:h1 "Hyphenation"]
   [:div.row
    [:div.col-md-6
     [new-hyphenation]]]
   [:h1 "Similar words"]
   [:div.row
    [:table#hyphenations.table.table-striped
     [:thead [:tr [:th "Word"] [:th "Hyphenation"]]]
     [:tbody
      (for [[word pattern] (:hyphenations @app-state)]
        ^{:key word} [hyphenation-pattern pattern])]]]])

;; -------------------------
;; Views

(defn home-page []
  [hyphenation-list])

(defn about-page []
  [:div [:h2 "About hyphen-keeper"]
   [:div [:a {:href "/"} "go to the home page"]]])

(defn current-page []
  [:div [(session/get :current-page)]])

;; -------------------------
;; Routes

(secretary/defroute "/" []
  (session/put! :current-page #'home-page))

(secretary/defroute "/about" []
  (session/put! :current-page #'about-page))

;; -------------------------
;; Initialize app

(defn mount-root []
  (reagent/render [current-page] (.getElementById js/document "app")))

(defn init! []
  (load-hyphenation-patterns! @spelling @word)
  (accountant/configure-navigation!
    {:nav-handler
     (fn [path]
       (secretary/dispatch! path))
     :path-exists?
     (fn [path]
       (secretary/locate-route path))})
  (accountant/dispatch-current!)
  (mount-root))

Add flash message for feedback

Add flash message for feedback


(ns hyphen-keeper.core
  (:require [accountant.core :as accountant]
            [ajax.core :as ajax]
            [clojure.string :as string]
            [reagent.core :as reagent]
            [reagent.session :as session]
            [secretary.core :as secretary :include-macros true]))

(defonce app-state
  (reagent/atom
   {:hyphenations []
    :spelling 1
    :word ""
    :hyphenation ""
    :suggested-hyphenation ""}))

(def spelling (reagent/cursor app-state [:spelling]))
(def word (reagent/cursor app-state [:word]))
(def hyphenation (reagent/cursor app-state [:hyphenation]))
(def suggested-hyphenation (reagent/cursor app-state [:suggested-hyphenation]))

(defn update-hyphenations! [f & args]
  (apply swap! app-state update-in [:hyphenations] f args))

(defn add-hyphenation! [h]
  (update-hyphenations! conj h))

(defn remove-hyphenation! [h]
  (update-hyphenations! (fn [hs] (vec (remove #(= % h) hs))) h))

(defn load-hyphenation-patterns!
  [spelling word]
  (ajax/GET "/api/words"
            :params {:spelling spelling :search word}
            :handler (fn [hyphenations] (swap! app-state assoc :hyphenations hyphenations))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to refresh hyphenation patterns from server: " details)))
            :response-format :json
            :keywords? true))

(defn add-hyphenation-pattern!
  [pattern]
  (ajax/POST "/api/words"
             :params pattern
             :handler (fn [] (add-hyphenation! pattern))
             :error-handler (fn [details]
                              (.warn js/console
                                     (str "Failed to add hyphenation pattern: " details)))
             :format :json))

(defn remove-hyphenation-pattern!
  [pattern]
  (ajax/DELETE (str "/api/words/" (:word pattern))
               :params pattern
               :handler (fn [] (remove-hyphenation! pattern))
               :error-handler (fn [details]
                                (.warn js/console
                                       (str "Failed to remove hyphenation pattern: " details)))
               :format :json))

(defn lookup-hyphenation-pattern!
  [spelling word]
  (ajax/GET "/api/hyphenate"
            :params {:word word :spelling spelling}
            :handler (fn [hyphenated] (do
                                        (swap! app-state assoc :suggested-hyphenation hyphenated)
                                        (swap! app-state assoc :hyphenation hyphenated)))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to lookup hyphenation patterns for word: " details)))))

(defn hyphenation-pattern [pattern]
  [:tr
   [:td (:word pattern)]
   [:td (:hyphenation pattern)]
   [:td
    [:div.btn-group
     [:button.btn.btn-default
      [:span.glyphicon.glyphicon-edit {:aria-hidden true}] " Edit"]
     [:button.btn.btn-default
      {:on-click #(remove-hyphenation-pattern! pattern)}
      [:span.glyphicon.glyphicon-trash {:aria-hidden true}] " Delete"]]]])

(defn word-field []
  [:div.form-group
   [:label {:for "wordInput"} "Word"]
   [:input.form-control
    {:id "wordInput"
     :type "text"
     :placeholder "Word"
     :value @word
     :on-change (fn [e]
                  (reset! word (-> e .-target .-value string/lower-case))
                  (load-hyphenation-patterns! @spelling @word))
     :on-blur #(lookup-hyphenation-pattern! @spelling @word)}]])

(defn- hyphenation-valid? [s]
  (and (not (string/blank? s))
       (re-find #"\S-\S" s)))

(defn hyphenation-field []
  (let [label "Corrected Hyphenation"
        valid? (or (string/blank? @hyphenation) (hyphenation-valid? @hyphenation))
        klass (if valid? "form-group" "form-group has-error")]
    [:div
     {:class klass}
     [:label {:for "hyphenationInput"} label]
     [:input.form-control
      {:type "text"
       :placeholder label
       :value @hyphenation
       :on-change #(reset! hyphenation (-> % .-target .-value string/lower-case))}]]))

(defn- hyphenation-add-button []
  [:button.btn.btn-default
   {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
                 (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling})
                 (reset! word "")
                 (reset! hyphenation ""))
    :disabled (when (or (string/blank? @word)
                        (not (hyphenation-valid? @hyphenation))
                        (= @hyphenation @suggested-hyphenation))
                "disabled")}
   "Add"])

(defn spelling-filter []
  [:div.form-group
   [:select {:value @spelling
             :on-change (fn [e]
                          (reset! spelling (-> e .-target .-value))
                          (load-hyphenation-patterns! @spelling @word)
                          (lookup-hyphenation-pattern! @spelling @word))}
    [:option {:value 0} "Old Spelling"]
    [:option {:value 1} "New Spelling"]]])

(defn suggested-hyphenation-field []
  (let [id "suggestedHyphenation"
        label "Suggested Hyphenation"]
    [:div.form-group
     [:label {:for id} label]
     [:input.form-control
      {:id id
       :type "text"
       :placeholder label
       :disabled "disabled"
       :value @suggested-hyphenation}]]))

(defn new-hyphenation []
  [:div.form
   [spelling-filter]
   [word-field]
   [suggested-hyphenation-field]
   [hyphenation-field]
   [hyphenation-add-button]])

(defn hyphenation-list []
  [:div.container
   [:h1 "Hyphenation"]
   [:div.row
    [:div.col-md-6
     [new-hyphenation]]]
   [:h1 "Similar words"]
   [:div.row
    [:table#hyphenations.table.table-striped
     [:thead [:tr [:th "Word"] [:th "Hyphenation"]]]
     [:tbody
      (for [h (sort-by :word (:hyphenations @app-state))]
        ^{:key (:word h)} [hyphenation-pattern h])]]]])

;; -------------------------
;; Views

(defn home-page []
  [hyphenation-list])

(defn about-page []
  [:div [:h2 "About hyphen-keeper"]
   [:div [:a {:href "/"} "go to the home page"]]])

(defn current-page []
  [:div [(session/get :current-page)]])

;; -------------------------
;; Routes

(secretary/defroute "/" []
  (session/put! :current-page #'home-page))

(secretary/defroute "/about" []
  (session/put! :current-page #'about-page))

;; -------------------------
;; Initialize app

(defn mount-root []
  (reagent/render [current-page] (.getElementById js/document "app")))

(defn init! []
  (load-hyphenation-patterns! @spelling @word)
  (accountant/configure-navigation!
    {:nav-handler
     (fn [path]
       (secretary/dispatch! path))
     :path-exists?
     (fn [path]
       (secretary/locate-route path))})
  (accountant/dispatch-current!)
  (mount-root))

(ns hyphen-keeper.core
  (:require [accountant.core :as accountant]
            [ajax.core :as ajax]
            [clojure.string :as string]
            [reagent.core :as reagent]
            [reagent.session :as session]
            [secretary.core :as secretary :include-macros true]))

(defonce app-state
  (reagent/atom
   {:hyphenations []
    :spelling 1
    :word ""
    :hyphenation ""
    :suggested-hyphenation ""}))

(def spelling (reagent/cursor app-state [:spelling]))
(def word (reagent/cursor app-state [:word]))
(def hyphenation (reagent/cursor app-state [:hyphenation]))
(def suggested-hyphenation (reagent/cursor app-state [:suggested-hyphenation]))

(defn update-hyphenations! [f & args]
  (apply swap! app-state update-in [:hyphenations] f args))

(defn add-hyphenation! [h]
  (update-hyphenations! conj h))

(defn remove-hyphenation! [h]
  (update-hyphenations! (fn [hs] (vec (remove #(= % h) hs))) h))

(defn load-hyphenation-patterns!
  [spelling word]
  (ajax/GET "/api/words"
            :params {:spelling spelling :search word}
            :handler (fn [hyphenations] (swap! app-state assoc :hyphenations hyphenations))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to refresh hyphenation patterns from server: " details)))
            :response-format :json
            :keywords? true))

(defn add-hyphenation-pattern!
  [pattern]
  (ajax/POST "/api/words"
             :params pattern
             :handler (fn [] (add-hyphenation! pattern))
             :error-handler (fn [details]
                              (.warn js/console
                                     (str "Failed to add hyphenation pattern: " details)))
             :format :json))

(defn remove-hyphenation-pattern!
  [pattern]
  (ajax/DELETE (str "/api/words/" (:word pattern))
               :params pattern
               :handler (fn [] (remove-hyphenation! pattern))
               :error-handler (fn [details]
                                (.warn js/console
                                       (str "Failed to remove hyphenation pattern: " details)))
               :format :json))

(defn lookup-hyphenation-pattern!
  [spelling word]
  (ajax/GET "/api/hyphenate"
            :params {:word word :spelling spelling}
            :handler (fn [hyphenated] (do
                                        (swap! app-state assoc :suggested-hyphenation hyphenated)
                                        (swap! app-state assoc :hyphenation hyphenated)))
            :error-handler (fn [details]
                             (.warn js/console
                                    (str "Failed to lookup hyphenation patterns for word: " details)))))

(defn hyphenation-pattern [pattern]
  [:tr
   [:td (:word pattern)]
   [:td (:hyphenation pattern)]
   [:td
    [:div.btn-group
     [:button.btn.btn-default
      [:span.glyphicon.glyphicon-edit {:aria-hidden true}] " Edit"]
     [:button.btn.btn-default
      {:on-click #(remove-hyphenation-pattern! pattern)}
      [:span.glyphicon.glyphicon-trash {:aria-hidden true}] " Delete"]]]])

(defn word-field []
  [:div.form-group
   [:label {:for "wordInput"} "Word"]
   [:input.form-control
    {:id "wordInput"
     :type "text"
     :placeholder "Word"
     :value @word
     :on-change (fn [e]
                  (reset! word (-> e .-target .-value string/lower-case))
                  (load-hyphenation-patterns! @spelling @word))
     :on-blur #(lookup-hyphenation-pattern! @spelling @word)}]])

(defn- hyphenation-valid? [s]
  (and (not (string/blank? s))
       (string/includes? s "-")
       (re-matches #"[a-z\xDF-\xFF-]+" s)))

(defn hyphenation-field []
  (let [label "Corrected Hyphenation"
        valid? (or (string/blank? @hyphenation) (hyphenation-valid? @hyphenation))
        klass (if valid? "form-group" "form-group has-error")]
    [:div
     {:class klass}
     [:label {:for "hyphenationInput"} label]
     [:input.form-control
      {:type "text"
       :placeholder label
       :value @hyphenation
       :on-change #(reset! hyphenation (-> % .-target .-value string/lower-case))}]]))

(defn- hyphenation-add-button []
  [:button.btn.btn-default
   {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
                 (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling})
                 (reset! word "")
                 (reset! hyphenation ""))
    :disabled (when (or (string/blank? @word)
                        (not (hyphenation-valid? @hyphenation))
                        (= @hyphenation @suggested-hyphenation))
                "disabled")}
   "Add"])

(defn spelling-filter []
  [:div.form-group
   [:select {:value @spelling
             :on-change (fn [e]
                          (reset! spelling (-> e .-target .-value))
                          (load-hyphenation-patterns! @spelling @word)
                          (lookup-hyphenation-pattern! @spelling @word))}
    [:option {:value 0} "Old Spelling"]
    [:option {:value 1} "New Spelling"]]])

(defn suggested-hyphenation-field []
  (let [id "suggestedHyphenation"
        label "Suggested Hyphenation"]
    [:div.form-group
     [:label {:for id} label]
     [:input.form-control
      {:id id
       :type "text"
       :placeholder label
       :disabled "disabled"
       :value @suggested-hyphenation}]]))

(defn new-hyphenation []
  [:div.form
   [spelling-filter]
   [word-field]
   [suggested-hyphenation-field]
   [hyphenation-field]
   [hyphenation-add-button]])

(defn hyphenation-list []
  [:div.container
   [:h1 "Hyphenation"]
   [:div.row
    [:div.col-md-6
     [new-hyphenation]]]
   [:h1 "Similar words"]
   [:div.row
    [:table#hyphenations.table.table-striped
     [:thead [:tr [:th "Word"] [:th "Hyphenation"]]]
     [:tbody
      (for [h (sort-by :word (:hyphenations @app-state))]
        ^{:key (:word h)} [hyphenation-pattern h])]]]])

;; -------------------------
;; Views

(defn home-page []
  [hyphenation-list])

(defn about-page []
  [:div [:h2 "About hyphen-keeper"]
   [:div [:a {:href "/"} "go to the home page"]]])

(defn current-page []
  [:div [(session/get :current-page)]])

;; -------------------------
;; Routes

(secretary/defroute "/" []
  (session/put! :current-page #'home-page))

(secretary/defroute "/about" []
  (session/put! :current-page #'about-page))

;; -------------------------
;; Initialize app

(defn mount-root []
  (reagent/render [current-page] (.getElementById js/document "app")))

(defn init! []
  (load-hyphenation-patterns! @spelling @word)
  (accountant/configure-navigation!
    {:nav-handler
     (fn [path]
       (secretary/dispatch! path))
     :path-exists?
     (fn [path]
       (secretary/locate-route path))})
  (accountant/dispatch-current!)
  (mount-root))

Validate the hyphenation

Validate the hyphenation


(ns tufdown.core
  (:require [tufdown.block :as block]
            [tufdown.span :as span]
            [tufdown.util :refer [escape-html]]
            [instaparse.core :as insta]))

(defn- make-string-end-with-LF [text]
  (if (clojure.string/ends-with? text "\n")
    text
    (str text "\n")))

(defn parse [text]
  (->> text
       make-string-end-with-LF
       block/parse
       (insta/transform {:문장 (fn [& chars]
                                 (span/parse (apply str chars)))})))

(declare render-html)

(defn- render-element [[태그 & 내용]]
  (let [태그맵 {:큰제목 "h2", :작은제목 "h3", :일반목록 "ul", :숫자목록 "ol"
                :항목 "li", :인용 "blockquote", :원문 "pre", :문단 "p"
                :기울임 "i", :굵게 "em"}
        추출 (fn [tag] (apply str (some #(= (first %) tag) 내용)))]
    (case 태그
      :빈줄   "
"
      :구분줄 "
"

      :소스코드
      (str "
"
           (render-html (추출 :소스내용))
           "
")

      ;; 기본
      (if-let [tag (태그맵 태그)]
        (str "<" tag ">" (render-html 내용) "</" tag ">")
        (render-html 내용)))))

(defn render-html [e]
  (cond
    (vector? e) (render-element e)
    (string? e) (escape-html e)
    (seq? e)    (apply str (map render-html e))
    (nil? e)    ""
    :default    (recur (str e))))

;; (render-html (parse "테스트\n==="))

(ns tufdown.core
  (:require [tufdown.block :as block]
            [tufdown.span :as span]
            [tufdown.util :refer [escape-html]]
            [instaparse.core :as insta]))

(defn- make-string-end-with-LF [text]
  (if (clojure.string/ends-with? text "\n")
    text
    (str text "\n")))

(defn parse [text]
  (->> text
       make-string-end-with-LF
       block/parse
       (insta/transform {:문장 #(span/parse (apply str %&))})))

(declare render-html)

(defn- render-element [[태그 & 내용]]
  (let [태그맵 {:큰제목 "h2", :작은제목 "h3", :일반목록 "ul", :숫자목록 "ol"
                :항목 "li", :인용 "blockquote", :원문 "pre", :문단 "p"
                :기울임 "i", :굵게 "em"}
        추출 (fn [tag] (apply str (some #(= (first %) tag) 내용)))]
    (case 태그
      :빈줄   "
"
      :구분줄 "
"

      :소스코드
      (str "
"
           (render-html (추출 :소스내용))
           "
")

      ;; 기본
      (if-let [tag (태그맵 태그)]
        (str "<" tag ">" (render-html 내용) "</" tag ">")
        (render-html 내용)))))

(defn render-html [e]
  (cond
    (vector? e) (render-element e)
    (string? e) (escape-html e)
    (seq? e)    (apply str (map render-html e))
    (nil? e)    ""
    :default    (recur (str e))))

;; (render-html (parse "테스트\n==="))

변환 함수 짧게

변환 함수 짧게


(ns clojars.integration.sessions-test
  (:require
   [clojars.integration.steps :refer [create-deploy-token enable-mfa login-as register-as]]
   [clojars.test-helper :as help]
   [clojure.java.jdbc :as jdbc]
   [clojure.test :refer [deftest testing use-fixtures]]
   [kerodon
    [core :refer [follow follow-redirect session within]]
    [test :refer [has status? text?]]]
   [net.cgrand.enlive-html :as enlive]
   [one-time.core :as ot]))

(use-fixtures :each
  help/default-fixture
  help/with-clean-database)

(deftest user-cant-login-with-bad-user-pass-combo
  (-> (session (help/app))
      (login-as "fixture@example.org" "password")
      (follow-redirect)
      (has (status? 200))
      (within [:div :p.error]
              (has (text? "Incorrect username, password, or two-factor code.Make sure that you are using your username, and not your email to log in.")))))

(deftest user-can-login-and-logout
  (let [app (help/app)]
    (-> (session app)
        (register-as "fixture" "fixture@example.org" "password"))
    (doseq [login ["fixture"]]
      (-> (session app)
          (login-as login "password")
          (follow-redirect)
          (has (status? 200))
          (within [:.light-article :> :h1]
                  (has (text? "Dashboard (fixture)")))
          (follow "logout")
          (follow-redirect)
          (has (status? 200))
          (within [:nav [:li enlive/first-child] :a]
                  (has (text? "login")))))))

(deftest user-cant-login-with-deploy-token
  (let [app (help/app)
        _ (-> (session app)
              (register-as "fixture" "fixture@example.org" "password"))
        token (create-deploy-token (session app) "fixture" "password" "testing")]
    (-> (session app)
        (login-as "fixture" token)
        (follow-redirect)
        (has (status? 200))
        (within [:div :p.error]
                (has (text? "Incorrect username, password, or two-factor code."))))))

(deftest user-with-password-wipe-gets-message
  (let [app (help/app)]
    (-> (session app)
        (register-as "fixture" "fixture@example.org" "password"))
    (jdbc/db-do-commands help/*db*
                         "update users set password='' where \"user\" = 'fixture'")
    (-> (session app)
        (login-as "fixture" "password")
        (follow-redirect)
        (has (status? 200))
        (within [:div :p.error]
                (has (text? "Incorrect username, password, or two-factor code."))))))

(deftest login-with-mfa
  (let [app (help/app)]
    (-> (session app)
        (register-as "fixture" "fixture@example.org" "password"))
    (let [[otp-secret recovery-code] (enable-mfa (session app) "fixture" "password")]
      (testing "with valid token"
        (-> (session app)
            (login-as "fixture" "password" (ot/get-totp-token otp-secret))
            (follow-redirect)
            (has (status? 200))
            (within [:.light-article :> :h1]
                    (has (text? "Dashboard (fixture)")))))
      (testing "with invalid token"
        (-> (session app)
            (login-as "fixture" "password" "1")
            (follow-redirect)
            (has (status? 200))
            (within [:div :p.error]
                    (has (text? "Incorrect username, password, or two-factor code.")))))
      (testing "with recovery code"
        (-> (session app)
            (login-as "fixture" "password" recovery-code)
            (follow-redirect)
            (has (status? 200))
            (within [:.light-article :> :h1]
                    (has (text? "Dashboard (fixture)"))))
        ;; mfa is now disabled, so login w/o an otp works
        (-> (session app)
            (login-as "fixture" "password")
            (follow-redirect)
            (has (status? 200))
            (within [:.light-article :> :h1]
                    (has (text? "Dashboard (fixture)"))))))))

(ns clojars.integration.sessions-test
  (:require
   [clojars.integration.steps :refer [create-deploy-token enable-mfa login-as register-as]]
   [clojars.test-helper :as help]
   [clojure.java.jdbc :as jdbc]
   [clojure.test :refer [deftest testing use-fixtures]]
   [kerodon.core :refer [follow follow-redirect session within]]
   [kerodon.test :refer [has status? text?]]
   [net.cgrand.enlive-html :as enlive]
   [one-time.core :as ot])
  (:import
    (java.util Date)))

(use-fixtures :each
  help/default-fixture
  help/with-clean-database)

(deftest user-cant-login-with-bad-user-pass-combo
  (-> (session (help/app))
      (login-as "fixture@example.org" "password")
      (follow-redirect)
      (has (status? 200))
      (within [:div :p.error]
              (has (text? "Incorrect username, password, or two-factor code.Make sure that you are using your username, and not your email to log in.")))))

(deftest user-can-login-and-logout
  (let [app (help/app)]
    (-> (session app)
        (register-as "fixture" "fixture@example.org" "password"))
    (doseq [login ["fixture"]]
      (-> (session app)
          (login-as login "password")
          (follow-redirect)
          (has (status? 200))
          (within [:.light-article :> :h1]
                  (has (text? "Dashboard (fixture)")))
          (follow "logout")
          (follow-redirect)
          (has (status? 200))
          (within [:nav [:li enlive/first-child] :a]
                  (has (text? "login")))))))

(deftest user-cant-login-with-deploy-token
  (let [app (help/app)
        _ (-> (session app)
              (register-as "fixture" "fixture@example.org" "password"))
        token (create-deploy-token (session app) "fixture" "password" "testing")]
    (-> (session app)
        (login-as "fixture" token)
        (follow-redirect)
        (has (status? 200))
        (within [:div :p.error]
                (has (text? "Incorrect username, password, or two-factor code."))))))

(deftest user-with-password-wipe-gets-message
  (let [app (help/app)]
    (-> (session app)
        (register-as "fixture" "fixture@example.org" "password"))
    (jdbc/db-do-commands help/*db*
                         "update users set password='' where \"user\" = 'fixture'")
    (-> (session app)
        (login-as "fixture" "password")
        (follow-redirect)
        (has (status? 200))
        (within [:div :p.error]
                (has (text? "Incorrect username, password, or two-factor code."))))))

(deftest login-with-mfa
  (let [app (help/app)]
    (-> (session app)
        (register-as "fixture" "fixture@example.org" "password"))
    (let [[otp-secret recovery-code] (enable-mfa (session app) "fixture" "password")]
      (testing "with valid token"
        (-> (session app)
            (login-as "fixture" "password" (ot/get-totp-token otp-secret))
            (follow-redirect)
            (has (status? 200))
            (within [:.light-article :> :h1]
                    (has (text? "Dashboard (fixture)")))))
      (testing "with a token that is too old"
        (let [the-past (Date. (- (System/currentTimeMillis) 31000))]
          (-> (session app)
              (login-as "fixture" "password" (ot/get-totp-token otp-secret {:date the-past}))
              (follow-redirect)
              (has (status? 200))
              (within [:div :p.error]
                      (has (text? "Incorrect username, password, or two-factor code."))))))
      (testing "with a token that is in the future"
        (let [the-future (Date. (+ (System/currentTimeMillis) 31000))]
          (-> (session app)
              (login-as "fixture" "password" (ot/get-totp-token otp-secret {:date the-future}))
              (follow-redirect)
              (has (status? 200))
              (within [:div :p.error]
                      (has (text? "Incorrect username, password, or two-factor code."))))))
      (testing "with invalid token"
        (-> (session app)
            (login-as "fixture" "password" "1")
            (follow-redirect)
            (has (status? 200))
            (within [:div :p.error]
                    (has (text? "Incorrect username, password, or two-factor code.")))))
      (testing "with recovery code"
        (-> (session app)
            (login-as "fixture" "password" recovery-code)
            (follow-redirect)
            (has (status? 200))
            (within [:.light-article :> :h1]
                    (has (text? "Dashboard (fixture)"))))
        ;; mfa is now disabled, so login w/o an otp works
        (-> (session app)
            (login-as "fixture" "password")
            (follow-redirect)
            (has (status? 200))
            (within [:.light-article :> :h1]
                    (has (text? "Dashboard (fixture)"))))))))

Add test for too old/new mfa codes

Add test for too old/new mfa codes