(ns exploud.setup
  "## Setting up our application"
  (:require [cheshire.custom :as json]
            [clojure.java.io :as io]
            [clojure.string :as cs :only (split)]
            [clojure.tools.logging :refer (info warn error)]
            [exploud
             [asgard :as asgard]
             [deployment :as deployment]
             [store :as store]
             [web :as web]]
            [environ.core :refer [env]]
            [monger
             [collection :as mcol :only (ensure-index)]
             [core :as mc :only (connect! mongo-options
                                          server-address use-db!)]]
            [ring.adapter.jetty :refer [run-jetty]])
  (:import (java.lang Integer Throwable)
           (java.util.concurrent TimeUnit)
           (java.util.logging LogManager)
           (com.yammer.metrics Metrics)
           (com.yammer.metrics.core MetricName)
           (com.ovi.common.metrics HostnameFactory)
           (com.ovi.common.metrics.graphite GraphiteName
                                            GraphiteReporterFactory
                                            ReporterState)
           (org.joda.time DateTimeZone)
           (org.slf4j.bridge SLF4JBridgeHandler))
  (:gen-class))

(defn read-file-to-properties
  "Reads the file at `file-name` to an instance of `java.util.Properties`."
  [file-name]
  (with-open [^java.io.Reader reader (io/reader file-name)]
    (let [props (java.util.Properties.)]
      (.load props reader)
      (into {} (for [[k v] props] [k v])))))

(defn configure-logging
  "Route all `java.util.logging` log statements to `slf4j`."
  []
  (.reset (LogManager/getLogManager))
  (SLF4JBridgeHandler/install))

(defn build-server-addresses
  "Takes a comma-separated list of `host:port` pairs and breaks them up into
   Mongo server addresses."
  [comma-sep-hosts]
  (map (fn [[h p]] (mc/server-address h (Integer/parseInt p)))
       (map #(cs/split % #":") (cs/split comma-sep-hosts #","))))

(defn configure-joda
  "Configures Joda Time to use UTC as the default timezone (in case someone
   hasn't included it in the JVM args."
  []
  (json/add-encoder org.joda.time.DateTime
                    (fn [dt jg] (.writeString jg (str dt))))
  (DateTimeZone/setDefault DateTimeZone/UTC))

(defn configure-mongo-conn-pool
  "Configures the Mongo connection pool."
  []
  (let [^MongoOptions opts
        (mc/mongo-options
         :threads-allowed-to-block-for-connection-multiplier 10
         :connections-per-host (Integer/parseInt (env :mongo-connections-max))
         :max-wait-time 120000
         :connect-timeout 30000
         :socket-timeout 10000
         :socket-keep-alive false)
        sa (build-server-addresses (env :mongo-hosts))]
    (mc/connect! sa opts)))

(defn configure-mongo-db
  "Configures Mongo to use the right database."
  []
  (mc/use-db! "exploud"))

(defn bootstrap-mongo
  "Makes sure that all the indexes we want are present on our collections."
  []
  (mcol/ensure-index "deployments" (array-map "tasks.status" 1))
  (mcol/ensure-index "deployments" (array-map "start" -1 "end" -1 "name" 1)))

(defn start-graphite-reporting
  "Starts Graphite reporting."
  []
  (let [graphite-prefix (new GraphiteName
                             (into-array Object
                                         [(env :environment-name)
                                          (env :service-name)
                                          (HostnameFactory/getHostname)]))]
    (GraphiteReporterFactory/create
     (env :environment-entertainment-graphite-host)
     (Integer/parseInt (env :environment-entertainment-graphite-port))
     graphite-prefix
     (Integer/parseInt (env :service-graphite-post-interval))
     (TimeUnit/valueOf (env :service-graphite-post-unit))
     (ReporterState/valueOf (env :service-graphite-enabled)))))

(defn pick-up-tasks
  "Picks up incomplete tasks and schedules them for tracking.

   The intention is that even if exploud is redeployed while another
   deployment is going on, that deployment can be picked up and carry on."
  []
  (doseq [deployment (store/deployments-with-incomplete-tasks)]
    (let [{:keys [id tasks]} deployment]
      (doseq [task tasks]
        (asgard/track-until-completed id task (* 1 60 60)
                                      deployment/task-finished
                                      deployment/task-timed-out)))))

(def version
  "Gets the version of the application from the project properties."
  (delay
   (if-let [path (.getResource (ClassLoader/getSystemClassLoader)
                               "META-INF/maven/exploud/exploud/pom.properties")]
     ((read-file-to-properties path) "version")
     "localhost")))

(defn setup
  "Sets up the application."
  []
  (web/set-version! @version)
  (configure-joda)
  (configure-mongo-conn-pool)
  (configure-mongo-db)
  (bootstrap-mongo)
  (configure-logging)
  (start-graphite-reporting)
  (pick-up-tasks))

(def server
  "Our trusty server."
  (atom nil))

(defn start-server
  "Starts the server."
  []
  (run-jetty #'web/app {:port (Integer. (env :service-port))
                        :join? false
                        :stacktraces? (not (Boolean/valueOf
                                            (env :service-production)))
                        :auto-reload? (not (Boolean/valueOf
                                            (env :service-production)))}))

(defn start
  "Sets up our application and starts the server."
  []
  (do
    (setup)
    (reset! server (start-server))))

(defn stop
  "Stops the server."
  []
  (if-let [server @server] (.stop server)))

(defn -main
  "The entry point for the application."
  [& args]
  (start))

(ns exploud.setup
  "## Setting up our application"
  (:require [cheshire.custom :as json]
            [clojure.java.io :as io]
            [clojure.string :as cs :only (split)]
            [clojure.tools.logging :refer (info warn error)]
            [exploud
             [asgard :as asgard]
             [deployment :as deployment]
             [store :as store]
             [web :as web]]
            [environ.core :refer [env]]
            [monger
             [collection :as mcol :only (ensure-index)]
             [core :as mc :only (connect! mongo-options
                                          server-address use-db!)]]
            [ring.adapter.jetty :refer [run-jetty]])
  (:import (java.lang Integer Throwable)
           (java.util.concurrent TimeUnit)
           (java.util.logging LogManager)
           (com.yammer.metrics Metrics)
           (com.yammer.metrics.core MetricName)
           (com.ovi.common.metrics HostnameFactory)
           (com.ovi.common.metrics.graphite GraphiteName
                                            GraphiteReporterFactory
                                            ReporterState)
           (org.joda.time DateTimeZone)
           (org.slf4j.bridge SLF4JBridgeHandler))
  (:gen-class))

(defn read-file-to-properties
  "Reads the file at `file-name` to an instance of `java.util.Properties`."
  [file-name]
  (with-open [^java.io.Reader reader (io/reader file-name)]
    (let [props (java.util.Properties.)]
      (.load props reader)
      (into {} (for [[k v] props] [k v])))))

(defn configure-logging
  "Route all `java.util.logging` log statements to `slf4j`."
  []
  (.reset (LogManager/getLogManager))
  (SLF4JBridgeHandler/install))

(defn build-server-addresses
  "Takes a comma-separated list of `host:port` pairs and breaks them up into
   Mongo server addresses."
  [comma-sep-hosts]
  (map (fn [[h p]] (mc/server-address h (Integer/parseInt p)))
       (map #(cs/split % #":") (cs/split comma-sep-hosts #","))))

(defn configure-joda
  "Configures Joda Time to use UTC as the default timezone (in case someone
   hasn't included it in the JVM args."
  []
  (json/add-encoder org.joda.time.DateTime
                    (fn [dt jg] (.writeString jg (str dt))))
  (DateTimeZone/setDefault DateTimeZone/UTC))

(defn configure-mongo-conn-pool
  "Configures the Mongo connection pool."
  []
  (let [^MongoOptions opts
        (mc/mongo-options
         :threads-allowed-to-block-for-connection-multiplier 10
         :connections-per-host (Integer/parseInt (env :mongo-connections-max))
         :max-wait-time 120000
         :connect-timeout 30000
         :socket-timeout 10000
         :socket-keep-alive false)
        sa (build-server-addresses (env :mongo-hosts))]
    (mc/connect! sa opts)))

(defn configure-mongo-db
  "Configures Mongo to use the right database."
  []
  (mc/use-db! "exploud"))

(defn bootstrap-mongo
  "Makes sure that all the indexes we want are present on our collections."
  []
  (mcol/ensure-index "deployments" (array-map "tasks.status" 1))
  (mcol/ensure-index "deployments" (array-map "start" -1 "end" -1 "name" 1)))

(defn start-graphite-reporting
  "Starts Graphite reporting."
  []
  (let [graphite-prefix (new GraphiteName
                             (into-array Object
                                         [(env :environment-name)
                                          (env :service-name)
                                          (HostnameFactory/getHostname)]))]
    (GraphiteReporterFactory/create
     (env :environment-entertainment-graphite-host)
     (Integer/parseInt (env :environment-entertainment-graphite-port))
     graphite-prefix
     (Integer/parseInt (env :service-graphite-post-interval))
     (TimeUnit/valueOf (env :service-graphite-post-unit))
     (ReporterState/valueOf (env :service-graphite-enabled)))))

(defn pick-up-tasks
  "Picks up incomplete tasks and schedules them for tracking.

   The intention is that even if exploud is redeployed while another
   deployment is going on, that deployment can be picked up and carry on."
  []
  (doseq [deployment (store/deployments-with-incomplete-tasks)]
    (let [{:keys [id tasks]} deployment]
      (doseq [task tasks]
        (asgard/track-until-completed id task (* 1 60 60)
                                      deployment/task-finished
                                      deployment/task-timed-out)))))

(def version
  "Gets the version of the application from the project properties."
  (delay
   (if-let [path (.getResource (ClassLoader/getSystemClassLoader)
                               "META-INF/maven/exploud/exploud/pom.properties")]
     ((read-file-to-properties path) "version")
     "localhost")))

(defn setup
  "Sets up the application."
  []
  (web/set-version! @version)
  (configure-joda)
  (configure-mongo-conn-pool)
  (configure-mongo-db)
  (bootstrap-mongo)
  (configure-logging)
  (start-graphite-reporting)
  (comment (pick-up-tasks)))

(def server
  "Our trusty server."
  (atom nil))

(defn start-server
  "Starts the server."
  []
  (run-jetty #'web/app {:port (Integer. (env :service-port))
                        :join? false
                        :stacktraces? (not (Boolean/valueOf
                                            (env :service-production)))
                        :auto-reload? (not (Boolean/valueOf
                                            (env :service-production)))}))

(defn start
  "Sets up our application and starts the server."
  []
  (do
    (setup)
    (reset! server (start-server))))

(defn stop
  "Stops the server."
  []
  (if-let [server @server] (.stop server)))

(defn -main
  "The entry point for the application."
  [& args]
  (start))

Disable the picking up of unfinished deployments


{:user {:plugins [[nightlight/lein-nightlight "1.6.3"]
                  [lein-auto "0.1.3"]
                  [lein-ancient "0.6.10"]
                  [lein-kibit "0.1.3"]
                  [venantius/ultra "0.5.1"]]}}

{:user {:plugins [[nightlight/lein-nightlight "1.6.3"]
                  [lein-auto "0.1.3"]
                  [lein-ancient "0.6.10"]
                  [lein-kibit "0.1.3"]]}}

Remove ultra

Remove ultra

It has issues with older versions of Clojure.


(ns io.perun.core
  "Utilies which can be used in base JVM and pods."
  (:require [clojure.java.io         :as io]
            [clojure.string          :as string]
            [boot.core               :as boot]
            [boot.from.io.aviso.ansi :as ansi]
            [boot.util               :as u]))

(def +meta-key+ :io.perun)

(defn get-meta
  "Return metadata on files. Files metadata is a list.
   Internally it's stored as a map indexed by `:path`"
  [fileset]
  (keep +meta-key+ (vals (:tree fileset))))

(defn key-meta [data]
  (into {} (for [d data] [(:path d) d])))

(defn set-meta
  "Update `+meta-key+` metadata for files in `data` and return updates fileset"
  [fileset data]
  (boot/add-meta fileset (into {} (for [d data] [(:path d) {+meta-key+ d}]))))

(defn merge-meta* [m1 m2]
  (vals (merge-with merge (key-meta m1) (key-meta m2))))

(defn merge-meta [fileset data]
  (set-meta fileset (merge-meta* (get-meta fileset) data)))

(def +global-meta-key+ :io.perun.global)

(defn get-global-meta
  "Return global metadata that is related to the whole project
   and all files. Global metadata is a map"
  [fileset]
  (-> fileset meta +global-meta-key+))

(defn set-global-meta [fileset data]
  (vary-meta fileset assoc +global-meta-key+ data))

(defn report-info [task msg & args]
  (apply u/info
        (str
          (ansi/yellow (str "[" task "]"))
          " - "
          (ansi/green (str msg "\n")))
        args))

(defn report-debug [task msg datastructure]
  (u/dbug
    (str
      (ansi/yellow (str "[" task "]"))
      " - "
      (ansi/blue (str msg "\n"))
      "%s\n")
    (pr-str datastructure)))

(defn write-to-file [out-file content]
  (doto out-file
    io/make-parents
    (spit content)))

(defn create-file [tmp filepath content]
  (let [file (io/file tmp filepath)]
    (write-to-file file content)))

(defn absolutize-url
  "Makes sure the url starts with slash."
  [url]
  (if (.startsWith url "/")
    url
    (str "/" url)))

(defn relativize-url
  "Removes slashes url start of the string."
  [url]
  (string/replace url #"^[\/]*" ""))

(defn create-filepath
  "Creates a filepath using system path separator."
  [& args]
  (.getPath (apply io/file args)))

(defn url-to-path
  "Converts a url to filepath."
  [url]
  (apply create-filepath (string/split (relativize-url url) #"\/")))

(defn filename [name]
  (second (re-find #"(.+?)(\.[^.]*$|$)" (last (string/split name #"/")))))

(defn parent-path [filepath filename-with-extension]
  (if (.endsWith filepath filename-with-extension)
      (.substring filepath 0 (- (count filepath)
                              (count filename-with-extension)))
     filepath))

(defn ^String extension [name]
  (last (seq (string/split name #"\."))))

(defn assert-base-url [base-url]
  (assert (= \/ (last base-url))
          "base-url must end in \"/\"")
  base-url)

(ns io.perun.core
  "Utilies which can be used in base JVM and pods."
  (:require [clojure.java.io         :as io]
            [clojure.string          :as string]
            [boot.core               :as boot]
            [boot.from.io.aviso.ansi :as ansi]
            [boot.util               :as u]))

(def +meta-key+ :io.perun)

(defn get-meta
  "Return metadata on files. Files metadata is a list.
   Internally it's stored as a map indexed by `:path`"
  [fileset]
  (keep +meta-key+ (vals (:tree fileset))))

(defn key-meta [data]
  (into {} (for [d data] [(:path d) d])))

(defn set-meta
  "Update `+meta-key+` metadata for files in `data` and return updated fileset"
  [fileset data]
  (boot/add-meta fileset (into {} (for [d data] [(:path d) {+meta-key+ d}]))))

(defn merge-meta* [m1 m2]
  (vals (merge-with merge (key-meta m1) (key-meta m2))))

(defn merge-meta [fileset data]
  (set-meta fileset (merge-meta* (get-meta fileset) data)))

(def +global-meta-key+ :io.perun.global)

(defn get-global-meta
  "Return global metadata that is related to the whole project
   and all files. Global metadata is a map"
  [fileset]
  (-> fileset meta +global-meta-key+))

(defn set-global-meta [fileset data]
  (vary-meta fileset assoc +global-meta-key+ data))

(defn report-info [task msg & args]
  (apply u/info
        (str
          (ansi/yellow (str "[" task "]"))
          " - "
          (ansi/green (str msg "\n")))
        args))

(defn report-debug [task msg datastructure]
  (u/dbug
    (str
      (ansi/yellow (str "[" task "]"))
      " - "
      (ansi/blue (str msg "\n"))
      "%s\n")
    (pr-str datastructure)))

(defn write-to-file [out-file content]
  (doto out-file
    io/make-parents
    (spit content)))

(defn create-file [tmp filepath content]
  (let [file (io/file tmp filepath)]
    (write-to-file file content)))

(defn absolutize-url
  "Makes sure the url starts with slash."
  [url]
  (if (.startsWith url "/")
    url
    (str "/" url)))

(defn relativize-url
  "Removes slashes url start of the string."
  [url]
  (string/replace url #"^[\/]*" ""))

(defn create-filepath
  "Creates a filepath using system path separator."
  [& args]
  (.getPath (apply io/file args)))

(defn url-to-path
  "Converts a url to filepath."
  [url]
  (apply create-filepath (string/split (relativize-url url) #"\/")))

(defn filename [name]
  (second (re-find #"(.+?)(\.[^.]*$|$)" (last (string/split name #"/")))))

(defn parent-path [filepath filename-with-extension]
  (if (.endsWith filepath filename-with-extension)
      (.substring filepath 0 (- (count filepath)
                              (count filename-with-extension)))
     filepath))

(defn ^String extension [name]
  (last (seq (string/split name #"\."))))

(defn assert-base-url [base-url]
  (assert (= \/ (last base-url))
          "base-url must end in \"/\"")
  base-url)

fix docstring typo

fix docstring typo


(ns lens.api
  (:require [clojure.core.reducers :as r]
            [clojure.string :as str]
            [datomic.api :as d]
            [lens.util :refer [uuid? entity?]]
            [lens.util :as util :refer [Nat]]
            [schema.core :as s :refer [Str]])
  (:import [java.util.concurrent ExecutionException]))

;; ---- Schema ----------------------------------------------------------------

(def Workbook
  (s/pred :workbook/id))

(def Version
  (s/pred :version/id))

(def User
  (s/pred :user/id))

;; ---- Single Accessors ------------------------------------------------------

(defn workbook [db id]
  (d/entity db [:workbook/id id]))

(defn version [db id]
  (d/entity db [:version/id id]))

(defn user [db id]
  (d/entity db [:user/id id]))

;; ---- Lists -------------------------------------------------------------

(defn- all-of [db attr]
  (->> (d/datoms db :avet attr)
       (r/map #(d/entity db (:e %)))))

(defn all-users [db]
  (all-of db :user/id))

(defn all-versions [db]
  (all-of db :version/id))

(defn all-queries [db]
  (->> (d/datoms db :aevt :query/cols)
       (r/map #(d/entity db (:e %)))))

;; ---- Traversal -------------------------------------------------------------

(defn queries
  "Returns a lazy seq of all queries of a version or nil."
  [version]
  (some-> version :version/queries util/to-seq))

(defn query-cols
  "Returns a lazy seq of all query columns of a query or nil."
  [query]
  (some-> query :query/cols util/to-seq))

(defn query-cells
  "Returns a lazy seq of all query cells of a query column or nil."
  [col]
  (some-> col :query.col/cells util/to-seq reverse))

(defn private-workbooks
  "Returns all private worksbooks of the user sorted by name."
  [user]
  {:pre [(:user/id user)]}
  (->> (:user/private-workbooks user)
       (sort-by (comp str/lower-case :workbook/name))))

;; ---- Creations -------------------------------------------------------------

(defn- create
  "Runs a transaction and returns one new entity.

  The function has to take a tempid as its only argument. The entity to be
  returned has to be created with this tempid."
  [conn fn]
  (let [tid (d/tempid :db.part/user)
        tx-result @(d/transact conn (fn tid))
        db-after (:db-after tx-result)]
    (d/entity db-after (d/resolve-tempid db-after (:tempids tx-result) tid))))

(defn transact [conn tx-data]
  (try
    @(d/transact conn tx-data)
    (catch ExecutionException e (throw (.getCause e)))
    (catch Exception e (throw e))))

(s/defn update-workbook! :- Workbook
  "Updates the workbook to point to the given version.

  Returns the workbook based on the new database. Checks that the old version is
  still current - throws a exception with type :lens.schema/precondition-failed
  if not. Throws :lens.schema/workbook-not-found if the workbook doesn't exist.
  Throws :lens.schema/version-not-found if the new version does not exist.
  Workbook Id is from :workbook/id and version ids are from :version/id."
  [conn workbook-id :- Str old-version-id :- Str new-version-id :- Str]
  (let [r (transact conn [[:workbook.fn/update workbook-id old-version-id
                           new-version-id]])]
    (d/entity (:db-after r) [:workbook/id workbook-id])))

(s/defn create-private-workbook! :- Workbook
  "Creates a new private workbook with name for the user with id.

  Creates the user if it does not exist. The new workbook will have one initial
  version with one query in it."
  [conn user-id name]
  {:pre [(string? user-id) (string? name)]
   :post [(:workbook/id %)]}
  (create conn (fn [tid] [[:workbook.fn/create-private tid user-id name]])))

(s/defn add-query :- Version
  "Adds a new query to a copy of the given version."
  [conn version :- Version]
  (create conn (fn [tid] [[:version.fn/add-query tid (:db/id version)]])))

(s/defn remove-query :- Version
  "Removes the query at idx from a copy of the given version."
  [conn version :- Version idx :- Nat]
  (create conn (fn [tid] [[:version.fn/remove-query tid (:db/id version) idx]])))

(s/defn duplicate-query :- Version
  "Duplicates the query at idx of the given version and insert the duplicate
  after the original in a copy of the given version."
  [conn version :- Version idx :- Nat]
  (create conn (fn [tid] [[:version.fn/duplicate-query tid (:db/id version) idx]])))

(s/defn add-query-cell :- Version
  "Adds a new query cell to a copy of the given version.

  Term is a vector of type and id."
  [conn version :- Version query-idx :- Nat col-idx :- Nat term :- [Str]]
  (create conn (fn [tid] [[:version.fn/add-query-cell tid (:db/id version)
                           query-idx col-idx term]])))

(s/defn remove-query-cell :- Version
  "Removes a query cell from a copy of the given version."
  [conn version :- Version query-idx :- Nat col-idx :- Nat term-id :- Str]
  (create conn (fn [tid] [[:version.fn/remove-query-cell tid (:db/id version)
                           query-idx col-idx term-id]])))

(ns lens.api
  (:require [clojure.core.reducers :as r]
            [clojure.string :as str]
            [datomic.api :as d]
            [lens.util :refer [uuid? entity?]]
            [lens.util :as util :refer [Nat]]
            [schema.core :as s :refer [Str]])
  (:import [java.util.concurrent ExecutionException]))

;; ---- Schema ----------------------------------------------------------------

(def Workbook
  (s/pred :workbook/id))

(def Version
  (s/pred :version/id))

(def User
  (s/pred :user/id))

;; ---- Single Accessors ------------------------------------------------------

(defn workbook [db id]
  (d/entity db [:workbook/id id]))

(defn version [db id]
  (d/entity db [:version/id id]))

(defn user [db id]
  (d/entity db [:user/id id]))

;; ---- Lists -------------------------------------------------------------

(defn- all-of [db attr]
  (->> (d/datoms db :avet attr)
       (r/map #(d/entity db (:e %)))))

(defn all-users [db]
  (all-of db :user/id))

(defn all-versions [db]
  (all-of db :version/id))

(defn all-queries [db]
  (->> (d/datoms db :aevt :query/cols)
       (r/map #(d/entity db (:e %)))))

;; ---- Traversal -------------------------------------------------------------

(defn queries
  "Returns a lazy seq of all queries of a version or nil."
  [version]
  (some-> version :version/queries util/to-seq))

(defn query-cols
  "Returns a lazy seq of all query columns of a query or nil."
  [query]
  (some-> query :query/cols util/to-seq))

(defn query-cells
  "Returns a lazy seq of all query cells of a query column or nil."
  [col]
  (some-> col :query.col/cells util/to-seq reverse))

(defn private-workbooks
  "Returns all private worksbooks of the user sorted by name."
  [user]
  {:pre [(:user/id user)]}
  (->> (:user/private-workbooks user)
       (sort-by (comp str/lower-case :workbook/name))))

;; ---- Creations -------------------------------------------------------------

(defn- create
  "Runs a transaction and returns one new entity.

  The function has to take a tempid as its only argument. The entity to be
  returned has to be created with this tempid."
  [conn fn]
  (let [tid (d/tempid :db.part/user)
        tx-result @(d/transact conn (fn tid))
        db-after (:db-after tx-result)]
    (d/entity db-after (d/resolve-tempid db-after (:tempids tx-result) tid))))

(defn transact [conn tx-data]
  (try
    @(d/transact conn tx-data)
    (catch ExecutionException e (throw (.getCause e)))
    (catch Exception e (throw e))))

(s/defn update-workbook! :- Workbook
  "Updates the workbook to point to the given version.

  Returns the workbook based on the new database. Checks that the old version is
  still current - throws a exception with type :lens.schema/precondition-failed
  if not. Throws :lens.schema/workbook-not-found if the workbook doesn't exist.
  Throws :lens.schema/version-not-found if the new version does not exist.
  Workbook Id is from :workbook/id and version ids are from :version/id."
  [conn workbook-id :- Str old-version-id :- Str new-version-id :- Str]
  (let [r (transact conn [[:workbook.fn/update workbook-id old-version-id
                           new-version-id]])]
    (d/entity (:db-after r) [:workbook/id workbook-id])))

(s/defn create-private-workbook! :- Workbook
  "Creates a new private workbook with name for the user with id.

  Creates the user if it does not exist. The new workbook will have one initial
  version with one query in it."
  [conn user-id name]
  {:pre [(string? user-id) (string? name)]
   :post [(:workbook/id %)]}
  (create conn (fn [tid] [[:workbook.fn/create-private tid user-id name]])))

(s/defn add-query :- Version
  "Returns a new version with one standard query added."
  [conn version :- Version]
  (create conn (fn [tid] [[:version.fn/add-query tid (:db/id version)]])))

(s/defn remove-query :- Version
  "Returns a new version with the query at idx removed."
  [conn version :- Version idx :- Nat]
  (create conn (fn [tid] [[:version.fn/remove-query tid (:db/id version) idx]])))

(s/defn duplicate-query :- Version
  "Returns a new version with the query at idx duplicated. The duplicate will be
  inserted right after the query at idx."
  [conn version :- Version idx :- Nat]
  (create conn (fn [tid] [[:version.fn/duplicate-query tid (:db/id version) idx]])))

(s/defn add-query-cell :- Version
  "Returns a new version with a query cell added to the query and column with
  the given indicies.

  Term is a vector of type and id."
  [conn version :- Version query-idx :- Nat col-idx :- Nat term :- [Str]]
  (create conn (fn [tid] [[:version.fn/add-query-cell tid (:db/id version)
                           query-idx col-idx term]])))

(s/defn remove-query-cell :- Version
  "Returns a new version with the query cell with term-id removed at the query
  and column with the given indicies."
  [conn version :- Version query-idx :- Nat col-idx :- Nat term-id :- Str]
  (create conn (fn [tid] [[:version.fn/remove-query-cell tid (:db/id version)
                           query-idx col-idx term-id]])))

Improve Docs

Improve Docs


(ns discuss.find
  (:require [clojure.walk :refer [keywordize-keys]]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [discuss.communication :as com]
            [discuss.utils.common :as lib]
            [discuss.utils.views :as vlib]))

(defn get-search-results
  "Extract values and create a list of maps."
  []
  (get-in @lib/app-state [:discussion :search :values]))

(defn statement-handler
  "Called when received a response in the search."
  [response]
  (let [res (lib/json->clj response)
        error (:error res)]
    (lib/loading? false)
    (if (pos? (count error))
      (lib/error-msg! error)
      (do
        (lib/no-error!)
        (lib/update-state-item! :discussion :search (fn [_] res))))))

(defn find-statement
  "Find related statements to given keywords."
  [keywords]
  (when-not (= keywords "")
    (let [issue 1
          mode 3
          request (clojure.string/join "/" ["api/get/statements" issue mode keywords])]
      (com/ajax-get request {} statement-handler))))

(defn item-view [data owner]
  (reify om/IRender
    (render [_]
      (dom/div #js {:className "bs-callout bs-callout-info"}
               (vlib/safe-html (:text data))
               (dom/span #js {:className "badge pull-right"}
                         (lib/str->int (:distance data)))))))

(defn update-state-find-statement
  "Saves current state into object and sends search request to discussion system."
  [key val owner]
  (vlib/commit-target-value key val owner)
  (find-statement (.. val -target -value)))

(defn form-view [_ owner]
  (reify
    om/IInitState
    (init-state [_]
      {:search-value ""})
    om/IRenderState
    (render-state [_ {:keys [search-value]}]
      (dom/div nil

               #_(dom/div #js {:className "dropdown"}
                        (dom/button #js {:id            "dropdownMenu1"
                                         :className     "btn btn-default dropdown-toggle"
                                         :type          "button"
                                         :data-toggle   "dropdown"
                                         :aria-haspopup "true"
                                         :aria-expanded "true"}
                                    "Dropdown "
                                    (dom/span #js {:className "caret"}))
                        (dom/ul #js {:className       "dropdown-menu"
                                     :aria-labelledby "dropdownMenu1"}
                                (dom/li nil
                                        (dom/a #js {:href "#"} "foo"))))

               (dom/div #js {:className "input-group"}
                        (dom/input #js {:className   "form-control"
                                        :onChange    #(update-state-find-statement :search-value % owner)
                                        :value       search-value
                                        :placeholder "Find Statement"})
                        (dom/span #js {:className "input-group-btn"}
                                  (dom/button #js {:className "btn btn-primary"
                                                   :type      "button"}
                                              (vlib/fa-icon "fa-search fa-fw" #(find-statement search-value)))))))))

(defn results-view []
  (reify om/IRender
    (render [_]
      (dom/div nil
               (apply dom/div nil
                      (om/build-all item-view (get-search-results)))))))

(ns discuss.find
  (:require [clojure.walk :refer [keywordize-keys]]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [discuss.communication :as com]
            [discuss.utils.common :as lib]
            [discuss.utils.views :as vlib]))

(defn get-search-results
  "Extract values and create a list of maps."
  []
  (get-in @lib/app-state [:discussion :search :values]))

(defn statement-handler
  "Called when received a response in the search."
  [response]
  (let [res (lib/json->clj response)
        error (:error res)]
    (lib/loading? false)
    (if (pos? (count error))
      (lib/error-msg! error)
      (do
        (lib/no-error!)
        (lib/update-state-item! :discussion :search (fn [_] res))))))

(defn find-statement
  "Find related statements to given keywords."
  [keywords]
  (when-not (= keywords "")
    (let [issue 1
          mode 3
          request (clojure.string/join "/" ["api/get/statements" issue mode keywords])]
      (com/ajax-get request {} statement-handler))))

(defn item-view [data owner]
  (reify om/IRender
    (render [_]
      (dom/div #js {:className "bs-callout bs-callout-info"}
               (vlib/safe-html (:text data))
               (dom/span #js {:className "badge pull-right"}
                         (lib/str->int (:distance data)))))))

(defn update-state-find-statement
  "Saves current state into object and sends search request to discussion system."
  [key val owner]
  (vlib/commit-target-value key val owner)
  (find-statement (.. val -target -value)))

(defn form-view [_ owner]
  (reify
    om/IInitState
    (init-state [_]
      {:search-value ""})
    om/IRenderState
    (render-state [_ {:keys [search-value]}]
      (dom/div nil
               (let [issues (lib/get-issues)]
                 (dom/div #js {:className "form-group"}
                          (dom/label nil "Select Issue")
                          (dom/select #js {:className "form-control"
                                           :multiple  true}
                                      (map #(dom/option #js {:key (lib/prefix-name (str "discuss-issue-selector-" (:uid %)))}
                                                        (:title %))
                                           issues))))

               (dom/div #js {:className "input-group"}
                        (dom/input #js {:className   "form-control"
                                        :onChange    #(update-state-find-statement :search-value % owner)
                                        :value       search-value
                                        :placeholder "Find Statement"})
                        (dom/span #js {:className "input-group-btn"}
                                  (dom/button #js {:className "btn btn-primary"
                                                   :type      "button"}
                                              (vlib/fa-icon "fa-search fa-fw" #(find-statement search-value)))))))))

(defn results-view []
  (reify om/IRender
    (render [_]
      (dom/div nil
               (apply dom/div nil
                      (om/build-all item-view (get-search-results)))))))

Add selector for issues

Add selector for issues


(ns nml.core
  (:require [clojure.string    :as string])
  (:require [instaparse.core   :as insta ])
  (:require [clojure.tools.cli :as cli   ])
  (:gen-class))

(declare nmlget nmlname nmlset nmlstr)

; defs

(def debug false)

(def parse (insta/parser (clojure.java.io/resource "grammar")))

;; defns

(defn fail [& msg]
  (if msg (println (apply str msg)))
  (System/exit 1))

(defn nmlget [tree nml key]
  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
        values   (last nvsubseq)
        value    (if (nil? values) "" (nmlstr values))]
    (println (str nml ":" key "=" value))
    tree))

(defn nmlname [x]
  (nmlstr (second x)))

(defn nmlset [tree nml key val & sub]
  (let [child (if sub :nvsubseq :stmt)
        match (if sub key nml)
        vnew  (if sub (fn [tree] (parse val :start :values)) #(nmlset % nml key val true))
        f     (fn [k v] [child k (if (= (nmlstr k) match) (vnew v) v)])]
    (insta/transform {child f} tree)))

(defn nmlstr [x]
  (let [k (first x)
        v (rest  x)
        cjoin    #(string/join "," %)
        delegate #(map nmlstr %)
        ds       (fn [v] (delegate (sort-by #(nmlname %) v)))
        list2str #(apply str (map nmlstr %))
        sf       #(nmlstr (first %))
        sl       #(nmlstr (last %))]
    (if debug (println (str "k=" k " v=" v)))
    (apply str (case k
                 :s        (ds v)
                 :array    [(sf v) (sl v)]
                 :c        (sf v)
                 :colon    ":"
                 :comma    ","
                 :comment  ""
                 :complex  ["(" (cjoin (delegate v)) ")"]
                 :dataref  (delegate v)
                 :dec      (delegate v)
                 :dot      "."
                 :exp      [(first v) (sl v)]
                 :false    "f"
                 :int      (delegate v)
                 :junk     ""
                 :logical  (sf v)
                 :name     (map string/lower-case v)
                 :nvseq    (ds v)
                 :nvsubseq ["  " (sf v) "=" (sl v) "\n"]
                 :partref  (sf v)
                 :percent  "%"
                 :r        (sf v)
                 :real     (delegate v)
                 :sect     ["(" (list2str v) ")"]
                 :sep      v
                 :sign     v
                 :slash    v
                 :star     "*"
                 :stmt     ["&" (sf v) "\n" (list2str (rest v)) "/\n"]
                 :string   v
                 :true     "t"
                 :uint     v
                 :value    (delegate v)
                 :values   (cjoin (delegate v))
                 :ws       ""
                 :wsopt    ""))))

(defn nmltree [fname]
  (try (parse (slurp fname))
       (catch Exception e (fail "Could not open namelist file '" fname "'."))))

;; cli

(defn assoc-get [m k v]
  (let [gets (:get m [])]
    (assoc m :get (into gets [v]))))

(defn assoc-set [m k v]
  (let [sets (:set m [])]
    (assoc m :set (into sets [v]))))

(defn parse-get [x]
  (string/split x #":" 2))

(defn parse-set [x]
  (let [[nmlkey val] (string/split x #"=" 2)
        [nml key] (parse-get nmlkey)]
    [nml key val]))

(def cliopts
  [["-g" "--get n:k"   "get value of key 'k' in namelist 'n'"        :assoc-fn assoc-get :parse-fn parse-get ]
   ["-s" "--set n:k=v" "set value of key 'k' in namelist 'n' to 'v'" :assoc-fn assoc-set :parse-fn parse-set]])

;; main

(defn transform [tree sets]
  (if (empty? sets)
    tree
    (let [[nml key val] (first sets)]
      (transform (nmlset tree nml key val) (rest sets)))))

(defn -main [& args]
  (alter-var-root #'*read-eval* (constantly false))
  (let [{:keys [options arguments summary]} (cli/parse-opts args cliopts)
        gets (:get options)
        sets (:set options)
        tree (nmltree (first arguments))]
    (if (and gets sets) (fail "Do not mix get and set operations."))
    (cond gets (doseq [[nml key] gets] (nmlget tree nml key))
          sets (println (nmlstr (transform tree sets)))
          :else (println (nmlstr tree)))))

(ns nml.core
  (:require [clojure.string    :as string])
  (:require [instaparse.core   :as insta ])
  (:require [clojure.tools.cli :as cli   ])
  (:gen-class))

(declare nmlget nmlname nmlset nmlstr)

; defs

(def debug false)

(def parse (insta/parser (clojure.java.io/resource "grammar")))

;; defns

(defn fail [& msg]
  (if msg (println (apply str msg)))
  (System/exit 1))

(defn nmlget [tree nml key]
  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
        values   (last nvsubseq)
        value    (if (nil? values) "" (nmlstr values))]
    (println (str nml ":" key "=" value))
    tree))

(defn nmlname [x]
  (nmlstr (second x)))

(defn nmlset [tree nml key val & sub]
  (let [child (if sub :nvsubseq :stmt)
        match (if sub key nml)
        vnew  (if sub (fn [tree] (parse val :start :values)) #(nmlset % nml key val true))
        f     (fn [k v] [child k (if (= (nmlstr k) match) (vnew v) v)])]
    (insta/transform {child f} tree)))

(defn nmlstr [x]
  (let [k (first x)
        v (rest  x)
        cjoin    #(string/join "," %)
        delegate #(map nmlstr %)
        ds       (fn [v] (delegate (sort-by #(nmlname %) v)))
        list2str #(apply str (map nmlstr %))
        sf       #(nmlstr (first %))
        sl       #(nmlstr (last %))]
    (if debug (println (str "k=" k " v=" v)))
    (apply str (case k
                 :s        (ds v)
                 :array    [(sf v) (sl v)]
                 :c        (sf v)
                 :colon    ":"
                 :comma    ","
                 :comment  ""
                 :complex  ["(" (cjoin (delegate v)) ")"]
                 :dataref  (delegate v)
                 :dec      (delegate v)
                 :dot      "."
                 :exp      [(first v) (sl v)]
                 :false    "f"
                 :int      (delegate v)
                 :junk     ""
                 :logical  (sf v)
                 :name     (map string/lower-case v)
                 :nvseq    (ds v)
                 :nvsubseq ["  " (sf v) "=" (sl v) "\n"]
                 :partref  (sf v)
                 :percent  "%"
                 :r        (sf v)
                 :real     (delegate v)
                 :sect     ["(" (list2str v) ")"]
                 :sep      v
                 :sign     v
                 :slash    v
                 :star     "*"
                 :stmt     ["&" (sf v) "\n" (list2str (rest v)) "/\n"]
                 :string   v
                 :true     "t"
                 :uint     v
                 :value    (delegate v)
                 :values   (cjoin (delegate v))
                 :ws       ""
                 :wsopt    ""))))

(defn nmlxform [tree sets]
  (loop [t tree s sets]
    (if (empty? s)
      t
      (let [[nml key val] (first s)]
        (recur (nmlset t nml key val) (rest s))))))

(defn nmltree [fname]
  (try (parse (slurp fname))
       (catch Exception e (fail "Could not open namelist file '" fname "'."))))

;; cli

(defn assoc-get [m k v]
  (let [gets (:get m [])]
    (assoc m :get (into gets [v]))))

(defn assoc-set [m k v]
  (let [sets (:set m [])]
    (assoc m :set (into sets [v]))))

(defn parse-get [x]
  (string/split x #":" 2))

(defn parse-set [x]
  (let [[nmlkey val] (string/split x #"=" 2)
        [nml key] (parse-get nmlkey)]
    [nml key val]))

(def cliopts
  [["-g" "--get n:k"   "get value of key 'k' in namelist 'n'"        :assoc-fn assoc-get :parse-fn parse-get ]
   ["-s" "--set n:k=v" "set value of key 'k' in namelist 'n' to 'v'" :assoc-fn assoc-set :parse-fn parse-set]])

;; main

(defn -main [& args]
  (alter-var-root #'*read-eval* (constantly false))
  (let [{:keys [options arguments summary]} (cli/parse-opts args cliopts)
        gets (:get options)
        sets (:set options)
        tree (nmltree (first arguments))]
    (if (and gets sets) (fail "Do not mix get and set operations."))
    (cond gets (doseq [[nml key] gets] (nmlget tree nml key))
          sets (println (nmlstr (nmlxform tree sets)))
          :else (println (nmlstr tree)))))

use loop/recur

use loop/recur


(ns pushpopchestnutreless.core
  (:require [reagent.core :as reagent :refer [atom]]
            [cljs.pprint :as pp]))

(enable-console-print!)

(defonce app-state
  (atom
    {:stack (list "first" "second")
     :new-item-text ""
     :snooping false}))

(defmulti step
  (fn [_ {:keys [id]}]
   id))

;; UPDATE

(defmethod step :change-new-item-text [state m]
  (assoc state :new-item-text (:text m)))

(defmethod step :push [{:keys [new-item-text] :as state} _]
  (-> state
    (update :stack conj new-item-text)
    (assoc :new-item-text "")))

(defmethod step :pop [state _]
  (update state :stack pop))

(defmethod step :toggle-snoop [state _]
  (update state :snooping not))

; VIEW HELPERS

(defn do-step [msg]
  (swap! app-state step msg))

(defn on-change [msg-id]
  #(do-step {:id msg-id
             :text (-> % .-target .-value)}))

(defn on-click [msg-id]
  #(do-step {:id msg-id}))

;: VIEW

(defn greeting [state]
  [:div
   [:h1 "Push pop"]
   [:div
    [:h2 (first (:stack state))]
    [:button
     {:on-click (on-click :pop)}
     "Pop"]]
   [:div
    [:a
     {:on-click (on-click :toggle-snoop)}
     (if (:snooping state) "peeking..." "peek...")]
    (when (:snooping state)
     (into [:ol]
      (map #(vec [:li %]) (:stack state))))]
   [:div
    [:p (:new-item-text state)]
    [:input
     {:on-change (on-change :change-new-item-text)
      :value (:new-item-text state)}]
    [:button
     {:on-click (on-click :push)}
     "push"]]])

(defn app []
  (.log js/console "render app")
  [greeting @app-state])

(reagent/render [app] (js/document.getElementById "app"))

(ns pushpopchestnutreless.core
  (:require [reagent.core :as reagent :refer [atom]]
            [cljs.pprint :as pp]))

(enable-console-print!)

(defonce app-state
  (atom
    {:stack (list "first" "second")
     :new-item-text ""
     :snooping false}))

(defmulti step
  (fn [_ {:keys [id]}]
   id))

;; UPDATE

(defmethod step :change-new-item-text [state m]
  (assoc state :new-item-text (:text m)))

(defmethod step :push [{:keys [new-item-text] :as state} _]
  (-> state
    (update :stack conj new-item-text)
    (assoc :new-item-text "")))

(defmethod step :pop [state _]
  (update state :stack pop))

(defmethod step :toggle-snoop [state _]
  (update state :snooping not))

; VIEW HELPERS

(defn do-step [msg]
  (swap! app-state step msg))

(defn on-change [msg-id]
  #(do-step {:id msg-id
             :text (-> % .-target .-value)}))

(defn on-click [msg-id]
  #(do-step {:id msg-id}))

;: VIEW

(defn greeting [{:keys [stack] :as state}]
  [:div
   [:h1 "Push pop"]
   [:div
    (if (empty? stack)
     [:h2 "And you're done."]
     [:div
      [:h2 (first stack)]
      [:button
       {:on-click (on-click :pop)}
       "Pop"]])]
   (when (not-empty stack)
    [:div
     [:a
      {:on-click (on-click :toggle-snoop)}
      (if (:snooping state) "peeking..." "peek...")]
     (when (:snooping state)
      (into [:ol]
       (map #(vec [:li %]) (:stack state))))])
   [:div
    [:p (:new-item-text state)]
    [:input
     {:on-change (on-change :change-new-item-text)
      :value (:new-item-text state)}]
    [:button
     {:on-click (on-click :push)}
     "push"]]])

(defn app []
  (.log js/console "render app")
  [greeting @app-state])

(reagent/render [app] (js/document.getElementById "app"))

Hide peek area and pop button when stack is empty


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

(ns uxbox.main.ui.dashboard.images
  (:require [cuerdas.core :as str]
            [lentes.core :as l]
            [uxbox.util.i18n :as t :refer (tr)]
            [uxbox.main.state :as st]
            [uxbox.util.rstore :as rs]
            [uxbox.main.data.lightbox :as udl]
            [uxbox.main.data.images :as di]
            [uxbox.main.ui.icons :as i]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.main.ui.lightbox :as lbx]
            [uxbox.main.ui.keyboard :as kbd]
            [uxbox.main.ui.dashboard.header :refer (header)]
            [uxbox.util.data :as data :refer (read-string)]
            [uxbox.util.dom :as dom]))

;; --- Helpers & Constants

(def +ordering-options+
  {:name "ds.project-ordering.by-name"
   :created "ds.project-ordering.by-creation-date"})

(defn- sort-images-by
  [ordering images]
  (case ordering
    :name (sort-by :name images)
    :created (reverse (sort-by :created-at images))
    images))

(defn- contains-term?
  [phrase term]
  (let [term (name term)]
    (str/includes? (str/lower phrase) (str/trim (str/lower term)))))

(defn- filter-images-by
  [term images]
  (if (str/blank? term)
    images
    (filter #(contains-term? (:name %) term) images)))

;; --- Refs

(def ^:private dashboard-ref
  (-> (l/in [:dashboard :images])
      (l/derive st/state)))

(def ^:private collections-ref
  (-> (l/key :image-colls-by-id)
      (l/derive st/state)))

(def ^:private images-ref
  (-> (l/key :images-by-id)
      (l/derive st/state)))

(def ^:private uploading?-ref
  (-> (l/key :uploading)
      (l/derive dashboard-ref)))

;; --- Page Title

(mx/defcs page-title
  {:mixins [(mx/local {}) mx/static mx/reactive]}
  [own {:keys [id] :as coll}]
  (let [local (:rum/local own)
        dashboard (mx/react dashboard-ref)
        own? (= :builtin (:type coll))
        edit? (:edit @local)]
    (letfn [(on-save [e]
              (let [dom (mx/ref-node own "input")
                    name (.-innerText dom)]
                (rs/emit! (di/rename-collection id (str/trim name)))
                (swap! local assoc :edit false)))
            (on-cancel [e]
              (swap! local assoc :edit false))
            (on-edit [e]
              (swap! local assoc :edit true))
            (on-input-keydown [e]
              (cond
                (kbd/esc? e) (on-cancel e)
                (kbd/enter? e)
                (do
                  (dom/prevent-default e)
                  (dom/stop-propagation e)
                  (on-save e))))

            (delete []
              (rs/emit! (di/delete-collection (:id coll))))
            (on-delete []
              (udl/open! :confirm {:on-accept delete}))]
      [:div.dashboard-title
       [:h2
        (if edit?
          [:div.dashboard-title-field
           [:span.edit
            {:content-editable true
             :ref "input"
             :on-key-down on-input-keydown}
            (:name coll)]
           [:span.close {:on-click on-cancel} i/close]]
          [:span.dashboard-title-field
           {:on-double-click on-edit}
           (:name coll "Storage")])]
       (if (and (not own?) coll)
         [:div.edition
          (if edit?
            [:span {:on-click on-save} i/save]
            [:span {:on-click on-edit} i/pencil])
          [:span {:on-click on-delete} i/trash]])])))

;; --- Nav

(defn react-count-images
  [id]
  (->> (mx/react images-ref)
       (vals)
       (filter #(= id (:collection %)))
       (count)))

(mx/defc nav-item
  {:mixins [mx/static mx/reactive]}
  [{:keys [id type name] :as coll} selected?]
  (letfn [(on-click [event]
            (let [type (or type :own)]
              (rs/emit! (di/select-collection type id))))]
    (let [num-images (react-count-images id)]
      [:li {:on-click on-click
            :class-name (when selected? "current")}
       [:span.element-title
        (if coll name "Storage")]
       [:span.element-subtitle
        (tr "ds.num-elements" (t/c num-images))]])))

(mx/defc nav-section
  {:mixins [mx/static]}
  [type selected colls]
  (let [own? (= type :own)
        builtin? (= type :builtin)
        collections (cond->> (vals colls)
                      own? (filter #(= :own (:type %)))
                      builtin? (filter #(= :builtin (:type %)))
                      own? (sort-by :name))]
    [:ul.library-elements
     (when own?
       [:li
        [:a.btn-primary
         {:on-click #(rs/emit! (di/create-collection))}
         "+ New library"]])
     (when own?
       (nav-item nil (nil? selected)))
     (for [coll collections
           :let [selected? (= (:id coll) selected)
                 key (str (:id coll))]]
       (-> (nav-item coll selected?)
           (mx/with-key key)))]))

(mx/defc nav
  {:mixins [mx/static]}
  [{:keys [type id] :as state} colls]
  (let [own? (= type :own)
        builtin? (= type :builtin)]
    (letfn [(select-tab [type]
              (if own?
                (rs/emit! (di/select-collection type))
                (let [coll (->> (map second colls)
                                 (filter #(= type (:type %)))
                                 (sort-by :name)
                                 (first))]
                  (if coll
                    (rs/emit! (di/select-collection type (:id coll)))
                    (rs/emit! (di/select-collection type))))))]
      [:div.library-bar
       [:div.library-bar-inside
        [:ul.library-tabs
         [:li {:class-name (when own? "current")
               :on-click (partial select-tab :own)}
          "YOUR IMAGES"]
         [:li {:class-name (when builtin? "current")
               :on-click (partial select-tab :builtin)}
          "IMAGES STORE"]]

        (nav-section type id colls)]])))

;; --- Grid

(mx/defcs grid-form
  {:mixins [mx/static mx/reactive]}
  [own coll-id]
  (letfn [(forward-click [event]
            (dom/click (mx/ref-node own "file-input")))
          (on-file-selected [event]
            (let [files (dom/get-event-files event)]
              (rs/emit! (di/create-images coll-id files))))]
    (let [uploading? (mx/react uploading?-ref)]
      [:div.grid-item.add-project {:on-click forward-click}
       (if uploading?
         [:div i/loader-pencil]
         [:span "+ New image"])
       [:input.upload-image-input
        {:style {:display "none"}
         :multiple true
         :ref "file-input"
         :value ""
         :accept "image/jpeg,image/png"
         :type "file"
         :on-change on-file-selected}]])))

(mx/defc grid-options-copy
  {:mixins [mx/reactive mx/static]}
  [current-coll]
  {:pre [(uuid? current-coll)]}
  (let [colls (mx/react collections-ref)
        colls (->> (vals colls)
                   (filter #(= :own (:type %)))
                   (remove #(= current-coll (:id %)))
                   (sort-by :name colls))
        on-select (fn [event id]
                    (dom/prevent-default event)
                    (rs/emit! (di/copy-selected id)))]
    [:ul.move-list
     [:li.title "Copy to library"]
     [:li [:a {:href "#" :on-click #(on-select % nil)} "Storage"]]
     (for [coll colls
           :let [id (:id coll)
                 name (:name coll)]]
       [:li {:key (str id)}
        [:a {:on-click #(on-select % id)} name]])]))

(mx/defc grid-options-move
  {:mixins [mx/reactive mx/static]}
  [current-coll]
  {:pre [(uuid? current-coll)]}
  (let [colls (mx/react collections-ref)
        colls (->> (vals colls)
                   (filter #(= :own (:type %)))
                   (remove #(= current-coll (:id %)))
                   (sort-by :name colls))
        on-select (fn [event id]
                    (println "on-select" event id)
                    (dom/prevent-default event)
                    (rs/emit! (di/move-selected id)))]
    [:ul.move-list
     [:li.title "Move to library"]
     [:li [:a {:href "#" :on-click #(on-select % nil)} "Storage"]]
     (for [coll colls
           :let [id (:id coll)
                 name (:name coll)]]
       [:li {:key (str id)}
        [:a {:on-click #(on-select % id)} name]])]))

(mx/defcs grid-options
  {:mixins [(mx/local) mx/static]}
  [own {:keys [type id] :as coll}]
  (let [editable? (or (= type :own) (nil? coll))
        local (:rum/local own)]
    (letfn [(delete []
              (rs/emit! (di/delete-selected)))
            (on-delete [event]
              (udl/open! :confirm {:on-accept delete}))
            (on-toggle-copy [event]
              (swap! local update :show-copy-tooltip not))
            (on-toggle-move [event]
              (swap! local update :show-move-tooltip not))]
      ;; MULTISELECT OPTIONS BAR
      [:div.multiselect-bar
       (if editable?
         [:div.multiselect-nav
          [:span.move-item.tooltip.tooltip-top
           {:on-click on-toggle-move}
           (when (:show-move-tooltip @local)
             (grid-options-move id))
           i/organize]
          [:span.delete.tooltip.tooltip-top
           {:alt "Delete"
            :on-click on-delete}
           i/trash]]
         [:div.multiselect-nav
          [:span.move-item.tooltip.tooltip-top
           {:on-click on-toggle-copy}
           (when (:show-copy-tooltip @local)
             (grid-options-copy id))
           i/organize]])])))

(mx/defc grid-item
  [{:keys [id] :as image} selected?]
  (letfn [(toggle-selection [event]
            (rs/emit! (di/toggle-image-selection id)))
          (toggle-selection-shifted [event]
            (when (kbd/shift? event)
              (toggle-selection event)))]
    [:div.grid-item.images-th
     {:on-click toggle-selection-shifted}
     [:div.grid-item-th
      {:style {:background-image (str "url('" (:thumbnail image) "')")}}
      [:div.input-checkbox.check-primary
       [:input {:type "checkbox"
                :id (:id image)
                :on-click toggle-selection
                :checked selected?}]
       [:label {:for (:id image)}]]]
     [:span (:name image)]]))

(mx/defc grid
  {:mixins [mx/static mx/reactive]}
  [{:keys [id type selected] :as state}]
  (let [editable? (or (= type :own) (nil? id))
        filtering (:filter state)
        ordering (:order state)
        images (mx/react images-ref)
        images (->> (vals images)
                    (filter #(= id (:collection %)))
                    (filter-images-by filtering)
                    (sort-images-by ordering))]
    [:div.dashboard-grid-content
     [:div.dashboard-grid-row
      (when editable? (grid-form id))
      (for [image images
            :let [id (:id image)
                  selected? (contains? selected id)]]
        (-> (grid-item image selected?)
            (mx/with-key (str id))))]]))

(mx/defc content
  {:mixins [mx/static]}
  [{:keys [type id selected] :as state} coll]
  [:section.dashboard-grid.library
   (page-title coll)
   (grid state)
   (when (seq selected)
     (grid-options coll))])

;; --- Menu

(mx/defc menu
  {:mixins [mx/static mx/reactive]}
  [coll]
  (let [state (mx/react dashboard-ref)
        ordering (:order state :name)
        filtering (:filter state "")
        icount (count (:images coll))]
    (letfn [(on-term-change [event]
              (let [term (-> (dom/get-target event)
                             (dom/get-value))]
                (rs/emit! (di/update-opts :filter term))))
            (on-ordering-change [event]
              (let [value (dom/event->value event)
                    value (read-string value)]
                (rs/emit! (di/update-opts :order value))))
            (on-clear [event]
              (rs/emit! (di/update-opts :filter "")))]
      [:section.dashboard-bar.library-gap
       [:div.dashboard-info

        ;; Counter
        [:span.dashboard-images (tr "ds.num-images" (t/c icount))]

        ;; Sorting
        [:div
         [:span (tr "ds.project-ordering")]
         [:select.input-select
          {:on-change on-ordering-change
           :value (pr-str ordering)}
          (for [[key value] (seq +ordering-options+)
                :let [ovalue (pr-str key)
                      olabel (tr value)]]
            [:option {:key ovalue :value ovalue} olabel])]]
        ;; Search
        [:form.dashboard-search
         [:input.input-text
          {:key :images-search-box
           :type "text"
           :on-change on-term-change
           :auto-focus true
           :placeholder (tr "ds.project-search.placeholder")
           :value (or filtering "")}]
         [:div.clear-search {:on-click on-clear} i/close]]]])))

;; --- Images Page

(defn- images-page-will-mount
  [own]
  (let [[type id] (:rum/args own)]
    (rs/emit! (di/initialize type id))
    own))

(defn- images-page-did-remount
  [old-own own]
  (let [[old-type old-id] (:rum/args old-own)
        [new-type new-id] (:rum/args own)]
    (when (or (not= old-type new-type)
              (not= old-id new-id))
      (rs/emit! (di/initialize new-type new-id)))
    own))

(mx/defc images-page
  {:will-mount images-page-will-mount
   :did-remount images-page-did-remount
   :mixins [mx/static mx/reactive]}
  [_ _]
  (let [state (mx/react dashboard-ref)
        colls (mx/react collections-ref)
        coll (get colls (:id state))]
    [:main.dashboard-main
     (header)
     [:section.dashboard-content
      (nav state colls)
      (menu coll)
      (content state coll)]]))

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

(ns uxbox.main.ui.dashboard.images
  (:require [cuerdas.core :as str]
            [lentes.core :as l]
            [uxbox.util.i18n :as t :refer (tr)]
            [uxbox.main.state :as st]
            [uxbox.util.rstore :as rs]
            [uxbox.main.data.lightbox :as udl]
            [uxbox.main.data.images :as di]
            [uxbox.main.ui.icons :as i]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.main.ui.lightbox :as lbx]
            [uxbox.main.ui.keyboard :as kbd]
            [uxbox.main.ui.dashboard.header :refer (header)]
            [uxbox.util.data :as data :refer (read-string)]
            [uxbox.util.dom :as dom]))

;; --- Helpers & Constants

(def +ordering-options+
  {:name "ds.project-ordering.by-name"
   :created "ds.project-ordering.by-creation-date"})

(defn- sort-images-by
  [ordering images]
  (case ordering
    :name (sort-by :name images)
    :created (reverse (sort-by :created-at images))
    images))

(defn- contains-term?
  [phrase term]
  (let [term (name term)]
    (str/includes? (str/lower phrase) (str/trim (str/lower term)))))

(defn- filter-images-by
  [term images]
  (if (str/blank? term)
    images
    (filter #(contains-term? (:name %) term) images)))

;; --- Refs

(def ^:private dashboard-ref
  (-> (l/in [:dashboard :images])
      (l/derive st/state)))

(def ^:private collections-ref
  (-> (l/key :image-colls-by-id)
      (l/derive st/state)))

(def ^:private images-ref
  (-> (l/key :images-by-id)
      (l/derive st/state)))

(def ^:private uploading?-ref
  (-> (l/key :uploading)
      (l/derive dashboard-ref)))

;; --- Page Title

(mx/defcs page-title
  {:mixins [(mx/local {}) mx/static mx/reactive]}
  [own {:keys [id] :as coll}]
  (let [local (:rum/local own)
        dashboard (mx/react dashboard-ref)
        own? (= :builtin (:type coll))
        edit? (:edit @local)]
    (letfn [(on-save [e]
              (let [dom (mx/ref-node own "input")
                    name (.-innerText dom)]
                (rs/emit! (di/rename-collection id (str/trim name)))
                (swap! local assoc :edit false)))
            (on-cancel [e]
              (swap! local assoc :edit false))
            (on-edit [e]
              (swap! local assoc :edit true))
            (on-input-keydown [e]
              (cond
                (kbd/esc? e) (on-cancel e)
                (kbd/enter? e)
                (do
                  (dom/prevent-default e)
                  (dom/stop-propagation e)
                  (on-save e))))

            (delete []
              (rs/emit! (di/delete-collection (:id coll))))
            (on-delete []
              (udl/open! :confirm {:on-accept delete}))]
      [:div.dashboard-title
       [:h2
        (if edit?
          [:div.dashboard-title-field
           [:span.edit
            {:content-editable true
             :ref "input"
             :on-key-down on-input-keydown}
            (:name coll)]
           [:span.close {:on-click on-cancel} i/close]]
          [:span.dashboard-title-field
           {:on-double-click on-edit}
           (:name coll "Storage")])]
       (if (and (not own?) coll)
         [:div.edition
          (if edit?
            [:span {:on-click on-save} i/save]
            [:span {:on-click on-edit} i/pencil])
          [:span {:on-click on-delete} i/trash]])])))

;; --- Nav

(defn react-count-images
  [id]
  (->> (mx/react images-ref)
       (vals)
       (filter #(= id (:collection %)))
       (count)))

(mx/defc nav-item
  {:mixins [mx/static mx/reactive]}
  [{:keys [id type name] :as coll} selected?]
  (letfn [(on-click [event]
            (let [type (or type :own)]
              (rs/emit! (di/select-collection type id))))]
    (let [num-images (react-count-images id)]
      [:li {:on-click on-click
            :class-name (when selected? "current")}
       [:span.element-title
        (if coll name "Storage")]
       [:span.element-subtitle
        (tr "ds.num-elements" (t/c num-images))]])))

(mx/defc nav-section
  {:mixins [mx/static]}
  [type selected colls]
  (let [own? (= type :own)
        builtin? (= type :builtin)
        collections (cond->> (vals colls)
                      own? (filter #(= :own (:type %)))
                      builtin? (filter #(= :builtin (:type %)))
                      own? (sort-by :name))]
    [:ul.library-elements
     (when own?
       [:li
        [:a.btn-primary
         {:on-click #(rs/emit! (di/create-collection))}
         "+ New library"]])
     (when own?
       (nav-item nil (nil? selected)))
     (for [coll collections
           :let [selected? (= (:id coll) selected)
                 key (str (:id coll))]]
       (-> (nav-item coll selected?)
           (mx/with-key key)))]))

(mx/defc nav
  {:mixins [mx/static]}
  [{:keys [type id] :as state} colls]
  (let [own? (= type :own)
        builtin? (= type :builtin)]
    (letfn [(select-tab [type]
              (if own?
                (rs/emit! (di/select-collection type))
                (let [coll (->> (map second colls)
                                 (filter #(= type (:type %)))
                                 (sort-by :name)
                                 (first))]
                  (if coll
                    (rs/emit! (di/select-collection type (:id coll)))
                    (rs/emit! (di/select-collection type))))))]
      [:div.library-bar
       [:div.library-bar-inside
        [:ul.library-tabs
         [:li {:class-name (when own? "current")
               :on-click (partial select-tab :own)}
          "YOUR IMAGES"]
         [:li {:class-name (when builtin? "current")
               :on-click (partial select-tab :builtin)}
          "IMAGES STORE"]]

        (nav-section type id colls)]])))

;; --- Grid

(mx/defcs grid-form
  {:mixins [mx/static mx/reactive]}
  [own coll-id]
  (letfn [(forward-click [event]
            (dom/click (mx/ref-node own "file-input")))
          (on-file-selected [event]
            (let [files (dom/get-event-files event)]
              (rs/emit! (di/create-images coll-id files))))]
    (let [uploading? (mx/react uploading?-ref)]
      [:div.grid-item.add-project {:on-click forward-click}
       (if uploading?
         [:div i/loader-pencil]
         [:span "+ New image"])
       [:input.upload-image-input
        {:style {:display "none"}
         :multiple true
         :ref "file-input"
         :value ""
         :accept "image/jpeg,image/png"
         :type "file"
         :on-change on-file-selected}]])))

(mx/defc grid-options-copy
  {:mixins [mx/reactive mx/static]}
  [current-coll]
  {:pre [(uuid? current-coll)]}
  (let [colls (mx/react collections-ref)
        colls (->> (vals colls)
                   (filter #(= :own (:type %)))
                   (remove #(= current-coll (:id %)))
                   (sort-by :name colls))
        on-select (fn [event id]
                    (dom/prevent-default event)
                    (rs/emit! (di/copy-selected id)))]
    [:ul.move-list
     [:li.title "Copy to library"]
     [:li [:a {:href "#" :on-click #(on-select % nil)} "Storage"]]
     (for [coll colls
           :let [id (:id coll)
                 name (:name coll)]]
       [:li {:key (str id)}
        [:a {:on-click #(on-select % id)} name]])]))

(mx/defc grid-options-move
  {:mixins [mx/reactive mx/static]}
  [current-coll]
  {:pre [(uuid? current-coll)]}
  (let [colls (mx/react collections-ref)
        colls (->> (vals colls)
                   (filter #(= :own (:type %)))
                   (remove #(= current-coll (:id %)))
                   (sort-by :name colls))
        on-select (fn [event id]
                    (println "on-select" event id)
                    (dom/prevent-default event)
                    (rs/emit! (di/move-selected id)))]
    [:ul.move-list
     [:li.title "Move to library"]
     [:li [:a {:href "#" :on-click #(on-select % nil)} "Storage"]]
     (for [coll colls
           :let [id (:id coll)
                 name (:name coll)]]
       [:li {:key (str id)}
        [:a {:on-click #(on-select % id)} name]])]))

(mx/defcs grid-options
  {:mixins [(mx/local) mx/static]}
  [own {:keys [type id] :as coll}]
  (let [editable? (or (= type :own) (nil? coll))
        local (:rum/local own)]
    (letfn [(delete []
              (rs/emit! (di/delete-selected)))
            (on-delete [event]
              (udl/open! :confirm {:on-accept delete}))
            (on-toggle-copy [event]
              (swap! local update :show-copy-tooltip not))
            (on-toggle-move [event]
              (swap! local update :show-move-tooltip not))]
      ;; MULTISELECT OPTIONS BAR
      [:div.multiselect-bar
       (if editable?
         [:div.multiselect-nav
          [:span.move-item.tooltip.tooltip-top
           {:on-click on-toggle-move}
           (when (:show-move-tooltip @local)
             (grid-options-move id))
           i/organize]
          [:span.delete.tooltip.tooltip-top
           {:alt "Delete"
            :on-click on-delete}
           i/trash]]
         [:div.multiselect-nav
          [:span.move-item.tooltip.tooltip-top
           {:on-click on-toggle-copy}
           (when (:show-copy-tooltip @local)
             (grid-options-copy id))
           i/organize]])])))

(mx/defc grid-item
  [{:keys [id] :as image} selected?]
  (letfn [(toggle-selection [event]
            (rs/emit! (di/toggle-image-selection id)))
          (toggle-selection-shifted [event]
            (when (kbd/shift? event)
              (toggle-selection event)))]
    [:div.grid-item.images-th
     {:on-click toggle-selection-shifted}
     [:div.grid-item-th
      {:style {:background-image (str "url('" (:thumbnail image) "')")}}
      [:div.input-checkbox.check-primary
       [:input {:type "checkbox"
                :id (:id image)
                :on-click toggle-selection
                :checked selected?}]
       [:label {:for (:id image)}]]]
     [:span (:name image)]]))

(mx/defc grid
  {:mixins [mx/static mx/reactive]}
  [{:keys [id type selected] :as state}]
  (let [editable? (or (= type :own) (nil? id))
        filtering (:filter state)
        ordering (:order state)
        images (mx/react images-ref)
        images (->> (vals images)
                    (filter #(= id (:collection %)))
                    (filter-images-by filtering)
                    (sort-images-by ordering))]
    [:div.dashboard-grid-content
     [:div.dashboard-grid-row
      (when editable? (grid-form id))
      (for [image images
            :let [id (:id image)
                  selected? (contains? selected id)]]
        (-> (grid-item image selected?)
            (mx/with-key (str id))))]]))

(mx/defc content
  {:mixins [mx/static]}
  [{:keys [selected] :as state} coll]
  [:section.dashboard-grid.library
   (page-title coll)
   (grid state)
   (when (seq selected)
     (grid-options coll))])

;; --- Menu

(mx/defc menu
  {:mixins [mx/static mx/reactive]}
  [coll]
  (let [state (mx/react dashboard-ref)
        ordering (:order state :name)
        filtering (:filter state "")
        icount (count (:images coll))]
    (letfn [(on-term-change [event]
              (let [term (-> (dom/get-target event)
                             (dom/get-value))]
                (rs/emit! (di/update-opts :filter term))))
            (on-ordering-change [event]
              (let [value (dom/event->value event)
                    value (read-string value)]
                (rs/emit! (di/update-opts :order value))))
            (on-clear [event]
              (rs/emit! (di/update-opts :filter "")))]
      [:section.dashboard-bar.library-gap
       [:div.dashboard-info

        ;; Counter
        [:span.dashboard-images (tr "ds.num-images" (t/c icount))]

        ;; Sorting
        [:div
         [:span (tr "ds.project-ordering")]
         [:select.input-select
          {:on-change on-ordering-change
           :value (pr-str ordering)}
          (for [[key value] (seq +ordering-options+)
                :let [ovalue (pr-str key)
                      olabel (tr value)]]
            [:option {:key ovalue :value ovalue} olabel])]]
        ;; Search
        [:form.dashboard-search
         [:input.input-text
          {:key :images-search-box
           :type "text"
           :on-change on-term-change
           :auto-focus true
           :placeholder (tr "ds.project-search.placeholder")
           :value (or filtering "")}]
         [:div.clear-search {:on-click on-clear} i/close]]]])))

;; --- Images Page

(defn- images-page-will-mount
  [own]
  (let [[type id] (:rum/args own)]
    (rs/emit! (di/initialize type id))
    own))

(defn- images-page-did-remount
  [old-own own]
  (let [[old-type old-id] (:rum/args old-own)
        [new-type new-id] (:rum/args own)]
    (when (or (not= old-type new-type)
              (not= old-id new-id))
      (rs/emit! (di/initialize new-type new-id)))
    own))

(mx/defc images-page
  {:will-mount images-page-will-mount
   :did-remount images-page-did-remount
   :mixins [mx/static mx/reactive]}
  [_ _]
  (let [state (mx/react dashboard-ref)
        colls (mx/react collections-ref)
        coll (get colls (:id state))]
    [:main.dashboard-main
     (header)
     [:section.dashboard-content
      (nav state colls)
      (menu coll)
      (content state coll)]]))

Remove useless destructuring binding on content component (images page).


(ns juzi.core
  (:require [clojure.java.shell :refer [sh]]
            [juzi.session :as s])
  (:import [jline.console ConsoleReader]))

(defn clear-screen []
  (print (str (char 27) "[2J"))
  (print (str (char 27) "[;H")))

(defn load-source [path]
  (->> path
       (slurp)
       (read-string)))

(defn load-sources []
  (mapcat load-source ["resources/word.edn" "resources/sentence.edn"]))

(defn expand-data [data]
  (map #(zipmap [:en :zh] %) data))

(defn start []
  (clear-screen)
  (let [cr (ConsoleReader.)]
    (println "Press 'y' if you know how to say Chinese sentence for this following English sentence, press something else otherwise.")
    (println "Ready? Press any key to continue ...")
    (.readCharacter cr)
    (clear-screen)
    (loop [s (s/make-session (expand-data (load-sources)))]
      (if-let [w (s/next-word s)]
        (let [{:keys [id en zh]} w]
          (println en)
          (flush)
          (let [i (.readCharacter cr)]
            (if (= \y (char i))
              (do (clear-screen)
                  (recur (s/mark-passed s id)))
              (do (println "ans:" zh)
                  (.readCharacter cr)
                  (clear-screen)
                  (recur s)))))
        (println "You have passed all the words! Gōngxǐ. Zàijiàn.")))))

(ns juzi.core
  (:require [clojure.java.shell :refer [sh]]
            [juzi.session :as s])
  (:import [jline.console ConsoleReader]))

(defn clear-screen []
  (print (str (char 27) "[2J"))
  (print (str (char 27) "[;H")))

(defn load-source [path]
  (->> path
       (slurp)
       (read-string)))

(defn load-sources []
  (mapcat load-source ["resources/word.edn" "resources/sentence.edn"]))

(defn expand-data [data]
  (map #(zipmap [:en :zh] %) data))

(defn start []
  (clear-screen)
  (let [cr (ConsoleReader.)]
    (println "Press 'y' if you know how to say Chinese word/sentence for this following English word/sentence, press something else otherwise.")
    (println "Ready? Press any key to continue ...")
    (.readCharacter cr)
    (clear-screen)
    (loop [s (s/make-session (expand-data (load-sources)))]
      (if-let [w (s/next-word s)]
        (let [{:keys [id en zh]} w]
          (println en)
          (flush)
          (let [i (.readCharacter cr)]
            (if (= \y (char i))
              (do (clear-screen)
                  (recur (s/mark-passed s id)))
              (do (println "ans:" zh)
                  (.readCharacter cr)
                  (clear-screen)
                  (recur s)))))
        (println "You have passed all the words! Gōngxǐ. Zàijiàn.")))))

Modify explanation

Modify explanation


(ns kiln.core
  (:gen-class)
  (:use stencil.core)
  (:import [java.net URLEncoder])
  (:require [clojure.data.json :as json]
      [markdown.core :as markdown]
      [clj-time.core :as timet]
      [clj-time.coerce :as timec]
      [clj-time.format :as timef]
      [clj-rss.core :as rss]
      ))

(def config (read-string (slurp "./_config.clj")))

(def all-article (atom
  (let [data-clj (str (:output config) "/.data.clj")]
    (if (.isFile (clojure.java.io/file data-clj))
      (read-string (slurp data-clj))
      {}))
))

(defn- load-template
  "加载模板文件"
  [tid]
  (let [template-file (clojure.java.io/file (str (:template config) "/" tid ".mustache"))
        resource-file (clojure.java.io/resource (str "templates/" tid ".mustache"))]
    (if (and (contains? config :template) (.isFile template-file))
      (slurp template-file)
      (or (slurp resource-file) "not found template-file"))))

(defn- only-markdown
  " 过滤出目录中的 markdown 文件"
  [file-s]
  (filter #(and (.isFile %) (re-find #".md$" (.getName %))) file-s))

(defn- only-update
  "过滤出需要更新的markdown文件"
  [file-s]
  (filter
    (fn [f]
      (let [html-file (clojure.java.io/file (str (:output config) "/article/" (clojure.string/replace (.getName f) #".md$" "") ".html"))]
       (or (not (.isFile html-file)) (< (.lastModified html-file) (.lastModified f)))))
    file-s))

(def blogdate-formatter
  (timef/formatter
    (timet/default-time-zone)
    "YYYY-MM-dd HH:mm:ss"
    "YYYY-MM-dd"
    "YYYY/MM/dd"
    "YYYY-MM-dd HH"
    "YYYY-MM-dd HH:mm"
    ))
(defn- read-markdown
  "读取文章内容"
  [md-file]
  (with-open [rdr (clojure.java.io/reader (.getPath md-file))]
    (let [lines (line-seq rdr)
        meta-lines (take-while #(re-matches #"^[\w\s]+:(.+)$" %) lines)
        md-string (clojure.string/join "\n" (drop (count meta-lines) lines))
        html-content (markdown/md-to-html-string md-string)
        meta-dict
          (merge
           {:date (timec/from-long (.lastModified md-file))}
           (into
             {}
             (for [[_ k v] (map #(re-matches #"^[\s]*([\w]+)[\s]*:[\s]*(.+)[\s]*$" %) meta-lines)]
               [
                (keyword (clojure.string/lower-case (clojure.string/trim k)))
                (cond
                  (= k "tags") (set (filter #(not (clojure.string/blank? %1)) (map clojure.string/trim (clojure.string/split v #","))))
                  (= k "date") (timec/to-long (timef/parse blogdate-formatter (clojure.string/trim v)))
                  :else v
                  )
                ]))) ]
         {
          :meta-dict meta-dict
          :md-string md-string
          :html-content html-content
         }
         )))
(defn- generation
  "生成 html 文件"
  [md-file]
  (let [{meta-dict :meta-dict md-string :md-string html-content :html-content} (read-markdown md-file)
        id (clojure.string/replace (.getName md-file) #".md$" "")
        html-file (str "/article/" id ".html")]
      (spit (str (:output config) html-file)
        (render-string
          (load-template "article")
          (merge
            config
            meta-dict
            {:tags (map #(hash-map :name %1, :urlcode (URLEncoder/encode %1 "UTF-8")) (get meta-dict :tags #{}))
             :date (timef/unparse
                    (timef/formatter (timet/default-time-zone) "YYYY-MM-dd" "YYYY/MM/dd")
                    (timec/from-long (:date meta-dict)))
             :content html-content })
          ))
      (swap! all-article assoc id (select-keys meta-dict [:title :date :tags]))
      id
      ))

(defn- spit-index
  "把有改动部分文章更新到索引文件中，包括index.html和/tags/*.html"
  [id-list]
  (if (not (empty? id-list))
  (let [last-tags (reduce #(clojure.set/union %1 %2) #{} (map #(get %1 :tags #{}) (vals (select-keys @all-article id-list))))
        all-articles (reverse (sort-by :date (map #(assoc (last %1) :urlcode (URLEncoder/encode (str (first %1)) "UTF-8") :id (first %1)) @all-article)))
        all-tags (frequencies (apply concat (map :tags #_(get %1 :tags #{}) (vals @all-article))))
        max-weight (apply max (conj (vals all-tags) 10))]
    ;更新首页
    (println "->" "/index.html")
    (spit (str (:output config) "/index.html")
      (render-string
        (load-template "index")
        (merge
          config
          {:tags (map
                   #(hash-map
                      :name (first %1),
                      :urlcode (URLEncoder/encode (str (first %1)) "UTF-8")
                      :weight (format "%.1f" (float (+ 1 (* (/ (last %1) max-weight) 5))))
                      ) all-tags)
           :articles (take 20 all_articles)})))
    ;rss
    (let [sort-article-list (take 10 all-articles)]
      (println "->" "/rss.xml")
      (spit (str (:output config) "/rss.xml")
            (rss/channel-xml
              {
               :title (get config :blog-name)
               :link (get config :blog-url)
               :description (get config :blog-description)
               :language (get config :blog-language "zh-CN")
               :lastBuildDate (timec/to-date (timet/now))
              }
              (map #(hash-map
                      :title (str "<![CDATA[ " (get %1 :title "None") " ]]>")
                      :pubDate (timec/to-date (timec/from-long (:date %1)))
                      :guid (str (:blog-url config) "/article/" (:urlcode %1) ".html")
                      :link (str (:blog-url config) "/article/" (:urlcode %1) ".html")
                      :description (str "<![CDATA[ " (:html-content (read-markdown (clojure.java.io/file (str (:input config) "/" (:id %1) ".md")))) " ]]>"))
                   sort-article-list))))
    ;更新tag页
    (doseq [tag last-tags]
      (println "->" (str "/tag/" tag ".html"))
      (spit (str (:output config) "/tag/" tag ".html")
        (render-string
          (load-template "tag")
          (merge config
            {:article-list
              (reverse (sort-by :date (filter
                #(contains? (get %1 :tags #{}) tag)
                (map #(merge (last %1)
                        {:id (first %1)
                         :urlid (URLEncoder/encode (first %1) "UTF-8")
                         :date (timef/unparse
                                (timef/formatter (timet/default-time-zone) "YYYY-MM-dd" "YYYY/MM/dd")
                                (timec/from-long (:date (last %1))))
                         }) @all-article))))
             :title tag})))))))

(defn -main
  "I don't do a whole lot ... yet."
  [& args]
  (.mkdirs (java.io.File. (str (:output config) "/article/")))
  (.mkdirs (java.io.File. (str (:output config) "/tag/")))
  (if (contains? config :template) (.mkdirs (java.io.File. (:template config))))
  (spit-index
    (mapv
      #(do
         (println "->" (.getName %1))
         (generation %1))
      (-> (:input config)
          clojure.java.io/file
          file-seq
          only-markdown
          only-update)))
  (spit (str (:output config) "/.data.clj") (pr-str @all-article))
  (println "done"))

(ns kiln.core
  (:gen-class)
  (:use stencil.core)
  (:import [java.net URLEncoder])
  (:require [clojure.data.json :as json]
      [markdown.core :as markdown]
      [clj-time.core :as timet]
      [clj-time.coerce :as timec]
      [clj-time.format :as timef]
      [clj-rss.core :as rss]
      ))

(def config (read-string (slurp "./_config.clj")))

(def all-article (atom
  (let [data-clj (str (:output config) "/.data.clj")]
    (if (.isFile (clojure.java.io/file data-clj))
      (read-string (slurp data-clj))
      {}))
))

(defn- load-template
  "加载模板文件"
  [tid]
  (let [template-file (clojure.java.io/file (str (:template config) "/" tid ".mustache"))
        resource-file (clojure.java.io/resource (str "templates/" tid ".mustache"))]
    (if (and (contains? config :template) (.isFile template-file))
      (slurp template-file)
      (or (slurp resource-file) "not found template-file"))))

(defn- only-markdown
  " 过滤出目录中的 markdown 文件"
  [file-s]
  (filter #(and (.isFile %) (re-find #".md$" (.getName %))) file-s))

(defn- only-update
  "过滤出需要更新的markdown文件"
  [file-s]
  (filter
    (fn [f]
      (let [html-file (clojure.java.io/file (str (:output config) "/article/" (clojure.string/replace (.getName f) #".md$" "") ".html"))]
       (or (not (.isFile html-file)) (< (.lastModified html-file) (.lastModified f)))))
    file-s))

(def blogdate-formatter
  (timef/formatter
    (timet/default-time-zone)
    "YYYY-MM-dd HH:mm:ss"
    "YYYY-MM-dd"
    "YYYY/MM/dd"
    "YYYY-MM-dd HH"
    "YYYY-MM-dd HH:mm"
    ))
(defn- read-markdown
  "读取文章内容"
  [md-file]
  (with-open [rdr (clojure.java.io/reader (.getPath md-file))]
    (let [lines (line-seq rdr)
        meta-lines (take-while #(re-matches #"^[\w\s]+:(.+)$" %) lines)
        md-string (clojure.string/join "\n" (drop (count meta-lines) lines))
        html-content (markdown/md-to-html-string md-string)
        meta-dict
          (merge
           {:date (timec/from-long (.lastModified md-file))}
           (into
             {}
             (for [[_ k v] (map #(re-matches #"^[\s]*([\w]+)[\s]*:[\s]*(.+)[\s]*$" %) meta-lines)]
               [
                (keyword (clojure.string/lower-case (clojure.string/trim k)))
                (cond
                  (= k "tags") (set (filter #(not (clojure.string/blank? %1)) (map clojure.string/trim (clojure.string/split v #","))))
                  (= k "date") (timec/to-long (timef/parse blogdate-formatter (clojure.string/trim v)))
                  :else v
                  )
                ]))) ]
         {
          :meta-dict meta-dict
          :md-string md-string
          :html-content html-content
         }
         )))
(defn- generation
  "生成 html 文件"
  [md-file]
  (let [{meta-dict :meta-dict md-string :md-string html-content :html-content} (read-markdown md-file)
        id (clojure.string/replace (.getName md-file) #".md$" "")
        html-file (str "/article/" id ".html")]
      (spit (str (:output config) html-file)
        (render-string
          (load-template "article")
          (merge
            config
            meta-dict
            {:tags (map #(hash-map :name %1, :urlcode (URLEncoder/encode %1 "UTF-8")) (get meta-dict :tags #{}))
             :date (timef/unparse
                    (timef/formatter (timet/default-time-zone) "YYYY-MM-dd" "YYYY/MM/dd")
                    (timec/from-long (:date meta-dict)))
             :content html-content })
          ))
      (swap! all-article assoc id (select-keys meta-dict [:title :date :tags]))
      id
      ))

(defn- spit-index
  "把有改动部分文章更新到索引文件中，包括index.html和/tags/*.html"
  [id-list]
  (if (not (empty? id-list))
  (let [last-tags (reduce #(clojure.set/union %1 %2) #{} (map #(get %1 :tags #{}) (vals (select-keys @all-article id-list))))
        all-articles (reverse (sort-by :date (map #(assoc (last %1) :urlcode (URLEncoder/encode (str (first %1)) "UTF-8") :id (first %1)) @all-article)))
        all-tags (frequencies (apply concat (map :tags #_(get %1 :tags #{}) (vals @all-article))))
        max-weight (apply max (conj (vals all-tags) 10))]
    ;更新首页
    (println "->" "/index.html")
    (spit (str (:output config) "/index.html")
      (render-string
        (load-template "index")
        (merge
          config
          {:tags (map
                   #(hash-map
                      :name (first %1),
                      :urlcode (URLEncoder/encode (str (first %1)) "UTF-8")
                      :weight (format "%.1f" (float (+ 1 (* (/ (last %1) max-weight) 5))))
                      ) all-tags)
           :articles (take 20 all-articles)})))
    ;rss
    (let [sort-article-list (take 10 all-articles)]
      (println "->" "/rss.xml")
      (spit (str (:output config) "/rss.xml")
            (rss/channel-xml
              {
               :title (get config :blog-name)
               :link (get config :blog-url)
               :description (get config :blog-description)
               :language (get config :blog-language "zh-CN")
               :lastBuildDate (timec/to-date (timet/now))
              }
              (map #(hash-map
                      :title (str "<![CDATA[ " (get %1 :title "None") " ]]>")
                      :pubDate (timec/to-date (timec/from-long (:date %1)))
                      :guid (str (:blog-url config) "/article/" (:urlcode %1) ".html")
                      :link (str (:blog-url config) "/article/" (:urlcode %1) ".html")
                      :description (str "<![CDATA[ " (:html-content (read-markdown (clojure.java.io/file (str (:input config) "/" (:id %1) ".md")))) " ]]>"))
                   sort-article-list))))
    ;更新tag页
    (doseq [tag last-tags]
      (println "->" (str "/tag/" tag ".html"))
      (spit (str (:output config) "/tag/" tag ".html")
        (render-string
          (load-template "tag")
          (merge config
            {:article-list
              (reverse (sort-by :date (filter
                #(contains? (get %1 :tags #{}) tag)
                (map #(merge (last %1)
                        {:id (first %1)
                         :urlid (URLEncoder/encode (first %1) "UTF-8")
                         :date (timef/unparse
                                (timef/formatter (timet/default-time-zone) "YYYY-MM-dd" "YYYY/MM/dd")
                                (timec/from-long (:date (last %1))))
                         }) @all-article))))
             :title tag})))))))

(defn -main
  "I don't do a whole lot ... yet."
  [& args]
  (.mkdirs (java.io.File. (str (:output config) "/article/")))
  (.mkdirs (java.io.File. (str (:output config) "/tag/")))
  (if (contains? config :template) (.mkdirs (java.io.File. (:template config))))
  (spit-index
    (mapv
      #(do
         (println "->" (.getName %1))
         (generation %1))
      (-> (:input config)
          clojure.java.io/file
          file-seq
          only-markdown
          only-update)))
  (spit (str (:output config) "/.data.clj") (pr-str @all-article))
  (println "done"))

index 增加列表

index 增加列表