;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns ^:no-doc ^:internal immutant.web.internal
    (:require [immutant.web.undertow :as undertow]
              [immutant.internal.options  :refer [extract-options opts->set opts->defaults-map]]
              [immutant.internal.util     :as u]
              [immutant.web.middleware    :refer [wrap-dev-middleware]]
              [clojure.java.browse        :refer [browse-url]])
    (:import org.projectodd.wunderboss.WunderBoss
             io.undertow.server.HttpHandler
             [org.projectodd.wunderboss.web Web Web$CreateOption Web$RegisterOption]
             javax.servlet.Servlet))

(def ^:internal register-defaults (opts->defaults-map Web$RegisterOption))
(def ^:internal create-defaults (opts->defaults-map Web$CreateOption))

(def ^:internal server-name
  (partial u/hash-based-component-name create-defaults))

(defn ^:internal server [opts]
  (WunderBoss/findOrCreateComponent Web
    (server-name (select-keys opts (opts->set Web$CreateOption)))
    (extract-options opts Web$CreateOption)))

(defn ^:internal mount [server handler opts]
  (let [opts (extract-options opts Web$RegisterOption)]
    (if (instance? Servlet handler)
      (.registerServlet server handler opts)
      (.registerHandler server
        (if (instance? HttpHandler handler)
          handler
          (undertow/create-http-handler handler))
        opts))))

(defn ^:internal run-dmc* [run handler & options]
  (let [result (apply run (wrap-dev-middleware handler) options)]
    (browse-url (format "http://%s:%s%s"
                  (:host options (:host create-defaults))
                  (:port options (:port create-defaults))
                  (:path options (:path register-defaults))))
    result))

;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns ^:no-doc ^:internal immutant.web.internal
    (:require [immutant.web.undertow :as undertow]
              [immutant.internal.options  :refer [extract-options opts->set opts->defaults-map]]
              [immutant.internal.util     :as u]
              [immutant.web.middleware    :refer [wrap-dev-middleware]]
              [clojure.java.browse        :refer [browse-url]])
    (:import org.projectodd.wunderboss.WunderBoss
             io.undertow.server.HttpHandler
             [org.projectodd.wunderboss.web Web Web$CreateOption Web$RegisterOption]
             javax.servlet.Servlet))

(def ^:internal register-defaults (opts->defaults-map Web$RegisterOption))
(def ^:internal create-defaults (opts->defaults-map Web$CreateOption))

(def ^:internal server-name
  (partial u/hash-based-component-name create-defaults))

(defn ^:internal server [opts]
  (WunderBoss/findOrCreateComponent Web
    (server-name (select-keys opts (opts->set Web$CreateOption)))
    (extract-options opts Web$CreateOption)))

(defn ^:internal mount [server handler opts]
  (let [opts (extract-options opts Web$RegisterOption)]
    (if (instance? Servlet handler)
      (.registerServlet server handler opts)
      (.registerHandler server
        (if (instance? HttpHandler handler)
          handler
          (undertow/create-http-handler handler))
        opts))))

(defn ^:internal run-dmc* [run handler & options]
  (let [result (apply run (wrap-dev-middleware handler) options)
        options (u/kwargs-or-map->map options)]
    (browse-url (format "http://%s:%s%s"
                  (:host options (:host create-defaults))
                  (:port options (:port create-defaults))
                  (:path options (:path register-defaults))))
    result))

Fix issue with run-dmc not respecting options

browse-url within run-dmc* was not properly handling the options passed
to it resulting in the browser always being launched and pointed at
http://localhost:8080.


;; Copyright © 2014 JUXT LTD.
(ns modular.less.compilation-test
  (:require [modular.less.compilation :refer (new-less-compilation)]
            [com.stuartsierra.component :refer (start)]
            [clojure.test :refer :all]))

;; todo: convert to unit test
(deftest test-start-compilation
  (testing " start compilation"
    (start (new-less-compilation :engine :javascript
                  :less-config {:project-root "resources"
                                :source-paths ["less"]
                                :target-path "css"}))))

;; Copyright © 2014 JUXT LTD.
(ns modular.less.compilation-test
  (:require [modular.less.compilation :refer (new-less-compilation)]
            [com.stuartsierra.component :refer (start)]
            [clojure.test :refer :all]))

;; todo: convert to unit test
(deftest test-start-compilation
  (testing " start compilation"
    (start (new-less-compilation :engine :javascript
                  :less-config {:project-root "resources"
                                :source-path "your-less-file.less"
                                :target-path "your-css-file.css"}))))

Update compilation_test.clj

Update compilation_test.clj


(ns vault.entity.tx
  "Entity data is stored in _transaction_ data blobs. These contain entity
  _roots_ and _updates_.

  A root blob creates a new entity by establishing a stable hash identifier as
  an _identity_. An update blob adds further modifications to one or more existing
  entities, identified by their root hash ids."
  (:require
    [clj-time.core :as time]
    [clojure.set :as set]
    [clojure.string :as str]
    [schema.core :as schema]
    ;[vault.blob.content]
    [vault.blob.store :as store]
    (vault.data
      [edn :as edn]
      [signature :as sig]
      [struct :as struct])
    (vault.entity
      [datom :as datom]))
  (:import
    org.joda.time.DateTime
    vault.blob.content.HashID))

;; ## Schemas

(def ^:const root-type   :vault.entity/root)
(def ^:const update-type :vault.entity/update)

(def DatomOperation
  "Schema for an operation on a datom."
  (schema/enum :attr/set :attr/add :attr/del))

(def DatomFragment
  "Schema for a fragment of a datom. Formed by a partial datom vector with
  `op`, `attribute`, and `value`."
  [(schema/one DatomOperation "operation")
   (schema/one schema/Keyword "attribute")
   (schema/one schema/Any "value")])

(def DatomFragments
  "Schema for a vector of one or more datom fragments."
  [(schema/one DatomFragment "datoms")
   DatomFragment])

(def DatomUpdates
  "Schema for a map from entity hash-ids to vectors of datom fragments."
  {HashID DatomFragments})

(def EntityRoot
  "Schema for an entity root value."
  {edn/type-key (schema/eq root-type)
   :id String
   :owner HashID
   :time DateTime
   (schema/optional-key :data) DatomFragments})

(def EntityUpdate
  "Schema for an entity update value."
  {edn/type-key (schema/eq update-type)
   :time DateTime
   :data DatomUpdates})

;; ## Entity Roots

(defn root?
  "Determines whether the given value is an entity root."
  [value]
  (= root-type (edn/value-type value)))

(defn- random-id!
  "Generates a hexadecimal identifier string from a sequence of random bytes."
  []
  (let [buf (byte-array 16)]
    (.nextBytes (java.security.SecureRandom.) buf)
    (.toString (BigInteger. 1 buf) 16)))

(defn root-value
  "Constructs a new entity root value."
  [{:keys [owner id time data]}]
  (when-not owner
    (throw (IllegalArgumentException. "Cannot create entity without owner")))
  (when data
    (schema/validate DatomFragments data))
  (cond->
    (edn/typed-map
      root-type
      :id (or id (random-id!))
      :time (or time (time/now))
      :owner owner)
    data (assoc :data data)))

(defn root->blob
  "Constructs a new entity blob for the given owner."
  [store sig-provider args]
  (sig/sign-value
    (root-value args)
    store
    sig-provider
    (:owner args)))

(defn validate-root
  "Checks the structure and signatures on an entity root blob. Returns a blob
  record with verified signatures."
  [blob store]
  (schema/validate EntityRoot (struct/data-value blob))
  (let [blob (sig/verify-sigs blob store)
        sigs (:data/signatures blob)
        owner (:owner (struct/data-value blob))]
    (when-not (contains? sigs owner)
      (throw (IllegalStateException.
               (str "Entity blob blob " (:id blob)
                    " does not have a valid signature by the owning key "
                    owner))))
    blob))

;; ## Entity Updates

(defn update?
  "Determines whether the given value is an entity update."
  [value]
  (= update-type (edn/value-type value)))

(defn- get-owner
  "Looks up the owner for the given entity root id. Throws an exception if any
  of the ids is not an entity root."
  [store root-id]
  (let [blob (edn/parse-data (store/get store root-id))]
    (when-not blob
      (throw (IllegalArgumentException.
               (str "Cannot get owner for nonexistent entity " root-id))))
    (when-not (root? (struct/data-value blob))
      (throw (IllegalArgumentException.
               (str "Cannot get owner for non-root blob " root-id))))
    (:owner (struct/data-value blob))))

(defn- get-update-owners
  "Given a map of DatomUpdates, returns a set of the hash-ids of the
  keys which own the updated entities."
  [store updates]
  (->> (keys updates)
       (map (partial get-owner store))
       set))

(defn update-value
  "Constructs a new entity update value."
  [{:keys [time data]}]
  (schema/validate DatomUpdates data)
  (edn/typed-map
    update-type
    :time (or time (time/now))
    :data (into (sorted-map) data)))

(defn update->blob
  "Constructs a new update blob from the given args."
  [store sig-provider args]
  (apply
    sig/sign-value
    (update-value args)
    store
    sig-provider
    (get-update-owners store (:data args))))

(defn validate-update
  "Checks the structure and signatures on an entity update blob. Returns a blob
  record with verified signatures."
  [blob store]
  (schema/validate EntityUpdate (struct/data-value blob))
  (let [blob (sig/verify-sigs blob store)
        sigs (:data/signatures blob)
        owners (get-update-owners store (:data (struct/data-value blob)))
        missing (set/difference owners sigs)]
    (when-not (empty? missing)
      (throw (IllegalStateException.
               (str "Entity update blob " (:id blob)
                    " is missing signatures by some owning keys: "
                    (str/join " " missing)))))
    blob))

;; ## Transaction Datoms

(defn- map-datoms
  "Maps a constructor across a sequence of fragments, producing Datom records."
  [id time entity fragments]
  (map
    (fn [[op attr value]]
      (datom/->Datom op entity attr value id time))
    fragments))

(defn tx->datoms
  "Reads a sequence of datoms from a transaction blob."
  [{:keys [id] :as blob}]
  (let [{:keys [time data] :as tx} (struct/data-value blob)]
    (condp = (struct/data-type blob)
      root-type   (map-datoms id time id data)
      update-type (mapcat (partial apply map-datoms id time) data))))

(ns vault.entity.tx
  "Entity data is stored in _transaction_ data blobs. These contain entity
  _roots_ and _updates_.

  A root blob creates a new entity by establishing a stable hash identifier as
  an _identity_. An update blob adds further modifications to one or more existing
  entities, identified by their root hash ids."
  (:require
    [clj-time.core :as time]
    [clojure.set :as set]
    [clojure.string :as str]
    [schema.core :as schema]
    ;[vault.blob.content]
    [vault.blob.store :as store]
    (vault.data
      [edn :as edn]
      [signature :as sig]
      [struct :as struct])
    (vault.entity
      [datom :as datom]))
  (:import
    org.joda.time.DateTime
    vault.blob.content.HashID))

;; ## Schemas

(def ^:const root-type   :vault.entity/root)
(def ^:const update-type :vault.entity/update)

(def DatomOperation
  "Schema for an operation on a datom."
  (schema/enum :attr/set :attr/add :attr/del))

(def DatomFragment
  "Schema for a fragment of a datom. Formed by a partial datom vector with
  `op`, `attribute`, and `value`."
  [(schema/one DatomOperation "operation")
   (schema/one schema/Keyword "attribute")
   (schema/one schema/Any "value")])

(def DatomFragments
  "Schema for a vector of one or more datom fragments."
  [(schema/one DatomFragment "datoms")
   DatomFragment])

(def DatomUpdates
  "Schema for a map from entity hash-ids to vectors of datom fragments."
  {HashID DatomFragments})

(def EntityRoot
  "Schema for an entity root value."
  {edn/type-key (schema/eq root-type)
   :id String
   :owner HashID
   :time DateTime
   (schema/optional-key :data) DatomFragments})

(def EntityUpdate
  "Schema for an entity update value."
  {edn/type-key (schema/eq update-type)
   :time DateTime
   :data DatomUpdates})

;; ## Entity Roots

(defn root?
  "Determines whether the given value is an entity root."
  [value]
  (= root-type (edn/value-type value)))

(defn- random-id!
  "Generates a hexadecimal identifier string from a sequence of random bytes."
  []
  (let [buf (byte-array 16)]
    (.nextBytes (java.security.SecureRandom.) buf)
    (.toString (BigInteger. 1 buf) 16)))

(defn root-value
  "Constructs a new entity root value."
  [{:keys [owner id time data]}]
  (when-not owner
    (throw (IllegalArgumentException. "Cannot create entity without owner")))
  (when data
    (schema/validate DatomFragments data))
  (cond->
    (edn/typed-map
      root-type
      :id (or id (random-id!))
      :time (or time (time/now))
      :owner owner)
    data (assoc :data data)))

(defn root->blob
  "Constructs a new entity blob for the given owner."
  [store sig-provider args]
  (sig/sign-value
    (root-value args)
    store
    sig-provider
    (:owner args)))

(defn validate-root
  "Checks the structure and signatures on an entity root blob. Returns a blob
  record with verified signatures."
  [blob store]
  (schema/validate EntityRoot (struct/data-value blob))
  (let [blob (sig/verify-sigs blob store)
        sigs (:data/signatures blob)
        owner (:owner (struct/data-value blob))]
    (when-not (contains? sigs owner)
      (throw (IllegalStateException.
               (str "Entity blob blob " (:id blob)
                    " does not have a valid signature by the owning key "
                    owner))))
    blob))

;; ## Entity Updates

(defn update?
  "Determines whether the given value is an entity update."
  [value]
  (= update-type (edn/value-type value)))

(defn- get-owner
  "Looks up the owner for the given entity root id. Throws an exception if any
  of the ids is not an entity root."
  [store root-id]
  (let [data (->> root-id (store/get store) edn/parse-data struct/data-value)]
    (when-not data
      (throw (IllegalStateException.
               (str "Cannot get owner for nonexistent entity " root-id))))
    (when-not (root? data)
      (throw (IllegalStateException.
               (str "Cannot get owner for non-root blob " root-id))))
    (:owner data)))

(defn- get-update-owners
  "Given a map of DatomUpdates, returns a set of the hash-ids of the
  keys which own the updated entities."
  [store updates]
  (->> (keys updates)
       (map (partial get-owner store))
       set))

(defn update-value
  "Constructs a new entity update value."
  [{:keys [time data]}]
  (schema/validate DatomUpdates data)
  (edn/typed-map
    update-type
    :time (or time (time/now))
    :data (into (sorted-map) data)))

(defn update->blob
  "Constructs a new update blob from the given args."
  [store sig-provider args]
  (apply
    sig/sign-value
    (update-value args)
    store
    sig-provider
    (get-update-owners store (:data args))))

(defn validate-update
  "Checks the structure and signatures on an entity update blob. Returns a blob
  record with verified signatures."
  [blob store]
  (schema/validate EntityUpdate (struct/data-value blob))
  (let [blob (sig/verify-sigs blob store)
        sigs (:data/signatures blob)
        owners (get-update-owners store (:data (struct/data-value blob)))
        missing (set/difference owners sigs)]
    (when-not (empty? missing)
      (throw (IllegalStateException.
               (str "Entity update blob " (:id blob)
                    " is missing signatures by some owning keys: "
                    (str/join " " missing)))))
    blob))

;; ## Transaction Datoms

(defn- map-datoms
  "Maps a constructor across a sequence of fragments, producing Datom records."
  [id time entity fragments]
  (map
    (fn [[op attr value]]
      (datom/->Datom op entity attr value id time))
    fragments))

(defn tx->datoms
  "Reads a sequence of datoms from a transaction blob."
  [{:keys [id] :as blob}]
  (let [{:keys [time data] :as tx} (struct/data-value blob)]
    (condp = (struct/data-type blob)
      root-type   (map-datoms id time id data)
      update-type (mapcat (partial apply map-datoms id time) data))))

Simplify get-owner function.

Simplify get-owner function.


;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.be>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns buddy.auth.backends.token
  "The token based authentication and authorization backends."
  (:require [buddy.auth.protocols :as proto]
            [buddy.auth.http :as http]
            [buddy.sign.jws :as jws]
            [buddy.sign.jwe :as jwe]
            [slingshot.slingshot :refer [try+]]))

(defn- handle-unauthorized-default [request]
  (if (:identity request)
    {:status 403 :headers {} :body "Permission denied"}
    {:status 401 :headers {} :body "Unauthorized"}))

(defn- parse-authorization-header
  [request token-name]
  (some->> (http/get-header request "authorization")
           (re-find (re-pattern (str "^" token-name " (.+)$")))
           (second)))

(defn jws-backend
  "The JWS (Json Web Signature) based backend constructor."
  [{:keys [secret unauthorized-handler options token-name on-error]
    :or {token-name "Token"}}]
  (reify
    proto/IAuthentication
    (parse [_ request]
      (parse-authorization-header request token-name))
    (authenticate [_ request data]
      (try+
        (assoc request :identity (jws/unsign data secret options))
        (catch [:type :validation] e
          (if (fn? on-error)
            (on-error request e)
            request))))

    proto/IAuthorization
    (handle-unauthorized [_ request metadata]
      (if unauthorized-handler
        (unauthorized-handler request metadata)
        (handle-unauthorized-default request)))))

(defn jwe-backend
  "The JWE (Json Web Encryption) based backend constructor."
  [{:keys [secret unauthorized-handler options token-name on-error]
    :or {token-name "Token"}}]
  (reify
    proto/IAuthentication
    (parse [_ request]
      (parse-authorization-header request token-name))
    (authenticate [_ request data]
      (try+
        (assoc request :identity (jwe/decrypt data secret options))
        (catch [:type :validation] e
          (if (fn? on-error)
            (on-error request e)
            request))))

    proto/IAuthorization
    (handle-unauthorized [_ request metadata]
      (if unauthorized-handler
        (unauthorized-handler request metadata)
        (handle-unauthorized-default request)))))

(defn token-backend
  [{:keys [authfn unauthorized-handler token-name] :or {token-name "Token"}}]
  {:pre [(fn? authfn)]}
  (reify
    proto/IAuthentication
    (parse [_ request]
      (parse-authorization-header request token-name))
    (authenticate [_ request token]
      (let [rsq (authfn request token)]
        (if (http/response? rsq)
          rsq
          (assoc request :identity rsq))))

    proto/IAuthorization
    (handle-unauthorized [_ request metadata]
      (if unauthorized-handler
        (unauthorized-handler request metadata)
        (handle-unauthorized-default request)))))

;; Copyright 2013-2015 Andrey Antukh <niwi@niwi.nz>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns buddy.auth.backends.token
  "The token based authentication and authorization backends."
  (:require [buddy.auth.protocols :as proto]
            [buddy.auth.http :as http]
            [buddy.sign.jws :as jws]
            [buddy.sign.jwe :as jwe]
            [slingshot.slingshot :refer [try+]]))

(defn- handle-unauthorized-default [request]
  (if (:identity request)
    {:status 403 :headers {} :body "Permission denied"}
    {:status 401 :headers {} :body "Unauthorized"}))

(defn- parse-authorization-header
  [request token-name]
  (some->> (http/get-header request "authorization")
           (re-find (re-pattern (str "^" token-name " (.+)$")))
           (second)))

(defn jws-backend
  "The JWS (Json Web Signature) based backend constructor."
  [{:keys [secret unauthorized-handler options token-name on-error]
    :or {token-name "Token"}}]
  (reify
    proto/IAuthentication
    (parse [_ request]
      (parse-authorization-header request token-name))
    (authenticate [_ request data]
      (try+
        (assoc request :identity (jws/unsign data secret options))
        (catch [:type :validation] e
          (if (fn? on-error)
            (on-error request e)
            request))))

    proto/IAuthorization
    (handle-unauthorized [_ request metadata]
      (if unauthorized-handler
        (unauthorized-handler request metadata)
        (handle-unauthorized-default request)))))

(defn jwe-backend
  "The JWE (Json Web Encryption) based backend constructor."
  [{:keys [secret unauthorized-handler options token-name on-error]
    :or {token-name "Token"}}]
  (reify
    proto/IAuthentication
    (parse [_ request]
      (parse-authorization-header request token-name))
    (authenticate [_ request data]
      (try+
        (assoc request :identity (jwe/decrypt data secret options))
        (catch [:type :validation] e
          (if (fn? on-error)
            (on-error request e)
            request))))

    proto/IAuthorization
    (handle-unauthorized [_ request metadata]
      (if unauthorized-handler
        (unauthorized-handler request metadata)
        (handle-unauthorized-default request)))))

(defn token-backend
  [{:keys [authfn unauthorized-handler token-name] :or {token-name "Token"}}]
  {:pre [(fn? authfn)]}
  (reify
    proto/IAuthentication
    (parse [_ request]
      (parse-authorization-header request token-name))
    (authenticate [_ request token]
      (let [rsq (authfn request token)]
        (if (http/response? rsq)
          rsq
          (assoc request :identity rsq))))

    proto/IAuthorization
    (handle-unauthorized [_ request metadata]
      (if unauthorized-handler
        (unauthorized-handler request metadata)
        (handle-unauthorized-default request)))))

Fix email on copyright notice on token ns.


(ns comic-reader.database
  (:require [com.stuartsierra.component :as component]
            [comic-reader.config :as config]
            [comic-reader.database.norms :as norms]
            [datomic.api :as d]
            [io.rkn.conformity :as conformity]))

(defn- create-database [config]
  (d/create-database (config/database-uri config)))

(defn- connect [config]
  (d/connect (config/database-uri config)))

(defn- setup-and-connect-to-database [config]
  (when (config/database-uri config)
    (println "Comic-Reader: Connecting to database...")
    (let [do-seeds? (create-database config)
          conn (connect config)]
      ;; Conform database to schemas here
      (when-let [norms-dir (config/norms-dir config)]
        (println "Comic-Reader: Conforming database to norms...")
        (conformity/ensure-conforms conn (norms/norms-map norms-dir)))

      ;; Add seeds if database was newly created
      ;; (when do-seeds?
      ;;   @(d/transact conn (seed/data)))
      conn)))

(defrecord Database [config conn]
  component/Lifecycle

  (start [component]
    (if-let [config (:config component)]
      (assoc component :conn
             (setup-and-connect-to-database config))
      component))

  (stop [component]
    (println "Comic-Reader: Disconnecting from database...")
    (dissoc component :conn)))

(defn database? [e]
  (instance? Database e))

(defn new-database []
  (map->Database {}))

(defn get-conn [database]
  (or (:conn database)
      (when-let [config (:config database)]
        (setup-and-connect-to-database config))))

(ns comic-reader.database
  (:require [com.stuartsierra.component :as component]
            [comic-reader.config :as config]
            [comic-reader.database.norms :as norms]
            [datomic.api :as d]
            [io.rkn.conformity :as conformity]))

(defn- create-database [config]
  (d/create-database (config/database-uri config)))

(defn- connect [config]
  (d/connect (config/database-uri config)))

(defn- setup-and-connect-to-database [config]
  (when (config/database-uri config)
    (println "Comic-Reader: Connecting to database...")
    (let [do-seeds? (create-database config)
          conn (connect config)]
      ;; Conform database to schemas here
      (when-let [norms-dir (config/norms-dir config)]
        (println "Comic-Reader: Conforming database to norms...")
        (conformity/ensure-conforms conn (norms/norms-map norms-dir)))

      ;; Add seeds if database was newly created
      ;; (when do-seeds?
      ;;   @(d/transact conn (seed/data)))
      conn)))

(defprotocol Database
  (get-conn [database] "Return the connection to the database."))

(defrecord DatomicDatabase [config conn]

  component/Lifecycle

  (start [component]
    (if-let [config (:config component)]
      (assoc component :conn
             (setup-and-connect-to-database config))
      component))

  (stop [component]
    (println "Comic-Reader: Disconnecting from database...")
    (dissoc component :conn))

  Database
  (get-conn [database] (:conn database)))

(defn database? [e]
  (instance? Database e))

(defn new-database []
  (map->DatomicDatabase {}))

Improve the database component

Improve the database component

Add a database protocol with the get-conn method on it.


(ns nightcode.editors
  (:require [clojure.java.io :as java.io]
            [nightcode.lein :as lein]
            [nightcode.shortcuts :as shortcuts]
            [nightcode.utils :as utils]
            [paredit-widget.core :as paredit]
            [seesaw.color :as color]
            [seesaw.core :as s])
  (:import [com.camick TextPrompt]
           [javax.swing.event DocumentListener]
           [org.fife.ui.rsyntaxtextarea
            FileLocation SyntaxConstants TextEditorPane Theme]
           [org.fife.ui.rtextarea RTextScrollPane SearchContext SearchEngine]))

; dealing with currently-open editors

(def editors (atom {}))
(def font-size (atom (utils/read-pref :font-size)))
(def disable-paredit? (utils/read-pref :disable-paredit))

(defn get-editor
  [path]
  (when (contains? @editors path)
    (->> [:<org.fife.ui.rsyntaxtextarea.TextEditorPane>]
         (s/select (get @editors path))
         first)))

(defn get-selected-editor
  []
  (get-editor (utils/get-selected-path)))

(defn get-selected-editor-pane
  []
  (get @editors (utils/get-selected-path)))

(defn is-unsaved?
  [path]
  (when-let [editor (get-editor path)]
    (.isDirty editor)))

(defn get-editor-text
  []
  (when-let [editor (get-selected-editor)]
    (.getText editor)))

(defn get-editor-selected-text
  []
  (when-let [editor (get-selected-editor)]
    (.getSelectedText editor)))

; actions for editor buttons

(defn update-buttons
  [pane editor]
  (-> (s/select pane [:#save-button])
      (s/config! :enabled? (.isDirty editor)))
  (-> (s/select pane [:#undo-button])
      (s/config! :enabled? (.canUndo editor)))
  (-> (s/select pane [:#redo-button])
      (s/config! :enabled? (.canRedo editor))))

(defn save-file
  [e]
  (when-let [editor (get-selected-editor)]
    (with-open [w (java.io/writer (java.io/file (utils/get-selected-path)))]
      (.write editor w))
    (.setDirty editor false)
    (s/request-focus! editor)
    (update-buttons (get-selected-editor-pane) editor)))

(defn undo-file
  [e]
  (when-let [editor (get-selected-editor)]
    (.undoLastAction editor)
    (update-buttons (get-selected-editor-pane) editor)))

(defn redo-file
  [e]
  (when-let [editor (get-selected-editor)]
    (.redoLastAction editor)
    (update-buttons (get-selected-editor-pane) editor)))

(defn set-font-size
  [editor size]
  (.setFont editor (-> editor .getFont (.deriveFont (float size)))))

(defn set-font-sizes
  [size]
  (when-let [selected-editor (get-selected-editor)]
    (doseq [[path editor-pane] @editors]
      (when-let [editor (get-editor path)]
        (set-font-size editor size)))))

(add-watch font-size :set-size (fn [_ _ _ x] (set-font-sizes x)))

(defn save-font-size
  [size]
  (utils/write-pref :font-size size))

(add-watch font-size :save-size (fn [_ _ _ x] (save-font-size x)))

(defn increase-font-size
  [_]
  (swap! font-size inc))

(defn decrease-font-size
  [_]
  (swap! font-size dec))

(defn focus-on-find
  [e]
  (when-let [pane (get-selected-editor-pane)]
    (doto (s/select pane [:#find-field])
      s/request-focus!
      .selectAll)))

(defn close-file
  [e])

(defn search
  [e]
  (when-let [editor (get-selected-editor)]
    (let [is-enter-key? (= (.getKeyCode e) 10)
          context (SearchContext. (s/text e))]
      (when-not is-enter-key?
        (.setCaretPosition editor 0))
      (when (and is-enter-key? (.isShiftDown e))
        (.setSearchForward context false))
      (if (or (SearchEngine/find editor context)
              (= (count (s/text e)) 0))
        (s/config! e :background nil)
        (s/config! e :background (color/color :red))))))

; create and show editors for each file

(def ^:const styles {"clj" SyntaxConstants/SYNTAX_STYLE_CLOJURE
                     "cljs" SyntaxConstants/SYNTAX_STYLE_CLOJURE
                     "js" SyntaxConstants/SYNTAX_STYLE_JAVASCRIPT
                     "java" SyntaxConstants/SYNTAX_STYLE_JAVA
                     "xml" SyntaxConstants/SYNTAX_STYLE_XML
                     "html" SyntaxConstants/SYNTAX_STYLE_HTML
                     "htm" SyntaxConstants/SYNTAX_STYLE_HTML
                     "css" SyntaxConstants/SYNTAX_STYLE_CSS
                     "json" SyntaxConstants/SYNTAX_STYLE_NONE
                     "md" SyntaxConstants/SYNTAX_STYLE_NONE
                     "txt" SyntaxConstants/SYNTAX_STYLE_NONE})
(def ^:const paredit-exts #{"clj" "cljs"})

(defn get-extension
  [path]
  (->> (.lastIndexOf path ".")
       (+ 1)
       (subs path)
       clojure.string/lower-case))

(defn get-syntax-style
  [path]
  (or (get styles (get-extension path))
      SyntaxConstants/SYNTAX_STYLE_NONE))

(defn create-editor
  [path]
  (when (and (.isFile (java.io/file path))
             (contains? styles (get-extension path)))
    (let [text-area (if (and (not disable-paredit?)
                             (contains? paredit-exts (get-extension path)))
                      (paredit/paredit-widget (TextEditorPane.))
                      (TextEditorPane.))
          text-area-scroll (RTextScrollPane. text-area)
          btn-group (utils/wrap-panel
                      :items [(s/button :id :save-button
                                        :text (utils/get-string :save)
                                        :focusable? false
                                        :listen [:action save-file])
                              (s/button :id :undo-button
                                        :text (utils/get-string :undo)
                                        :focusable? false
                                        :listen [:action undo-file])
                              (s/button :id :redo-button
                                        :text (utils/get-string :redo)
                                        :focusable? false
                                        :listen [:action redo-file])
                              (s/button :id :font-dec-button
                                        :text (utils/get-string :font_dec)
                                        :focusable? false
                                        :listen [:action decrease-font-size])
                              (s/button :id :font-enc-button
                                        :text (utils/get-string :font_inc)
                                        :focusable? false
                                        :listen [:action increase-font-size])
                              (s/text :id :find-field
                                      :columns 10
                                      :listen [:key-released search])])
          text-group (s/border-panel
                       :north btn-group
                       :center text-area-scroll)]
      (shortcuts/create-mappings text-group
                                 {:save-button save-file
                                  :undo-button undo-file
                                  :redo-button redo-file
                                  :find-field focus-on-find
                                  :font-enc-button increase-font-size
                                  :font-dec-button decrease-font-size})
      (shortcuts/create-hints text-group)
      (update-buttons text-group text-area)
      (doto (TextPrompt. (utils/get-string :find)
                         (s/select text-group [:#find-field]))
        (.changeAlpha 0.5))
      (.load text-area (FileLocation/create path) nil)
      (.discardAllEdits text-area)
      (.setAntiAliasingEnabled text-area true)
      (s/listen text-area
                :key-released
                (fn [e] (update-buttons text-group text-area)))
      (.addDocumentListener (.getDocument text-area)
                            (reify DocumentListener
                              (changedUpdate [this e]
                                (update-buttons text-group text-area))
                              (insertUpdate [this e]
                                (update-buttons text-group text-area))
                              (removeUpdate [this e]
                                (update-buttons text-group text-area))))
      (.setSyntaxEditingStyle text-area (get-syntax-style path))
      (-> (java.io/resource "dark.xml")
          java.io/input-stream
          Theme/load
          (.apply text-area))
      (if @font-size
        (set-font-size text-area @font-size)
        (reset! font-size (-> text-area .getFont .getSize)))
      text-group)))

(defn create-logcat
  [path]
  (when (= (.getName (java.io/file path)) "*LogCat*")
    (let [console (utils/create-console)
          process (atom nil)
          thread (atom nil)
          in (utils/get-console-input console)
          out (utils/get-console-output console)
          toggle-btn (s/button :id :toggle-logcat-button
                               :text (utils/get-string :start))
          btn-group (s/horizontal-panel :items [toggle-btn])
          start (fn []
                  (->> (.getParent (java.io/file path))
                       (lein/run-logcat process thread in out))
                  (s/config! toggle-btn :text (utils/get-string :stop)))
          stop (fn []
                 (lein/stop-process process)
                 (lein/stop-thread thread)
                 (s/config! toggle-btn :text (utils/get-string :start)))
          toggle (fn [e]
                   (if (nil? @process) (start) (stop)))]
      (s/listen toggle-btn :action toggle)
      (shortcuts/create-mappings btn-group {:toggle-logcat-button toggle})
      (shortcuts/create-hints btn-group)
      (s/border-panel :north btn-group
                      :center console))))

(defn show-editor
  [path]
  (let [editor-pane (s/select @utils/ui-root [:#editor-pane])]
    ; create new editor if necessary
    (when (and path (not (contains? @editors path)))
      (when-let [view (or (create-editor path)
                          (create-logcat path))]
        (swap! editors assoc path view)
        (.add editor-pane view path)))
    ; display the correct card
    (s/show-card! editor-pane (if (contains? @editors path) path :default-card))
    ; give the editor focus if it exists
    (when-let [editor (get-editor path)]
      (s/request-focus! editor))))

(ns nightcode.editors
  (:require [clojure.java.io :as java.io]
            [nightcode.lein :as lein]
            [nightcode.shortcuts :as shortcuts]
            [nightcode.utils :as utils]
            [paredit-widget.core :as paredit]
            [seesaw.color :as color]
            [seesaw.core :as s])
  (:import [com.camick TextPrompt]
           [javax.swing.event DocumentListener]
           [org.fife.ui.rsyntaxtextarea
            FileLocation SyntaxConstants TextEditorPane Theme]
           [org.fife.ui.rtextarea RTextScrollPane SearchContext SearchEngine]))

; dealing with currently-open editors

(def editors (atom {}))
(def font-size (atom (utils/read-pref :font-size)))

(defn get-editor
  [path]
  (when (contains? @editors path)
    (->> [:<org.fife.ui.rsyntaxtextarea.TextEditorPane>]
         (s/select (get @editors path))
         first)))

(defn get-selected-editor
  []
  (get-editor (utils/get-selected-path)))

(defn get-selected-editor-pane
  []
  (get @editors (utils/get-selected-path)))

(defn is-unsaved?
  [path]
  (when-let [editor (get-editor path)]
    (.isDirty editor)))

(defn get-editor-text
  []
  (when-let [editor (get-selected-editor)]
    (.getText editor)))

(defn get-editor-selected-text
  []
  (when-let [editor (get-selected-editor)]
    (.getSelectedText editor)))

; actions for editor buttons

(defn update-buttons
  [pane editor]
  (-> (s/select pane [:#save-button])
      (s/config! :enabled? (.isDirty editor)))
  (-> (s/select pane [:#undo-button])
      (s/config! :enabled? (.canUndo editor)))
  (-> (s/select pane [:#redo-button])
      (s/config! :enabled? (.canRedo editor))))

(defn save-file
  [e]
  (when-let [editor (get-selected-editor)]
    (with-open [w (java.io/writer (java.io/file (utils/get-selected-path)))]
      (.write editor w))
    (.setDirty editor false)
    (s/request-focus! editor)
    (update-buttons (get-selected-editor-pane) editor)))

(defn undo-file
  [e]
  (when-let [editor (get-selected-editor)]
    (.undoLastAction editor)
    (update-buttons (get-selected-editor-pane) editor)))

(defn redo-file
  [e]
  (when-let [editor (get-selected-editor)]
    (.redoLastAction editor)
    (update-buttons (get-selected-editor-pane) editor)))

(defn set-font-size
  [editor size]
  (.setFont editor (-> editor .getFont (.deriveFont (float size)))))

(defn set-font-sizes
  [size]
  (when-let [selected-editor (get-selected-editor)]
    (doseq [[path editor-pane] @editors]
      (when-let [editor (get-editor path)]
        (set-font-size editor size)))))

(add-watch font-size :set-size (fn [_ _ _ x] (set-font-sizes x)))

(defn save-font-size
  [size]
  (utils/write-pref :font-size size))

(add-watch font-size :save-size (fn [_ _ _ x] (save-font-size x)))

(defn increase-font-size
  [_]
  (swap! font-size inc))

(defn decrease-font-size
  [_]
  (swap! font-size dec))

(defn focus-on-find
  [e]
  (when-let [pane (get-selected-editor-pane)]
    (doto (s/select pane [:#find-field])
      s/request-focus!
      .selectAll)))

(defn close-file
  [e])

(defn search
  [e]
  (when-let [editor (get-selected-editor)]
    (let [is-enter-key? (= (.getKeyCode e) 10)
          context (SearchContext. (s/text e))]
      (when-not is-enter-key?
        (.setCaretPosition editor 0))
      (when (and is-enter-key? (.isShiftDown e))
        (.setSearchForward context false))
      (if (or (SearchEngine/find editor context)
              (= (count (s/text e)) 0))
        (s/config! e :background nil)
        (s/config! e :background (color/color :red))))))

; create and show editors for each file

(def ^:const styles {"clj" SyntaxConstants/SYNTAX_STYLE_CLOJURE
                     "cljs" SyntaxConstants/SYNTAX_STYLE_CLOJURE
                     "js" SyntaxConstants/SYNTAX_STYLE_JAVASCRIPT
                     "java" SyntaxConstants/SYNTAX_STYLE_JAVA
                     "xml" SyntaxConstants/SYNTAX_STYLE_XML
                     "html" SyntaxConstants/SYNTAX_STYLE_HTML
                     "htm" SyntaxConstants/SYNTAX_STYLE_HTML
                     "css" SyntaxConstants/SYNTAX_STYLE_CSS
                     "json" SyntaxConstants/SYNTAX_STYLE_NONE
                     "md" SyntaxConstants/SYNTAX_STYLE_NONE
                     "txt" SyntaxConstants/SYNTAX_STYLE_NONE})
(def ^:const paredit-exts #{"clj" "cljs"})

(defn get-extension
  [path]
  (->> (.lastIndexOf path ".")
       (+ 1)
       (subs path)
       clojure.string/lower-case))

(defn get-syntax-style
  [path]
  (or (get styles (get-extension path))
      SyntaxConstants/SYNTAX_STYLE_NONE))

(defn create-editor
  [path]
  (when (and (.isFile (java.io/file path))
             (contains? styles (get-extension path)))
    (let [text-area (if (contains? paredit-exts (get-extension path))
                      (paredit/paredit-widget (TextEditorPane.))
                      (TextEditorPane.))
          text-area-scroll (RTextScrollPane. text-area)
          btn-group (utils/wrap-panel
                      :items [(s/button :id :save-button
                                        :text (utils/get-string :save)
                                        :focusable? false
                                        :listen [:action save-file])
                              (s/button :id :undo-button
                                        :text (utils/get-string :undo)
                                        :focusable? false
                                        :listen [:action undo-file])
                              (s/button :id :redo-button
                                        :text (utils/get-string :redo)
                                        :focusable? false
                                        :listen [:action redo-file])
                              (s/button :id :font-dec-button
                                        :text (utils/get-string :font_dec)
                                        :focusable? false
                                        :listen [:action decrease-font-size])
                              (s/button :id :font-enc-button
                                        :text (utils/get-string :font_inc)
                                        :focusable? false
                                        :listen [:action increase-font-size])
                              (s/text :id :find-field
                                      :columns 10
                                      :listen [:key-released search])])
          text-group (s/border-panel
                       :north btn-group
                       :center text-area-scroll)]
      (shortcuts/create-mappings text-group
                                 {:save-button save-file
                                  :undo-button undo-file
                                  :redo-button redo-file
                                  :find-field focus-on-find
                                  :font-enc-button increase-font-size
                                  :font-dec-button decrease-font-size})
      (shortcuts/create-hints text-group)
      (update-buttons text-group text-area)
      (doto (TextPrompt. (utils/get-string :find)
                         (s/select text-group [:#find-field]))
        (.changeAlpha 0.5))
      (.load text-area (FileLocation/create path) nil)
      (.discardAllEdits text-area)
      (.setAntiAliasingEnabled text-area true)
      (s/listen text-area
                :key-released
                (fn [e] (update-buttons text-group text-area)))
      (.addDocumentListener (.getDocument text-area)
                            (reify DocumentListener
                              (changedUpdate [this e]
                                (update-buttons text-group text-area))
                              (insertUpdate [this e]
                                (update-buttons text-group text-area))
                              (removeUpdate [this e]
                                (update-buttons text-group text-area))))
      (.setSyntaxEditingStyle text-area (get-syntax-style path))
      (-> (java.io/resource "dark.xml")
          java.io/input-stream
          Theme/load
          (.apply text-area))
      (if @font-size
        (set-font-size text-area @font-size)
        (reset! font-size (-> text-area .getFont .getSize)))
      text-group)))

(defn create-logcat
  [path]
  (when (= (.getName (java.io/file path)) "*LogCat*")
    (let [console (utils/create-console)
          process (atom nil)
          thread (atom nil)
          in (utils/get-console-input console)
          out (utils/get-console-output console)
          toggle-btn (s/button :id :toggle-logcat-button
                               :text (utils/get-string :start))
          btn-group (s/horizontal-panel :items [toggle-btn])
          start (fn []
                  (->> (.getParent (java.io/file path))
                       (lein/run-logcat process thread in out))
                  (s/config! toggle-btn :text (utils/get-string :stop)))
          stop (fn []
                 (lein/stop-process process)
                 (lein/stop-thread thread)
                 (s/config! toggle-btn :text (utils/get-string :start)))
          toggle (fn [e]
                   (if (nil? @process) (start) (stop)))]
      (s/listen toggle-btn :action toggle)
      (shortcuts/create-mappings btn-group {:toggle-logcat-button toggle})
      (shortcuts/create-hints btn-group)
      (s/border-panel :north btn-group
                      :center console))))

(defn show-editor
  [path]
  (let [editor-pane (s/select @utils/ui-root [:#editor-pane])]
    ; create new editor if necessary
    (when (and path (not (contains? @editors path)))
      (when-let [view (or (create-editor path)
                          (create-logcat path))]
        (swap! editors assoc path view)
        (.add editor-pane view path)))
    ; display the correct card
    (s/show-card! editor-pane (if (contains? @editors path) path :default-card))
    ; give the editor focus if it exists
    (when-let [editor (get-editor path)]
      (s/request-focus! editor))))

Remove paredit pref for now

Remove paredit pref for now


(ns frontend.components.pages.run
  (:require [compassus.core :as compassus]
            [frontend.components.common :as common]
            [frontend.components.pieces.job :as job]
            [frontend.components.pieces.map :as map]
            [frontend.components.pieces.run-row :as run-row]
            [frontend.components.templates.main :as main-template]
            [frontend.models.feature :as feature]
            [frontend.utils :refer-macros [component element html]]
            [goog.string :as gstring]
            [loom.graph :as g]
            [om.next :as om-next :refer-macros [defui]]))

(defn job-cards-row
  "A set of cards to layout together"
  [cards]
   (component
     (html
       [:div
        (for [card cards]
          ;; Reuse the card's key. Thus, if each card is built with a unique key,
          ;; each .item will be built with a unique key.
          [:.item (when-let [react-key (and card (.-key card))]
                    {:key react-key})
           card])])))

(defui ^:once Page
  static om-next/IQuery
  (query [this]
    ['{:legacy/state [*]}
     {:app/route-params [:route-params/tab :route-params/container-id]}
     `{:routed/run
       [:run/id
        {:run/project [:project/name
                       {:project/organization [:organization/vcs-type
                                               :organization/name]}]}
        {:run/trigger-info [:trigger-info/branch]}
        {:run/errors [:workflow-error/message]}
        {:run/jobs [:job/name
                    {:job/required-jobs [:job/name]}]}
        :error/type]}
     `{(:run-for-row {:< :routed/run})
       ~(om-next/get-query run-row/RunRow)}
     `{(:run-for-jobs {:< :routed/run})
       [{:run/jobs ~(om-next/get-query job/Job)}]}
     {:routed/job [:job/name
                   {:job/build [:build/vcs-type
                                :build/org
                                :build/repo
                                :build/number]}]}])
  ;; TODO: Add the correct analytics properties.
  #_analytics/Properties
  #_(properties [this]
      (let [props (om-next/props this)]
        {:user (get-in props [:circleci/viewer :user/login])
         :view :projects
         :org (get-in props [:app/route-data :route-data/organization :organization/name])}))
  Object
  ;; TODO: Title this page.
  #_(componentDidMount [this]
      (set-page-title! "Projects"))
  (componentWillUpdate [this next-props _next-state]
    (when (= :error/not-found (get-in next-props [:routed/run :error/type]))
      (compassus/set-route! this :route/not-found)))
  (render [this]
    (let [{{project-name :project/name
            {org-name :organization/name
             vcs-type :organization/vcs-type} :project/organization} :run/project
           {branch-name :trigger-info/branch} :run/trigger-info
           id :run/id
           errors :run/errors}
          (:routed/run (om-next/props this))]
      (component
       (main-template/template
        {:app (:legacy/state (om-next/props this))
         :crumbs [{:type :workflows}
                  {:type :org-workflows
                   :username org-name
                   :vcs_type vcs-type}
                  {:type :project-workflows
                   :username org-name
                   :project project-name
                   :vcs_type vcs-type}
                  {:type :branch-workflows
                   :username org-name
                   :project project-name
                   :vcs_type vcs-type
                   :branch branch-name}
                  {:type :workflow-run
                   :run/id id}]
         :main-content
         (element :main-content
                  (let [run (:run-for-row (om-next/props this))
                        jobs (-> this
                                 om-next/props
                                 :run-for-jobs
                                 :run/jobs)]
                    (html
                     [:div
                      ;; We get the :run/id for free in the route params, so even
                      ;; before the run has loaded, we'll have the :run/id here. So
                      ;; dissoc that and see if we have anything else; when we do, we
                      ;; should have enough to render it.
                      (when-not (empty? (dissoc run :run/id))
                        (run-row/run-row run))

                      (if (seq errors)
                        [:div.alert.alert-warning.iconified
                         [:div [:img.alert-icon {:src (common/icon-path "Info-Warning")}]]
                         [:div
                          [:div "We weren't able to start this workflow."]
                          (for [{:keys [workflow-error/message]} errors]
                            [:div message])
                          [:div
                           [:span "For more examples see the "]
                           [:a {:href "/docs/2.0/workflows"}
                            "Workflows documentation"]
                           [:span "."]]]]
                        [:.jobs
                         [:div.jobs-header
                          [:.hr-title
                           [:span (gstring/format "%s jobs in this workflow" (count jobs))]]]
                         (job-cards-row
                          (map job/job jobs))
                         (if (feature/enabled? :workflow-map)
                           (let [jobs (-> this
                                          om-next/props
                                          :routed-entity/run
                                          :run/jobs)
                                 nodes (map :job/name jobs)
                                 edges (for [job jobs
                                             required (:job/required-jobs job)]
                                         [(:job/name required)
                                          (:job/name job)])
                                 graph (-> (g/digraph)
                                           (g/add-nodes* nodes)
                                           (g/add-edges* edges))
                                 config {:box-width 150
                                         :box-height 40
                                         :x-spacing 100
                                         :y-spacing 10
                                         :strut-spacing 20
                                         :arrow-radius 10}]
                             (map/map-svg config graph)))])])))})))))

(ns frontend.components.pages.run
  (:require [compassus.core :as compassus]
            [frontend.components.common :as common]
            [frontend.components.pieces.job :as job]
            [frontend.components.pieces.map :as map]
            [frontend.components.pieces.run-row :as run-row]
            [frontend.components.templates.main :as main-template]
            [frontend.models.feature :as feature]
            [frontend.utils :refer-macros [component element html]]
            [goog.string :as gstring]
            [loom.graph :as g]
            [om.next :as om-next :refer-macros [defui]]))

(defn job-cards-row
  "A set of cards to layout together"
  [cards]
   (component
     (html
       [:div
        (for [card cards]
          ;; Reuse the card's key. Thus, if each card is built with a unique key,
          ;; each .item will be built with a unique key.
          [:.item (when-let [react-key (and card (.-key card))]
                    {:key react-key})
           card])])))

(defui ^:once Page
  static om-next/IQuery
  (query [this]
    ['{:legacy/state [*]}
     {:app/route-params [:route-params/tab :route-params/container-id]}
     `{:routed/run
       [:run/id
        {:run/project [:project/name
                       {:project/organization [:organization/vcs-type
                                               :organization/name]}]}
        {:run/trigger-info [:trigger-info/branch]}
        {:run/errors [:workflow-error/message]}
        {:run/jobs [:job/name
                    {:job/required-jobs [:job/name]}]}
        :error/type]}
     `{(:run-for-row {:< :routed/run})
       ~(om-next/get-query run-row/RunRow)}
     `{(:run-for-jobs {:< :routed/run})
       [{:run/jobs ~(om-next/get-query job/Job)}]}
     {:routed/job [:job/name
                   {:job/build [:build/vcs-type
                                :build/org
                                :build/repo
                                :build/number]}]}])
  ;; TODO: Add the correct analytics properties.
  #_analytics/Properties
  #_(properties [this]
      (let [props (om-next/props this)]
        {:user (get-in props [:circleci/viewer :user/login])
         :view :projects
         :org (get-in props [:app/route-data :route-data/organization :organization/name])}))
  Object
  ;; TODO: Title this page.
  #_(componentDidMount [this]
      (set-page-title! "Projects"))
  (componentWillUpdate [this next-props _next-state]
    (when (= :error/not-found (get-in next-props [:routed/run :error/type]))
      (compassus/set-route! this :route/not-found)))
  (render [this]
    (let [{{project-name :project/name
            {org-name :organization/name
             vcs-type :organization/vcs-type} :project/organization} :run/project
           {branch-name :trigger-info/branch} :run/trigger-info
           id :run/id
           errors :run/errors}
          (:routed/run (om-next/props this))]
      (component
       (main-template/template
        {:app (:legacy/state (om-next/props this))
         :crumbs [{:type :workflows}
                  {:type :org-workflows
                   :username org-name
                   :vcs_type vcs-type}
                  {:type :project-workflows
                   :username org-name
                   :project project-name
                   :vcs_type vcs-type}
                  {:type :branch-workflows
                   :username org-name
                   :project project-name
                   :vcs_type vcs-type
                   :branch branch-name}
                  {:type :workflow-run
                   :run/id id}]
         :main-content
         (element :main-content
                  (let [run (:run-for-row (om-next/props this))
                        jobs (-> this
                                 om-next/props
                                 :run-for-jobs
                                 :run/jobs)]
                    (html
                     [:div
                      ;; We get the :run/id for free in the route params, so even
                      ;; before the run has loaded, we'll have the :run/id here. So
                      ;; dissoc that and see if we have anything else; when we do, we
                      ;; should have enough to render it.
                      (when-not (empty? (dissoc run :run/id))
                        (run-row/run-row run))

                      (if (seq errors)
                        [:div.alert.alert-warning.iconified
                         [:div [:img.alert-icon {:src (common/icon-path "Info-Warning")}]]
                         [:div
                          [:div "We weren't able to start this workflow."]
                          (for [{:keys [workflow-error/message]} errors]
                            [:div message])
                          [:div
                           [:span "For more examples see the "]
                           [:a {:href "/docs/2.0/workflows"}
                            "Workflows documentation"]
                           [:span "."]]]]
                        [:.jobs
                         [:div.jobs-header
                          [:.hr-title
                           [:span (gstring/format "%s jobs in this workflow" (count jobs))]]]
                         (job-cards-row
                          (map job/job jobs))
                         (if (feature/enabled? :workflow-map)
                           (let [jobs (-> this
                                          om-next/props
                                          :routed/run
                                          :run/jobs)
                                 nodes (map :job/name jobs)
                                 edges (for [job jobs
                                             required (:job/required-jobs job)]
                                         [(:job/name required)
                                          (:job/name job)])
                                 graph (-> (g/digraph)
                                           (g/add-nodes* nodes)
                                           (g/add-edges* edges))
                                 config {:box-width 150
                                         :box-height 40
                                         :x-spacing 100
                                         :y-spacing 10
                                         :strut-spacing 20
                                         :arrow-radius 10}]
                             (map/map-svg config graph)))])])))})))))

Fix workflow map

Fix workflow map

I goozled myself.


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "DSL for processing data"}
  dsbdp.data-processing-dsl
  (:require [dsbdp.byte-array-conversion :refer :all]))

(defn create-data-processing-sub-fn
  [data-processing-definition input offset]
  (into
    '()
    (reverse
      (reduce
        (fn [v data-proc-def-element]
          (cond
            (symbol? data-proc-def-element) (let [s data-proc-def-element]
                                              (condp not= nil
                                                (ns-resolve 'clojure.core s)
                                                  (conj v (ns-resolve 'clojure.core s))
                                                (ns-resolve 'dsbdp.byte-array-conversion s)
                                                  (conj v (ns-resolve 'dsbdp.byte-array-conversion s) 'input)
                                                (do
                                                  (println "Could not resolve symbol:" s)
                                                   v)))
            (list? data-proc-def-element) (conj v (into '() (reverse (create-data-processing-sub-fn data-proc-def-element input offset))))
            :default (conj v data-proc-def-element)))
        [] data-processing-definition))))

;;; TODO: This function only supports byte array based functions yet.
;;; This will become problematic once other input data types,
;;; such as vectors or maps shall be processed to, e.g., CSV string format.
(defn get-data-processing-sub-fn-ret-type
  "Get the return type of a data processing sub-function data-proc-sub-fn.
   For determining the type, this function calls data-proc-sub-fn with a 1530 byte dummy byte-array filled with 0."
  [data-proc-sub-fn]
  (let [dummy-ba (byte-array 1530 (byte 0))
        ret (data-proc-sub-fn dummy-ba 0)]
    (type ret)))

(defn create-data-processing-fn-body-for-java-map-output-type
  "Create a data processing function body for emitting data into a Java map."
  [input offset rules]
  (reduce
    (fn [v rule]
      (conj v `(.put
                ~(name (first rule))
                ~(create-data-processing-sub-fn (second rule) input offset))))
    '[doto (java.util.HashMap.)] rules))

(defn create-data-processing-fn-body-for-clj-map-output-type
  "Create a data processing function body for emitting data into a Clojure map."
  [input offset rules]
  (reduce
    (fn [v rule]
      (conj v `(assoc
                 ~(name (first rule))
                 ~(create-data-processing-sub-fn (second rule) input offset))))
    '[-> {}] rules))

(defn create-data-processing-fn-body-for-csv-str-output-type
  "Create a data processing function body for emitting data into a CSV string."
  [input offset rules]
  (let [extracted-strings (reduce
                            (fn [v rule]
                              (let [data-proc-sub-fn (create-data-processing-sub-fn (second rule) input offset)
                                    data-proc-sub-fn-ret-type (get-data-processing-sub-fn-ret-type (eval `(fn [~input ~offset] ~data-proc-sub-fn)))]
                                (conj v (if (= java.lang.String data-proc-sub-fn-ret-type)
                                          `(str "\"" ~data-proc-sub-fn "\"")
                                          data-proc-sub-fn))))
                            '[str] rules)
        commas (reduce into [] ["." (repeat (- (count rules) 1) ",") "."])]
    (vec (filter #(not= \. %) (interleave extracted-strings commas)))))

(defn create-data-processing-fn-body-for-json-str-output-type
  "Create a data processing function body for emitting data into a JSON string."
  [input offset rules]
  (let [extracted-strings (conj
                            (reduce
                              (fn [v rule]
                                (let [data-proc-sub-fn (create-data-processing-sub-fn (second rule) input offset)
                                      data-proc-sub-fn-ret-type (get-data-processing-sub-fn-ret-type (eval `(fn [~input ~offset] ~data-proc-sub-fn)))]
                                  (conj v "\"" (name (first rule)) "\":"
                                          (if (= java.lang.String data-proc-sub-fn-ret-type)
                                            `(str "\"" ~data-proc-sub-fn "\"")
                                            data-proc-sub-fn))))
                              '[str "{"] rules)
                            "}")
        commas (reduce into [] ["." "." "." "." "." (reduce into [] (repeat (- (count rules) 1) ["," "." "." "."])) "." "."])]
;    (println (interleave extracted-strings commas))
    (vec (filter (fn [x] (and (not= \. x) (not= "." x))) (interleave extracted-strings commas)))))

(defn create-data-processing-fn
  "Create a data processing function based on the given dsl-expression."
  [dsl-expression]
;  (println "Got DSL expression:" dsl-expression)
  (let [input-sym 'input
        offset-sym 'offset
        fn-body-vec (let [output-type (:output-type dsl-expression)
                          rules (:rules dsl-expression)]
                      (condp = (name output-type)
                        "java-map" (create-data-processing-fn-body-for-java-map-output-type input-sym offset-sym rules)
                        "clj-map" (create-data-processing-fn-body-for-clj-map-output-type input-sym offset-sym rules)
                        "csv-str" (create-data-processing-fn-body-for-csv-str-output-type input-sym offset-sym rules)
                        "json-str" (create-data-processing-fn-body-for-json-str-output-type input-sym offset-sym rules)
                        (do
                          (println "Unknown output type:" output-type)
                          (println "Defaulting to :java-maps as output type.")
                          (create-data-processing-fn-body-for-java-map-output-type input-sym offset-sym rules))))
;        _ (println "Created data processing function vector from DSL:" fn-body-vec)
        fn-body (reverse (into '() fn-body-vec))
;        _ (println "Created data processing function body:" fn-body)
        data-processing-fn (eval `(fn [~input-sym ~offset-sym] ~fn-body))]
    data-processing-fn))

Improve indentation.

Improve indentation.


(ns blocks.store.file
  "Block storage backed by files in nested directories. Each block is stored in
  a separate file.

  In many filesystems, directories are limited to 4,096 entries. In order to
  avoid this limit (and make navigating the blocks a bit more efficient), block
  content is stored in nested directories three levels deep. All path elements
  are lower-case hex-encoded bytes from the multihash.

  The first level is the two-byte multihash prefix, which designates the
  algorithm and digest length. There will usually only be one or two of these
  directories. The second and third levels are formed by the first two bytes of
  the hash digest. Finally, the block is stored in a file containing the rest of
  the digest.

  Thus, a block containing the content `foobar` would have the sha1 digest
  `97df3501149...` and be stored under the root directory at:

  `root/1114/97/df/35011497df3588b5a3...`

  Using this scheme, leaf directories should start approaching the limit once the
  user has 2^28 entries, or about 268 million blocks."
  (:require
    [blocks.core :as block]
    [blocks.data :as data]
    [clojure.java.io :as io]
    [clojure.string :as str]
    [multihash.core :as multihash])
  (:import
    java.io.File
    java.util.Date))

;; ## File System Utilities

(defn- seek-marker
  "Given a marker string, determine whether the file should be skipped, recursed
  into with a substring, or listed in full. Returs nil if the file should be
  skipped, otherwise a vector of the file and a marker to recurse with."
  [marker ^File file]
  (if (empty? marker)
    [file nil]
    (let [fname (.getName file)
          len (min (count marker) (count fname))
          cmp (compare (subs fname  0 len)
                       (subs marker 0 len))]
      (if-not (neg? cmp)
        (if (zero? cmp)
          [file (subs marker len)]
          [file nil])))))

(defn- find-files
  "Walks a directory tree depth first, returning a sequence of files found in
  lexical order. Intelligently skips directories based on the given marker."
  [^File file marker]
  (if (.isDirectory file)
    (->> (.listFiles file)
         (filter #(re-matches #"^[0-9a-f]+$" (.getName ^File %)))
         (keep (partial seek-marker marker))
         (sort-by first)
         (keep (partial apply find-files))
         (flatten))
    (when (.isFile file)
      [file])))

(defn- rm-r
  "Recursively removes a directory of files."
  [^File path]
  (when (.isDirectory path)
    (dorun (map rm-r (.listFiles path))))
  (.delete path))

;; ## File Block Functions

(defn- file-stats
  "Calculates storage stats for a block file."
  [^File file]
  {:stored-at (Date. (.lastModified file))
   :source (.toURI file)})

(defn- block-stats
  "Calculates a merged stat map for a block."
  [id ^File file]
  (merge (file-stats file)
         {:id id, :size (.length file)}))

(defn- id->file
  "Determines the filesystem path for a block of content with the given hash
  identifier."
  ^java.io.File
  [root id]
  (let [hex (multihash/hex id)]
    (io/file
      root
      (subs hex 0 4)
      (subs hex 4 6)
      (subs hex 6 8)
      (subs hex 8))))

(defn- file->id
  "Reconstructs the hash identifier represented by the given file path."
  [root file]
  (let [root (str root)
        path (str file)]
    (when-not (.startsWith path root)
      (throw (IllegalStateException.
               (str "File " path " is not a child of root directory " root))))
    (-> path
        (subs (inc (count root)))
        (str/replace "/" "")
        (multihash/decode))))

(defn- file->block
  "Creates a lazy block to read from the given file."
  [id ^File file]
  (block/with-stats
    (data/lazy-block
      id (.length file)
      (fn file-reader [] (io/input-stream file)))
    (file-stats file)))

(defmacro ^:private when-block
  "An anaphoric macro which binds the block file to `file` and executes `body`
  only if it exists. Assumes that the root directory is bound to `root`."
  [id & body]
  `(let [~(with-meta 'file {:tag 'java.io.File})
         (id->file ~'root ~id)]
     (when (.exists ~'file)
       ~@body)))

;; ## File Store

; TODO: File store operations should really be thread-safe

;; Block content is stored as files in a multi-level hierarchy under the given
;; root directory.
(defrecord FileBlockStore
  [^File root]

  block/BlockStore

  (stat
    [this id]
    (when-block id
      (block-stats id file)))

  (-list
    [this opts]
    (->> (find-files root (:after opts))
         (map #(block-stats (file->id root %) %))
         (block/select-stats opts)))

  (-get
    [this id]
    (when-block id
      (file->block id file)))

  (put!
    [this block]
    (let [id (:id block)
          file (id->file root id)]
      (when-not (.exists file)
        (io/make-parents file)
        (with-open [content (block/open block)]
          (io/copy content file))
        (.setWritable file false false))
      (data/merge-blocks
        block
        (file->block id file))))

  (delete!
    [this id]
    (when-block id
      (.delete file))))

(defn erase!
  "Clears all contents of the file store by recursively deleting the root
  directory."
  [store]
  (rm-r (:root store)))

(defn file-store
  "Creates a new local file-based block store."
  [root]
  (FileBlockStore. (io/file root)))

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

(ns blocks.store.file
  "Block storage backed by files in nested directories. Each block is stored in
  a separate file.

  In many filesystems, directories are limited to 4,096 entries. In order to
  avoid this limit (and make navigating the blocks a bit more efficient), block
  content is stored in nested directories three levels deep. All path elements
  are lower-case hex-encoded bytes from the multihash.

  The first level is the two-byte multihash prefix, which designates the
  algorithm and digest length. There will usually only be one or two of these
  directories. The second and third levels are formed by the first two bytes of
  the hash digest. Finally, the block is stored in a file containing the rest of
  the digest.

  Thus, a block containing the content `foobar` would have the sha1 digest
  `97df3501149...` and be stored under the root directory at:

  `root/1114/97/df/35011497df3588b5a3...`

  Using this scheme, leaf directories should start approaching the limit once the
  user has 2^28 entries, or about 268 million blocks."
  (:require
    [blocks.core :as block]
    [blocks.data :as data]
    [clojure.java.io :as io]
    [clojure.string :as str]
    [multihash.core :as multihash])
  (:import
    java.io.File
    java.util.Date))

;; ## File System Utilities

(defn- seek-marker
  "Given a marker string, determine whether the file should be skipped, recursed
  into with a substring, or listed in full. Returs nil if the file should be
  skipped, otherwise a vector of the file and a marker to recurse with."
  [marker ^File file]
  (if (empty? marker)
    [file nil]
    (let [fname (.getName file)
          len (min (count marker) (count fname))
          cmp (compare (subs fname  0 len)
                       (subs marker 0 len))]
      (if-not (neg? cmp)
        (if (zero? cmp)
          [file (subs marker len)]
          [file nil])))))

(defn- find-files
  "Walks a directory tree depth first, returning a sequence of files found in
  lexical order. Intelligently skips directories based on the given marker."
  [^File file marker]
  (if (.isDirectory file)
    (->> (.listFiles file)
         (filter #(re-matches #"^[0-9a-f]+$" (.getName ^File %)))
         (keep (partial seek-marker marker))
         (sort-by first)
         (keep (partial apply find-files))
         (flatten))
    (when (.isFile file)
      [file])))

(defn- rm-r
  "Recursively removes a directory of files."
  [^File path]
  (when (.isDirectory path)
    (dorun (map rm-r (.listFiles path))))
  (.delete path))

;; ## File Block Functions

(defn- file-stats
  "Calculates storage stats for a block file."
  [^File file]
  {:stored-at (Date. (.lastModified file))
   :source (.toURI file)})

(defn- block-stats
  "Calculates a merged stat map for a block."
  [id ^File file]
  (when id
    (merge (file-stats file)
           {:id id, :size (.length file)})))

(defn- id->file
  "Determines the filesystem path for a block of content with the given hash
  identifier."
  ^java.io.File
  [root id]
  (let [hex (multihash/hex id)]
    (io/file
      root
      (subs hex 0 4)
      (subs hex 4 6)
      (subs hex 6 8)
      (subs hex 8))))

(defn- file->id
  "Reconstructs the hash identifier represented by the given file path."
  [root file]
  (let [root (str root)
        path (str file)]
    (when-not (.startsWith path root)
      (throw (IllegalStateException.
               (str "File " path " is not a child of root directory " root))))
    (-> path
        (subs (inc (count root)))
        (str/replace "/" "")
        (multihash/decode))))

(defn- file->block
  "Creates a lazy block to read from the given file."
  [id ^File file]
  (block/with-stats
    (data/lazy-block
      id (.length file)
      (fn file-reader [] (io/input-stream file)))
    (file-stats file)))

(defmacro ^:private when-block
  "An anaphoric macro which binds the block file to `file` and executes `body`
  only if it exists. Assumes that the root directory is bound to `root`."
  [id & body]
  `(let [~(with-meta 'file {:tag 'java.io.File})
         (id->file ~'root ~id)]
     (when (.exists ~'file)
       ~@body)))

;; ## File Store

; TODO: File store operations should really be thread-safe

;; Block content is stored as files in a multi-level hierarchy under the given
;; root directory.
(defrecord FileBlockStore
  [^File root]

  block/BlockStore

  (stat
    [this id]
    (when-block id
      (block-stats id file)))

  (-list
    [this opts]
    (->> (find-files root (:after opts))
         (keep #(block-stats (file->id root %) %))
         (block/select-stats opts)))

  (-get
    [this id]
    (when-block id
      (file->block id file)))

  (put!
    [this block]
    (let [id (:id block)
          file (id->file root id)]
      (when-not (.exists file)
        (io/make-parents file)
        (with-open [content (block/open block)]
          (io/copy content file))
        (.setWritable file false false))
      (data/merge-blocks
        block
        (file->block id file))))

  (delete!
    [this id]
    (when-block id
      (.delete file))))

(defn erase!
  "Clears all contents of the file store by recursively deleting the root
  directory."
  [store]
  (rm-r (:root store)))

(defn file-store
  "Creates a new local file-based block store."
  [root]
  (FileBlockStore. (io/file root)))

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

Check id in block-stats to catch nils from file->id.


(ns chessdojo.core
  (:require
    [clojure.zip :as zip :refer [up down left lefts right rights rightmost insert-right branch? node]]
    [reagent.core :as reagent :refer [atom]]
    [reagent.session :as session]
    [secretary.core :as secretary :include-macros true]
    [accountant.core :as accountant]
    [chessdojo.game :as cg]
    [chessdojo.fen :as cf]
    [chessdojo.rules :as cr]))

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

; samples

;(defn simple-component []
;  [:div
;   [:p "I am a component!"]
;   [:p.someclass
;    "I have " [:strong "bold"]
;    [:span {:style {:color "red"}} " and red "] "text."]])
;
;(defn lister [items]
;  [:ul
;   (for [item items]
;     ^{:key item} [:li "Item " item])])
;
;(def click-count (reagent/atom 0))
;
;(defn counting-component []
;  [:div
;   "The atom " [:code "click-count"] " has value: "
;   @click-count ". "
;   [:input {:type "button" :value "Click me!"
;            :on-click #(swap! click-count inc)}]])

(def state
  (reagent/atom
    (cg/soak [
              {:to-file "e" :to-rank "4"}
              {:to-file "e" :to-rank "5"}
              {:piece "N" :to-file "f" :to-rank "3"}
              :back
              {:piece "N" :to-file "c" :to-rank "3"}
              :out
              :forward
              {:piece "N" :to-file "c" :to-rank "6"}
              {:piece "B" :to-file "b" :to-rank "5"}
              {:to-file "a" :to-rank "6"}
              {:piece "B" :capture "x" :to-file "c" :to-rank "6"}
              ])))

(defn update-board [path]
  (println path)
  (let [game @state new-game (cg/jump game path)]
    (println (zip/node new-game))
    (let [new-fen (cf/position->fen (:position (node new-game)))]
      (reset! state new-game)
      (js/updateBoard new-fen)
    )
  ))

(defn ^:export insert-move [move]
  (let [move-info (js->clj move)
        move-coords {:from (get move-info "from") :to (get move-info "to") :piece (get move-info "piece") }
        new-game (cg/insert-move @state move-coords)
        new-fen (cf/position->fen (:position (node new-game)))
        ]
    (reset! state new-game)
    (js/updateBoard new-fen)
    )
  )

(defn move-view [move position path]
  [:span {:style {:margin-right "5px"} :on-click #(update-board path)} (cg/move->long-str move)])

(defn variation-view [nodes depth]
  [:div
   (for [node nodes]
     (if (vector? node)
       ^{:key (str depth)} [variation-view node (inc depth)]
       (let [move (:move node) position (:position node) path (:path (meta node))]
         ^{:key path} [move-view move position path]
         )
       )
     )
   ]
  )

(defn game-view []
  [:div
   [variation-view (rest (zip/root @state)) 0]
   ]
  )

(defn buttons []
  [:div
   [:input {:type "button" :value "Down" :on-click #(reset! state (down @state))}]
   [:input {:type "button" :value "Right" :on-click #(reset! state (right @state))}]]
  )

(defn home-page []
  [:div [:h2 "Welcome to chess-dojo"]
   [:div [:a {:href "/about"} "go to about page"]]
   [game-view]
   [buttons]
   ])

(defn about-page []
  [:div [:h2 "About chesslib"]
   [: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! []
  (accountant/configure-navigation!)
  (accountant/dispatch-current!)
  (mount-root))

(ns chessdojo.core
  (:require
    [clojure.zip :as zip :refer [up down left lefts right rights rightmost insert-right branch? node]]
    [reagent.core :as reagent :refer [atom]]
    [reagent.session :as session]
    [secretary.core :as secretary :include-macros true]
    [accountant.core :as accountant]
    [chessdojo.game :as cg]
    [chessdojo.fen :as cf]
    [chessdojo.rules :as cr]))

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

; samples

;(defn simple-component []
;  [:div
;   [:p "I am a component!"]
;   [:p.someclass
;    "I have " [:strong "bold"]
;    [:span {:style {:color "red"}} " and red "] "text."]])
;
;(defn lister [items]
;  [:ul
;   (for [item items]
;     ^{:key item} [:li "Item " item])])
;
;(def click-count (reagent/atom 0))
;
;(defn counting-component []
;  [:div
;   "The atom " [:code "click-count"] " has value: "
;   @click-count ". "
;   [:input {:type "button" :value "Click me!"
;            :on-click #(swap! click-count inc)}]])

(def state
  (reagent/atom
    (cg/soak [
              {:to-file "e" :to-rank "4"}
              {:to-file "e" :to-rank "5"}
              {:piece "N" :to-file "f" :to-rank "3"}
              :back
              {:piece "N" :to-file "c" :to-rank "3"}
              :out
              :forward
              {:piece "N" :to-file "c" :to-rank "6"}
              {:piece "B" :to-file "b" :to-rank "5"}
              {:to-file "a" :to-rank "6"}
              {:piece "B" :capture "x" :to-file "c" :to-rank "6"}
              ])))

(defn update-board [path]
  (println path)
  (let [game @state new-game (cg/jump game path)]
    (println (zip/node new-game))
    (let [new-fen (cf/position->fen (:position (node new-game)))]
      (reset! state new-game)
      (js/updateBoard new-fen)
      )
    ))

(defn ^:export insert-move [move]
  (let [move-info (js->clj move)
        move-coords {:from (get move-info "from") :to (get move-info "to") :piece (get move-info "piece")}
        new-game (cg/insert-move @state move-coords)
        new-fen (cf/position->fen (:position (node new-game)))
        ]
    (reset! state new-game)
    (js/updateBoard new-fen)))

(defn move-no [ply]
  (when (odd? ply) (str (inc (quot ply 2)) ".")))

(defn move-view [move path]
  [:span {:style {:margin-right "5px"} :on-click #(update-board path)}
   (str (move-no (first path)) (cg/move->long-str move))])

(defn variation-view [nodes depth]
  [:div
   (for [node nodes]
     (if (vector? node)
       ^{:key (rand-int 100000)} [variation-view node (inc depth)]
       (let [move (:move node) path (:path (meta node))]
         ^{:key path} [move-view move path]
         )
       )
     )
   ]
  )

(defn game-view []
  [:div
   [variation-view (rest (zip/root @state)) 0]
   ]
  )

(defn buttons []
  [:div
   [:input {:type "button" :value "Down" :on-click #(reset! state (down @state))}]
   [:input {:type "button" :value "Right" :on-click #(reset! state (right @state))}]]
  )

(defn home-page []
  [:div [:h2 "Welcome to chess-dojo"]
   [:div [:a {:href "/about"} "go to about page"]]
   [game-view]
   [buttons]
   ])

(defn about-page []
  [:div [:h2 "About chesslib"]
   [: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! []
  (accountant/configure-navigation!)
  (accountant/dispatch-current!)
  (mount-root))

include move-numbers in notation for white moves


(ns clanhr.{{sanitized}}.controllers.routes
  (:gen-class)
  (:require [clojure.stacktrace]
            [compojure.handler :as handler]
            [clanhr.auth.auth-middleware :as auth]
            [clanhr.analytics.errors :as errors]
            [clanhr.analytics.metrics :as metrics]
            [clanhr.{{sanitized}}.controllers.healthcheck :as healthcheck]
            [aleph.http :as http]
            [clanhr.reply.core :as reply]
            [clojure.core.async :as a]
            [ring.middleware.params :as ring-params]
            [ring.middleware.cors :as cors]
            [compojure.core :as core :refer [GET POST PUT DELETE defroutes]]
            [compojure.route :as route]))

(defroutes public-routes
  (GET "/healthcheck" [] (healthcheck/handler)))

(defroutes private-routes
  (route/not-found (reply/not-found {:success false :data "not-found"})))

(defn- wrap-exception-handler
  [handler]
  (fn [req]
    (try
      (handler req)
      (catch Exception e
        (errors/request-exception e req)
        (reply/exception e)))))

(defn- setup-cors
  "Setup cors"
  [handler]
  (cors/wrap-cors handler
                  :access-control-allow-origin
                  [#"^https?://(.+\.)?clanhr.com(.*)"
                   #"^https?://clanhr(.+\.)?cloudapp.net(.*)"
                   #"^http://localhost(.*)"]
                  :access-control-allow-methods [:get :put :post :delete]))
(def app
  (-> (core/routes
        public-routes
        (-> (handler/api private-routes)
            (auth/run)))
      (compojure.handler/api)
      (wrap-exception-handler)
      (setup-cors)
      (metrics/http-request-metric-fn "{{name}}")))

(defn- get-port
  "Gets the port to run the service"
  []
  (or (get (System/getenv) "PORT")
      "5000"))

(defn -main [& args]
  (let [port (Integer/parseInt (get-port))]
    (println "**" (or (get (System/getenv) "{{upper-and-sanitized-name}}_ENV" "development")))
    (println "Running on port" port)
    (http/start-server app {:port port})))

(ns clanhr.{{sanitized}}.controllers.routes
  (:gen-class)
  (:require [clojure.stacktrace]
            [compojure.handler :as handler]
            [clanhr.auth.auth-middleware :as auth]
            [clanhr.analytics.errors :as errors]
            [clanhr.analytics.metrics :as metrics]
            [clanhr.{{sanitized}}.controllers.healthcheck :as healthcheck]
            [aleph.http :as http]
            [clanhr.reply.core :as reply]
            [clojure.core.async :as a]
            [ring.middleware.params :as ring-params]
            [ring.middleware.cors :as cors]
            [compojure.core :as core :refer [GET POST PUT DELETE defroutes]]
            [compojure.route :as route]))

(defroutes public-routes
  (GET "/healthcheck" [] (healthcheck/handler)))

(defroutes private-routes
  (route/not-found (reply/not-found {:success false :data "not-found"})))

(defn- wrap-exception-handler
  [handler]
  (fn [req]
    (try
      (handler req)
      (catch Exception e
        (errors/request-exception e req)
        (reply/exception e)))))

(defn- setup-cors
  "Setup cors"
  [handler]
  (cors/wrap-cors handler
                  :access-control-allow-origin
                  [#"^https?://(.+\.)?clanhr.com(.*)"
                   #"^https?://clanhr(.+\.)?cloudapp.net(.*)"
                   #"^http://localhost(.*)"]
                  :access-control-allow-methods [:get :put :post :delete]))
(def app
  (-> (core/routes
        public-routes
        (-> (handler/api private-routes)
            (auth/run)))
      (compojure.handler/api)
      (wrap-exception-handler)
      (setup-cors)
      (metrics/http-request-metric-fn "{{name}}")))

(defn- get-port
  "Gets the port to run the service"
  []
  (or (get (System/getenv) "PORT")
      (get (System/getenv) "CLANHR_{{upper-and-sanitized-name}}_PORT")
      "5000"))

(defn -main [& args]
  (let [port (Integer/parseInt (get-port))]
    (println "**" (or (get (System/getenv) "{{upper-and-sanitized-name}}_ENV" "development")))
    (println "Running on port" port)
    (http/start-server app {:port port})))

add env port

add env port