(ns org.akvo.flow-api.datastore.survey
  (:refer-clojure :exclude [list list*])
  (:require [clojure.core.cache :as cache]
            clojure.set
            [org.akvo.flow-api.anomaly :as anomaly]
            [org.akvo.flow-api.datastore :as ds])
  (:import [com.gallatinsystems.survey.domain SurveyGroup]
           [com.google.appengine.api.datastore DatastoreService Entity Key KeyFactory QueryResultIterator]
           [org.akvo.flow.api.dao FolderDAO SurveyDAO]
           [org.apache.commons.lang ArrayUtils]))

(defn list*
  [user-id]
  (let [survey-dao (SurveyDAO.)
        all-surveys (.listAll survey-dao)]
    (.filterByUserAuthorizationObjectId survey-dao all-surveys user-id)))

(defn list-by-ids
  [user-id survey-ids]
  (let [survey-dao (SurveyDAO.)
        all-surveys (.listByKeys survey-dao (ArrayUtils/toObject (long-array survey-ids)))]
    (.filterByUserAuthorizationObjectId survey-dao all-surveys user-id)))

(defn list-by-folder [user-id folder-id]
  (->>
    (list* user-id)
    (map (fn [survey]
           {:id (str (ds/id survey))
            :name (.getName survey)
            :folder-id (str (.getParentId survey))
            :created-at (ds/created-at survey)
            :modified-at (ds/modified-at survey)}))
    (filter #(= (:folder-id %) folder-id))))

(defn list-forms-by-ids
  [user-id form-ids]
  (let [form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
        all-forms (.listByKeys form-dao (ArrayUtils/toObject (long-array form-ids)))]
    (.filterByUserAuthorizationObjectId form-dao all-forms user-id)))

(defn ->question [question]
  (let [type* (str (.getType question))]
    (merge
     {:id (str (ds/id question))
      :name (.getText question)
      :type type*
      :order (.getOrder question)
      :variable-name (.getVariableName question)
      :created-at (ds/created-at question)
      :modified-at (ds/modified-at question)}
     (when (= type* "CADDISFLY")
       {:caddisfly-resource-uuid (.getCaddisflyResourceUuid question)}))))

(defn question-group-definition [question-group questions]
  (let [qs (sort-by :order (map ->question questions))]
    {:id (str (ds/id question-group))
     :name (.getName question-group)
     :repeatable (boolean (.getRepeatable question-group))
     :questions qs
     :created-at (ds/created-at question-group)
     :modified-at (ds/modified-at question-group)}))

(defn get-form-definition
  ([form-id]
   (get-form-definition form-id {}))
  ([form-id {:keys [include-survey-id?]}]
   (let [form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
         ;; Includes question groups, but contrary to docstring does not contain questions
         form (.loadFullSurvey form-dao form-id)
         question-dao (com.gallatinsystems.survey.dao.QuestionDao.)
         questions (group-by #(.getQuestionGroupId %)
                             (.listQuestionsBySurvey question-dao form-id))]
     (cond->
         {:id (str form-id)
          :name (.getName form)
          :question-groups (mapv (fn [question-group]
                                   (question-group-definition question-group
                                                              (get questions (ds/id question-group))))
                                 (.values (.getQuestionGroupMap form)))
          :created-at (ds/created-at form)
          :modified-at (ds/modified-at form)}
       include-survey-id? (assoc :survey-id (str (.getSurveyGroupId form)))))))

(defn by-id [user-id survey-id]
  (let [survey-dao (com.gallatinsystems.survey.dao.SurveyGroupDAO.)
        survey (if-let [survey (.getByKey survey-dao (Long/parseLong survey-id))]
                 survey
                 (anomaly/not-found "Survey not found"
                                    {:survey-id survey-id}))
        registration-form-id (.getNewLocaleSurveyId survey)
        form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
        all-forms (.listSurveysByGroup form-dao (Long/parseLong survey-id))
        forms (.filterByUserAuthorizationObjectId form-dao
                                                  all-forms
                                                  user-id)]
    (if (and (not-empty all-forms) (empty? forms))
      (anomaly/unauthorized "Not Authorized"
                            {:survey-id survey-id
                             :user-id user-id})
      {:id survey-id
       :name (.getName survey)
       :registration-form-id (str registration-form-id)
       :forms (mapv #(get-form-definition (ds/id %)) forms)
       :created-at (ds/created-at survey)
       :modified-at (ds/modified-at survey)})))

(defn keep-allowed-to-see [surveys-to-permission surveys-allowed-per-instance]
  (let [instance->survey-set (into {}
                               (map (fn [{:keys [instance-id survey-ids]}]
                                      [instance-id (set survey-ids)])
                                 surveys-allowed-per-instance))]
    (filter
      (fn [{:keys [instance-id survey-id]}]
        (contains? (get instance->survey-set instance-id) survey-id))
      surveys-to-permission)))

(defn survey->map
  [^SurveyGroup survey]
  {:id (str (ds/id survey))
   :name (.getName survey)
   :registration-form-id (str (.getNewLocaleSurveyId survey))
   :created-at (ds/created-at survey)
   :modified-at (ds/modified-at survey)})

(ns org.akvo.flow-api.datastore.survey
  (:refer-clojure :exclude [list list*])
  (:require [clojure.core.cache :as cache]
            clojure.set
            [org.akvo.flow-api.anomaly :as anomaly]
            [org.akvo.flow-api.datastore :as ds])
  (:import [com.gallatinsystems.survey.domain SurveyGroup]
           [com.google.appengine.api.datastore DatastoreService Entity Key KeyFactory QueryResultIterator]
           [org.akvo.flow.api.dao FolderDAO SurveyDAO]
           [org.apache.commons.lang ArrayUtils]))

(defn list*
  [user-id]
  (let [survey-dao (SurveyDAO.)
        all-surveys (.listAll survey-dao)]
    (.filterByUserAuthorizationObjectId survey-dao all-surveys user-id)))

(defn list-by-ids
  [user-id survey-ids]
  (let [survey-dao (SurveyDAO.)
        all-surveys (.listByKeys survey-dao (ArrayUtils/toObject (long-array survey-ids)))]
    (.filterByUserAuthorizationObjectId survey-dao all-surveys user-id)))

(defn list-by-folder [user-id folder-id]
  (->>
    (list* user-id)
    (map (fn [survey]
           {:id (str (ds/id survey))
            :name (.getName survey)
            :folder-id (str (.getParentId survey))
            :created-at (ds/created-at survey)
            :modified-at (ds/modified-at survey)}))
    (filter #(= (:folder-id %) folder-id))))

(defn list-forms-by-ids
  [user-id form-ids]
  (let [form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
        all-forms (.listByKeys form-dao (ArrayUtils/toObject (long-array form-ids)))]
    (.filterByUserAuthorizationObjectId form-dao all-forms user-id)))

(defn ->question [question]
  (let [type* (str (.getType question))]
    (merge
     {:id (str (ds/id question))
      :name (.getText question)
      :type type*
      :order (.getOrder question)
      :variable-name (.getVariableName question)
      :personal-data (.getPersonalData question)
      :created-at (ds/created-at question)
      :modified-at (ds/modified-at question)}
     (when (= type* "CADDISFLY")
       {:caddisfly-resource-uuid (.getCaddisflyResourceUuid question)}))))

(defn question-group-definition [question-group questions]
  (let [qs (sort-by :order (map ->question questions))]
    {:id (str (ds/id question-group))
     :name (.getName question-group)
     :repeatable (boolean (.getRepeatable question-group))
     :questions qs
     :created-at (ds/created-at question-group)
     :modified-at (ds/modified-at question-group)}))

(defn get-form-definition
  ([form-id]
   (get-form-definition form-id {}))
  ([form-id {:keys [include-survey-id?]}]
   (let [form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
         ;; Includes question groups, but contrary to docstring does not contain questions
         form (.loadFullSurvey form-dao form-id)
         question-dao (com.gallatinsystems.survey.dao.QuestionDao.)
         questions (group-by #(.getQuestionGroupId %)
                             (.listQuestionsBySurvey question-dao form-id))]
     (cond->
         {:id (str form-id)
          :name (.getName form)
          :question-groups (mapv (fn [question-group]
                                   (question-group-definition question-group
                                                              (get questions (ds/id question-group))))
                                 (.values (.getQuestionGroupMap form)))
          :created-at (ds/created-at form)
          :modified-at (ds/modified-at form)}
       include-survey-id? (assoc :survey-id (str (.getSurveyGroupId form)))))))

(defn by-id [user-id survey-id]
  (let [survey-dao (com.gallatinsystems.survey.dao.SurveyGroupDAO.)
        survey (if-let [survey (.getByKey survey-dao (Long/parseLong survey-id))]
                 survey
                 (anomaly/not-found "Survey not found"
                                    {:survey-id survey-id}))
        registration-form-id (.getNewLocaleSurveyId survey)
        form-dao (com.gallatinsystems.survey.dao.SurveyDAO.)
        all-forms (.listSurveysByGroup form-dao (Long/parseLong survey-id))
        forms (.filterByUserAuthorizationObjectId form-dao
                                                  all-forms
                                                  user-id)]
    (if (and (not-empty all-forms) (empty? forms))
      (anomaly/unauthorized "Not Authorized"
                            {:survey-id survey-id
                             :user-id user-id})
      {:id survey-id
       :name (.getName survey)
       :registration-form-id (str registration-form-id)
       :forms (mapv #(get-form-definition (ds/id %)) forms)
       :created-at (ds/created-at survey)
       :modified-at (ds/modified-at survey)})))

(defn keep-allowed-to-see [surveys-to-permission surveys-allowed-per-instance]
  (let [instance->survey-set (into {}
                               (map (fn [{:keys [instance-id survey-ids]}]
                                      [instance-id (set survey-ids)])
                                 surveys-allowed-per-instance))]
    (filter
      (fn [{:keys [instance-id survey-id]}]
        (contains? (get instance->survey-set instance-id) survey-id))
      surveys-to-permission)))

(defn survey->map
  [^SurveyGroup survey]
  {:id (str (ds/id survey))
   :name (.getName survey)
   :registration-form-id (str (.getNewLocaleSurveyId survey))
   :created-at (ds/created-at survey)
   :modified-at (ds/modified-at survey)})

Return question personal-data

[#222] Return question personal-data


(ns ^:integration integration.test.slice
  (:require [clojure.test :refer :all]
            [qu.loader :as loader]
            [qu.data :as data]
            [qu.test-util :refer :all]))

(use-fixtures :once (mongo-setup-fn "integration_test"))

(deftest ^:integration test-query-slice-with-no-params
  (testing "it returns successfully as text/html"
    (let [resp (GET "/data/integration_test/slice/incomes")]
      (println "RESPONSE" resp)
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "text/html;charset=UTF-8" "Vary" "Accept"}))))

(deftest ^:integration test-query-slice-does-not-exist
  (testing "it returns a 404"
    (let [resp (GET "/data/bad-dataset/slice/bad-slice")]
      (does= (:status resp) 404))

    (let [resp (GET "/data/bad-dataset/slice/bad-slice.xml")]
      (does= (:status resp) 404)
      (does-contain (:headers resp)
                    {"Content-Type" "application/xml;charset=UTF-8" "Vary" "Accept"}))))

(deftest ^:integration test-json
  (testing "it returns a content-type of application/json"
    (let [resp (GET "/data/integration_test/slice/incomes.json")]
      (println "RESPONSE" resp)
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "application/json;charset=UTF-8"}))))

(deftest ^:integration test-jsonp
  (testing "it uses the callback we supply"
    (let [resp (GET "/data/integration_test/slice/incomes.jsonp?$callback=foo")]
      (println "RESPONSE" resp)
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "text/javascript;charset=UTF-8"})
      (does-re-find (:body resp) #"^foo\(")))

  (testing "it uses 'callback' by default"
    (let [resp (GET "/data/integration_test/slice/incomes.jsonp")]
      (println "RESPONSE" resp)
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "text/javascript;charset=UTF-8"})
      (does-re-find (:body resp) #"^callback\("))))

(deftest ^:integration test-xml
  (testing "it returns a content-type of application/xml"
    (let [resp (GET "/data/integration_test/slice/incomes.xml")]
      (println "RESPONSE" resp)
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "application/xml;charset=UTF-8"}))))

(deftest ^:integration test-query-with-error
  (testing "it returns the status code for bad request"
    (let [resp (GET "/data/integration_test/slice/incomes?$where=peanut%20butter")]
      (does= (:status resp) 400))))

;; (run-tests)

(ns ^:integration integration.test.slice
  (:require [clojure.test :refer :all]
            [qu.loader :as loader]
            [qu.data :as data]
            [qu.test-util :refer :all]))

(use-fixtures :once (mongo-setup-fn "integration_test"))

(deftest ^:integration test-query-slice-with-no-params
  (testing "it returns successfully as text/html"
    (let [resp (GET "/data/integration_test/slice/incomes")]
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "text/html;charset=UTF-8" "Vary" "Accept"}))))

(deftest ^:integration test-query-slice-does-not-exist
  (testing "it returns a 404"
    (let [resp (GET "/data/bad-dataset/slice/bad-slice")]
      (does= (:status resp) 404))

    (let [resp (GET "/data/bad-dataset/slice/bad-slice.xml")]
      (does= (:status resp) 404)
      (does-contain (:headers resp)
                    {"Content-Type" "application/xml;charset=UTF-8" "Vary" "Accept"}))))

(deftest ^:integration test-json
  (testing "it returns a content-type of application/json"
    (let [resp (GET "/data/integration_test/slice/incomes.json")]
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "application/json;charset=UTF-8"}))))

(deftest ^:integration test-jsonp
  (testing "it uses the callback we supply"
    (let [resp (GET "/data/integration_test/slice/incomes.jsonp?$callback=foo")]
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "text/javascript;charset=UTF-8"})
      (does-re-find (:body resp) #"^foo\(")))

  (testing "it uses 'callback' by default"
    (let [resp (GET "/data/integration_test/slice/incomes.jsonp")]
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "text/javascript;charset=UTF-8"})
      (does-re-find (:body resp) #"^callback\("))))

(deftest ^:integration test-xml
  (testing "it returns a content-type of application/xml"
    (let [resp (GET "/data/integration_test/slice/incomes.xml")]
      (does= (:status resp) 200)
      (does-contain (:headers resp)
                    {"Content-Type" "application/xml;charset=UTF-8"}))))

(deftest ^:integration test-query-with-error
  (testing "it returns the status code for bad request"
    (let [resp (GET "/data/integration_test/slice/incomes?$where=peanut%20butter")]
      (does= (:status resp) 400))))

;; (run-tests)

remove debug from tests

remove debug from tests


;   Copyright (c) Shantanu Kumar. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file LICENSE at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns asphalt.internal.param
  (:require
    [asphalt.internal :as i]
    [asphalt.type :as t])
  (:import
    [java.util Calendar TimeZone]
    [java.sql Date PreparedStatement Time Timestamp]))

;; ----- date/time/calendar helpers -----

(defn tz-cal
  ^java.util.Calendar
  [^String x]
  (Calendar/getInstance (TimeZone/getTimeZone x)))

(defn resolve-cal
  ^java.util.Calendar
  [tz-or-cal]
  (cond
    (instance?
      Calendar tz-or-cal) tz-or-cal
    (instance?
      TimeZone tz-or-cal) (Calendar/getInstance ^TimeZone tz-or-cal)
    (string? tz-or-cal)   (tz-cal tz-or-cal)
    (i/named? tz-or-cal)  (tz-cal (i/as-str tz-or-cal))
    :otherwise            (i/expected "a TimeZone keyword/string or Calendar instance" tz-or-cal)))

;; ----- multi param helpers -----

(defn params-indices
  [param-keys-vec param-types-vec params-sym]
  (i/expected vector? "a vector of param keys" param-keys-vec)
  (i/expected vector? "a vector of param types" param-types-vec)
  (when-not (= (count param-keys-vec) (count param-types-vec))
    (i/expected (format "param keys (%d) and param types (%d) to be of same length"
                  (count param-keys-vec) (count param-types-vec))
      {:param-keys param-keys-vec
       :param-types param-types-vec}))
  (if (every? (partial contains? t/single-typemap) param-types-vec)
    (->> (iterate inc 1)
      (take (count param-types-vec))
      (apply vector-of :int))
    (let [multi-counts (map-indexed (fn [^long idx pt]
                                      (if (contains? t/single-typemap pt)
                                        `1
                                        `(count (get ~params-sym ~(get param-keys-vec idx)))))
                         param-types-vec)]
      `(reduce (fn [cv# ^long pcount#]
                 (conj cv# (unchecked-add (int (last cv#)) pcount#)))
         (vector-of :int 1)
         [~@multi-counts]))))

;; ----- param setting helpers -----

(defn set-param-value
  [^PreparedStatement prepared-statement param-type ^long param-index param-value]
  (case (get t/single-typemap param-type)
    :nil        (if (instance? clojure.lang.BigInt param-value)
                  (.setLong   prepared-statement param-index ^long (long param-value))
                  (.setObject prepared-statement param-index ^Object param-value))
    :boolean    (.setBoolean   prepared-statement param-index (boolean    param-value))
    :byte       (.setByte      prepared-statement param-index (byte       param-value))
    :byte-array (.setBytes     prepared-statement param-index (byte-array param-value))
    :date       (if (instance? Calendar param-value)
                  (.setDate    prepared-statement param-index (Date. (.getTimeInMillis ^Calendar param-value))
                    ^Calendar param-value)
                  (.setDate    prepared-statement param-index ^java.sql.Date param-value))
    :double     (.setDouble    prepared-statement param-index (double     param-value))
    :float      (.setFloat     prepared-statement param-index (float      param-value))
    :int        (.setInt       prepared-statement param-index (int        param-value))
    :long       (.setLong      prepared-statement param-index (long       param-value))
    :nstring    (.setNString   prepared-statement param-index ^String param-value)
    :object     (.setObject    prepared-statement param-index ^Object param-value)
    :string     (.setString    prepared-statement param-index ^String param-value)
    :time       (if (instance? Calendar param-value)
                  (.setTime      prepared-statement param-index (Time. (.getTimeInMillis ^Calendar param-value))
                    ^Calendar param-value)
                  (.setTime      prepared-statement param-index ^java.sql.Time param-value))
    :timestamp  (if (instance? Calendar param-value)
                  (.setTimestamp prepared-statement param-index (Timestamp. (.getTimeInMillis ^Calendar param-value))
                    ^Calendar param-value)
                  (.setTimestamp prepared-statement param-index ^java.sql.Timestamp param-value))
    (i/expected-single-param-type param-type)))

;; ----- param laying helpers -----

(defmacro try-param
  [pindex-sym type-label param-expr]
  `(try ~param-expr
     (catch Exception e#
       (throw (IllegalArgumentException.
                (str "Error resolving SQL param " ~pindex-sym
                  ~(format " as %s: %s" type-label param-expr))
                e#)))))

(defmacro each-param-expr
  "Return param setter expression."
  [setter pstmt-sym pindex-sym type-label param-expr]
  `(~setter ~pstmt-sym ~pindex-sym
     (try-param ~pindex-sym ~type-label ~param-expr)))

(defn lay-param-expr
  "Given prepared statement symbol, parm type, param index expression/symbol and param value expression/symbol, return
  an expression to set JDBC prepared statement param."
  [pstmt-sym param-type pindex-sym pvalue-sym]
  (when-not (contains? t/all-typemap param-type) (i/expected-param-type param-type))
  (if (contains? t/multi-typemap param-type)  ; multi-bit?
    (let [i-sym (gensym "i-")
          v-sym (gensym "v-")]
      `(i/loop-indexed [~i-sym ~pindex-sym
                        ~v-sym ~pvalue-sym]
         ~(lay-param-expr pstmt-sym (get t/multi-typemap param-type) i-sym v-sym)))
    (case (get t/single-typemap param-type)
      :nil        `(set-param-value ~pstmt-sym :nil ~pindex-sym ~pvalue-sym)
      :boolean    `(each-param-expr ~'.setBoolean   ~pstmt-sym ~pindex-sym "boolean"    (boolean    ~pvalue-sym))
      :byte       `(each-param-expr ~'.setByte      ~pstmt-sym ~pindex-sym "byte"       (byte       ~pvalue-sym))
      :byte-array `(each-param-expr ~'.setBytes     ~pstmt-sym ~pindex-sym "byte-array" (byte-array ~pvalue-sym))
      :date       `(let [p# (try-param ~pindex-sym "date" ~pvalue-sym)]
                     (cond
                       (instance? Date p#) (.setDate ~pstmt-sym ~pindex-sym ^java.sql.Date p#)
                       ;; calendar
                       (instance? Calendar p#) (.setDate ~pstmt-sym ~pindex-sym
                                                 (Date. (.getTimeInMillis ^java.util.Calendar p#))
                                                 ^java.util.Calendar p#)
                       (nil? p#)    (.setDate ~pstmt-sym ~pindex-sym nil)
                       :otherwise   (i/expected "java.sql.Date or java.util.Calendar instance" p#)))
      :double     `(each-param-expr ~'.setDouble    ~pstmt-sym ~pindex-sym "double"     (double     ~pvalue-sym))
      :float      `(each-param-expr ~'.setFloat     ~pstmt-sym ~pindex-sym "float"      (float      ~pvalue-sym))
      :int        `(each-param-expr ~'.setInt       ~pstmt-sym ~pindex-sym "int"        (int        ~pvalue-sym))
      :long       `(each-param-expr ~'.setLong      ~pstmt-sym ~pindex-sym "long"       (long       ~pvalue-sym))
      :nstring    `(each-param-expr ~'.setNString   ~pstmt-sym ~pindex-sym "string"     ~pvalue-sym)
      :object     `(each-param-expr ~'.setObject    ~pstmt-sym ~pindex-sym "object"     ~pvalue-sym)
      :string     `(each-param-expr ~'.setString    ~pstmt-sym ~pindex-sym "string"     ~pvalue-sym)
      :time       `(let [p# (try-param ~pindex-sym "time" ~pvalue-sym)]
                     (cond
                       (instance? Date p#) (.setTime ~pstmt-sym ~pindex-sym ^java.sql.Time p#)
                       ;; calendar
                       (instance? Calendar p#) (.setTime ~pstmt-sym ~pindex-sym
                                                 (Time. (.getTimeInMillis ^java.util.Calendar p#))
                                                 ^java.util.Calendar p#)
                       (nil? p#)    (.setTime ~pstmt-sym ~pindex-sym nil)
                       :otherwise   (i/expected "java.sql.Time or java.util.Calendar instance" p#)))
      :timestamp  `(let [p# (try-param ~pindex-sym "timestamp" ~pvalue-sym)]
                     (cond
                       (instance? Timestamp p#) (.setTimestamp ~pstmt-sym ~pindex-sym ^java.sql.Timestamp p#)
                       ;; calendar
                       (instance? Calendar p#) (.setTimestamp ~pstmt-sym ~pindex-sym
                                                 (Timestamp. (.getTimeInMillis ^java.util.Calendar p#))
                                                 ^java.util.Calendar p#)
                       (nil? p#)    (.setTimestamp ~pstmt-sym ~pindex-sym nil)
                       :otherwise   (i/expected "java.sql.Timestamp or java.util.Calendar instance" p#)))
      (i/expected-single-param-type param-type))))

(def cached-indices
  (memoize (fn [^long n]
             (apply vector-of :int (range n)))))

;   Copyright (c) Shantanu Kumar. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file LICENSE at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns asphalt.internal.param
  (:require
    [asphalt.internal :as i]
    [asphalt.type :as t])
  (:import
    [java.util Calendar TimeZone]
    [java.sql Date PreparedStatement Time Timestamp]))

;; ----- date/time/calendar helpers -----

(defn tz-cal
  ^java.util.Calendar
  [^String x]
  (Calendar/getInstance (TimeZone/getTimeZone x)))

(defn resolve-cal
  ^java.util.Calendar
  [tz-or-cal]
  (cond
    (instance?
      Calendar tz-or-cal) tz-or-cal
    (instance?
      TimeZone tz-or-cal) (Calendar/getInstance ^TimeZone tz-or-cal)
    (string? tz-or-cal)   (tz-cal tz-or-cal)
    (i/named? tz-or-cal)  (tz-cal (i/as-str tz-or-cal))
    :otherwise            (i/expected "a TimeZone keyword/string or Calendar instance" tz-or-cal)))

;; ----- multi param helpers -----

(defn params-indices
  [param-keys-vec param-types-vec params-sym]
  (i/expected vector? "a vector of param keys" param-keys-vec)
  (i/expected vector? "a vector of param types" param-types-vec)
  (when-not (= (count param-keys-vec) (count param-types-vec))
    (i/expected (format "param keys (%d) and param types (%d) to be of same length"
                  (count param-keys-vec) (count param-types-vec))
      {:param-keys param-keys-vec
       :param-types param-types-vec}))
  (if (every? (partial contains? t/single-typemap) param-types-vec)
    (->> (iterate inc 1)
      (take (count param-types-vec))
      (apply vector-of :int))
    (let [multi-counts (map-indexed (fn [^long idx pt]
                                      (if (contains? t/single-typemap pt)
                                        `1
                                        `(count (get ~params-sym ~(get param-keys-vec idx)))))
                         param-types-vec)]
      `(reduce (fn [cv# ^long pcount#]
                 (conj cv# (unchecked-add (int (last cv#)) pcount#)))
         (vector-of :int 1)
         [~@multi-counts]))))

;; ----- param setting helpers -----

(def ^:const ba-type (Class/forName "[B"))  ;; byte-array class

(defn set-param-value
  [^PreparedStatement prepared-statement param-type ^long param-index param-value]
  (case (get t/single-typemap param-type)
    :nil        (if (instance? clojure.lang.BigInt param-value)
                  (.setLong   prepared-statement param-index ^long (long param-value))
                  (.setObject prepared-statement param-index ^Object param-value))
    :boolean    (.setBoolean   prepared-statement param-index (boolean    param-value))
    :byte       (.setByte      prepared-statement param-index (byte       param-value))
    :byte-array (.setBytes     prepared-statement param-index (cond
                                                                (= (type param-value) ba-type) param-value
                                                                (nil? param-value) nil
                                                                :else (byte-array param-value)))
    :date       (if (instance? Calendar param-value)
                  (.setDate    prepared-statement param-index (Date. (.getTimeInMillis ^Calendar param-value))
                    ^Calendar param-value)
                  (.setDate    prepared-statement param-index ^java.sql.Date param-value))
    :double     (.setDouble    prepared-statement param-index (double     param-value))
    :float      (.setFloat     prepared-statement param-index (float      param-value))
    :int        (.setInt       prepared-statement param-index (int        param-value))
    :long       (.setLong      prepared-statement param-index (long       param-value))
    :nstring    (.setNString   prepared-statement param-index ^String param-value)
    :object     (.setObject    prepared-statement param-index ^Object param-value)
    :string     (.setString    prepared-statement param-index ^String param-value)
    :time       (if (instance? Calendar param-value)
                  (.setTime      prepared-statement param-index (Time. (.getTimeInMillis ^Calendar param-value))
                    ^Calendar param-value)
                  (.setTime      prepared-statement param-index ^java.sql.Time param-value))
    :timestamp  (if (instance? Calendar param-value)
                  (.setTimestamp prepared-statement param-index (Timestamp. (.getTimeInMillis ^Calendar param-value))
                    ^Calendar param-value)
                  (.setTimestamp prepared-statement param-index ^java.sql.Timestamp param-value))
    (i/expected-single-param-type param-type)))

;; ----- param laying helpers -----

(defmacro verify
  [klass instance]
  (i/expected symbol? "a class symbol" klass)
  (let [sym (with-meta (gensym) {:tag (str klass)})]
    `(let [~sym ~instance]
       (cond
         (instance? ~klass ~sym) ~sym
         (nil? ~sym)             nil
         :else (i/expected ~(str "nil or instance of class " klass) ~sym)))))

(defmacro try-param
  [pindex-sym type-label param-expr]
  `(try ~param-expr
     (catch Exception e#
       (throw (IllegalArgumentException.
                (str "Error resolving SQL param " ~pindex-sym
                  ~(format " as %s: %s" type-label param-expr))
                e#)))))

(defn lay-param-expr
  "Given prepared statement symbol, parm type, param index expression/symbol and param value expression/symbol, return
  an expression to set JDBC prepared statement param."
  [pstmt-sym param-type pindex-sym pvalue-sym]
  (when-not (contains? t/all-typemap param-type) (i/expected-param-type param-type))
  (if (contains? t/multi-typemap param-type)  ; multi-bit?
    (let [i-sym (gensym "i-")
          v-sym (gensym "v-")]
      `(i/loop-indexed [~i-sym ~pindex-sym
                        ~v-sym ~pvalue-sym]
         ~(lay-param-expr pstmt-sym (get t/multi-typemap param-type) i-sym v-sym)))
    (case (get t/single-typemap param-type)
      :nil        `(set-param-value ~pstmt-sym :nil ~pindex-sym ~pvalue-sym)
      :boolean    `(.setBoolean ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "boolean"    (boolean ~pvalue-sym)))
      :byte       `(.setByte    ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "byte"       (byte    ~pvalue-sym)))
      :byte-array `(.setBytes   ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "byte-array" (let [v# ~pvalue-sym]
                                                                                (cond
                                                                                (= (type v#) ba-type) v#
                                                                                (nil? v#)             nil
                                                                                :else (byte-array v#)))))
      :date       `(let [p# (try-param ~pindex-sym "date" ~pvalue-sym)]
                     (cond
                       (instance? Date p#) (.setDate ~pstmt-sym ~pindex-sym ^java.sql.Date p#)
                       ;; calendar
                       (instance? Calendar p#) (.setDate ~pstmt-sym ~pindex-sym
                                                 (Date. (.getTimeInMillis ^java.util.Calendar p#))
                                                 ^java.util.Calendar p#)
                       (nil? p#)    (.setDate ~pstmt-sym ~pindex-sym nil)
                       :otherwise   (i/expected "java.sql.Date or java.util.Calendar instance" p#)))
      :double     `(.setDouble    ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "double"   (double     ~pvalue-sym)))
      :float      `(.setFloat     ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "float"    (float      ~pvalue-sym)))
      :int        `(.setInt       ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "int"      (int        ~pvalue-sym)))
      :long       `(.setLong      ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "long"     (long       ~pvalue-sym)))
      :nstring    `(.setNString   ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "string"   (verify java.lang.String
                                                                                ~pvalue-sym)))
      :object     `(.setObject    ~pstmt-sym ~pindex-sym ~pvalue-sym)
      :string     `(.setString    ~pstmt-sym ~pindex-sym (try-param ~pindex-sym "string"   (verify java.lang.String
                                                                                ~pvalue-sym)))
      :time       `(let [p# (try-param ~pindex-sym "time" ~pvalue-sym)]
                     (cond
                       (instance? Date p#) (.setTime ~pstmt-sym ~pindex-sym ^java.sql.Time p#)
                       ;; calendar
                       (instance? Calendar p#) (.setTime ~pstmt-sym ~pindex-sym
                                                 (Time. (.getTimeInMillis ^java.util.Calendar p#))
                                                 ^java.util.Calendar p#)
                       (nil? p#)    (.setTime ~pstmt-sym ~pindex-sym nil)
                       :otherwise   (i/expected "java.sql.Time or java.util.Calendar instance" p#)))
      :timestamp  `(let [p# (try-param ~pindex-sym "timestamp" ~pvalue-sym)]
                     (cond
                       (instance? Timestamp p#) (.setTimestamp ~pstmt-sym ~pindex-sym ^java.sql.Timestamp p#)
                       ;; calendar
                       (instance? Calendar p#) (.setTimestamp ~pstmt-sym ~pindex-sym
                                                 (Timestamp. (.getTimeInMillis ^java.util.Calendar p#))
                                                 ^java.util.Calendar p#)
                       (nil? p#)    (.setTimestamp ~pstmt-sym ~pindex-sym nil)
                       :otherwise   (i/expected "java.sql.Timestamp or java.util.Calendar instance" p#)))
      (i/expected-single-param-type param-type))))

(def cached-indices
  (memoize (fn [^long n]
             (apply vector-of :int (range n)))))

refactor param setting for better error messages


(ns shadow.cljs.devtools.server.fs-watch-jvm
  (:require [shadow.build.api :as cljs]
            [clojure.core.async :as async :refer (alt!! thread >!!)]
            [shadow.cljs.devtools.server.util :as util]
            [shadow.cljs.devtools.server.system-bus :as system-bus]
            [clojure.java.io :as io]
            [clojure.string :as str])
  (:import (shadow.util FileWatcher)
           (java.io File)))

(defn service? [x]
  (and (map? x)
       (::service x)))

(defn poll-changes [{:keys [dir watcher]}]
  (let [changes (.pollForChanges watcher)]
    (when (seq changes)
      (->> changes
           (map (fn [[name event]]
                  {:dir dir
                   :name name
                   :ext (when-let [x (str/last-index-of name ".")]
                          (subs name (inc x)))
                   :file (io/file dir name)
                   :event event}))
           ;; ignore empty files
           (remove (fn [{:keys [event file] :as x}]
                     (and (not= event :del)
                          (zero? (.length file)))))
           ))))

(defn watch-loop
  [watch-dirs control publish-fn]

  (loop []
    (alt!!
      control
      ([_]
        :terminated)

      (async/timeout 500)
      ([_]
        (let [fs-updates
              (->> watch-dirs
                   (mapcat poll-changes)
                   (into []))]

          (when (seq fs-updates)
            (publish-fn fs-updates))

          (recur)))))

  ;; shut down watchers when loop ends
  (doseq [{:keys [watcher]} watch-dirs]
    (.close watcher))

  ::shutdown-complete)

(defn start [config directories file-exts publish-fn]
  {:pre [(every? #(instance? File %) directories)
         (coll? file-exts)
         (every? string? file-exts)]}
  (let [control
        (async/chan)

        watch-dirs
        (->> directories
             (map (fn [dir]
                    {:dir dir
                     :watcher (FileWatcher/create dir (vec file-exts))}))
             (into []))]

    {::service true
     :control control
     :watch-dirs watch-dirs
     :thread (thread (watch-loop watch-dirs control publish-fn))}))

(defn stop [{:keys [control thread] :as svc}]
  {:pre [(service? svc)]}
  (async/close! control)
  (async/<!! thread))

(ns shadow.cljs.devtools.server.fs-watch-jvm
  (:require [shadow.build.api :as cljs]
            [clojure.core.async :as async :refer (alt!! thread >!!)]
            [shadow.cljs.devtools.server.util :as util]
            [shadow.cljs.devtools.server.system-bus :as system-bus]
            [clojure.java.io :as io]
            [clojure.string :as str])
  (:import (shadow.util FileWatcher)
           (java.io File)))

(defn service? [x]
  (and (map? x)
       (::service x)))

(defn poll-changes [{:keys [dir ^FileWatcher watcher]}]
  (let [changes (.pollForChanges watcher)]
    (when (seq changes)
      (->> changes
           (map (fn [[name event]]
                  {:dir dir
                   :name name
                   :ext (when-let [x (str/last-index-of name ".")]
                          (subs name (inc x)))
                   :file (io/file dir name)
                   :event event}))
           ;; ignore empty files
           (remove (fn [{:keys [event ^File file] :as x}]
                     (and (not= event :del)
                          (zero? (.length file)))))
           ))))

(defn watch-loop
  [watch-dirs control publish-fn]

  (loop []
    (alt!!
      control
      ([_]
        :terminated)

      (async/timeout 500)
      ([_]
        (let [fs-updates
              (->> watch-dirs
                   (mapcat poll-changes)
                   (into []))]

          (when (seq fs-updates)
            (publish-fn fs-updates))

          (recur)))))

  ;; shut down watchers when loop ends
  (doseq [{:keys [^FileWatcher watcher]} watch-dirs]
    (.close watcher))

  ::shutdown-complete)

(defn start [config directories file-exts publish-fn]
  {:pre [(every? #(instance? File %) directories)
         (coll? file-exts)
         (every? string? file-exts)]}
  (let [control
        (async/chan)

        watch-dirs
        (->> directories
             (map (fn [^File dir]
                    {:dir dir
                     :watcher (FileWatcher/create dir (vec file-exts))}))
             (into []))]

    {::service true
     :control control
     :watch-dirs watch-dirs
     :thread (thread (watch-loop watch-dirs control publish-fn))}))

(defn stop [{:keys [control thread] :as svc}]
  {:pre [(service? svc)]}
  (async/close! control)
  (async/<!! thread))

remove some reflective calls

remove some reflective calls


hide the cosine line on even values of n; comments


(ns reply.reader.jline
  (:refer-clojure :exclude [read])
  (:require [reply.reader.jline.completion :as jline.completion]
            [reply.eval-state :as eval-state]
            [reply.reader.simple-jline :as simple-jline]
            [clojure.main])
  (:import [java.io File IOException PrintStream ByteArrayOutputStream
            FileInputStream FileDescriptor]
           [reply.reader.jline JlineInputReader]
           [reply.hacks CustomizableBufferLineNumberingPushbackReader]
           [jline.console ConsoleReader]
           [jline.internal Configuration Log]))

(def jline-reader (atom nil))
(def jline-pushback-reader (atom nil))

(def prompt-end "=> ")

(defmulti get-prompt type)
(defmethod get-prompt :default [ns]
  (format (str "%s" prompt-end) ns))
(defmethod get-prompt clojure.lang.Namespace [ns]
  (get-prompt (ns-name ns)))

(def prompt-fn (atom get-prompt))
(defn set-prompt-fn! [f]
  (when f (reset! prompt-fn f)))

(defn subsequent-prompt [options ns]
  (let [subsequent-prompt (:subsequent-prompt options)]
    (if subsequent-prompt
      (subsequent-prompt ns)
      (let [prompt-end (str "#_" prompt-end)]
        (apply str
               (concat (repeat (- (count (@prompt-fn ns))
                                  (count prompt-end))
                               \space)
                       prompt-end))))))

(defn set-empty-prompt [options]
  (.setPrompt
    @jline-reader
    (apply str (subsequent-prompt options (eval-state/get-ns)))))

(defn ->fn [config default]
  (cond (fn? config) config
        (seq? config) (eval config)
        :else default))

(defn setup-reader! [{:keys [prompt custom-prompt subsequent-prompt]
                      :as options}]
  (simple-jline/set-jline-output!)
  (let [prompt-fn (->fn custom-prompt (fn [ns] (str ns "=> ")))
        subsequent-prompt-fn (->fn subsequent-prompt nil)]
    (set-prompt-fn! prompt-fn)
    ; since construction is side-effect-y
    (reset! jline-reader (simple-jline/setup-console-reader options))
    ; since this depends on jline-reader
    (reset! jline-pushback-reader
            (CustomizableBufferLineNumberingPushbackReader.
              (JlineInputReader.
                {:jline-reader @jline-reader
                 :set-empty-prompt
                 (partial set-empty-prompt
                          {:subsequent-prompt subsequent-prompt-fn})})
              1))))

(defn prepare-for-read [eval-fn ns]
  (.setPrompt @jline-reader (@prompt-fn ns))
  (eval-state/set-ns ns)
  (.addCompleter @jline-reader
    ((simple-jline/make-completer (str (ns-name ns)) eval-fn)
       @jline-reader)))

(defmacro with-jline-in [options & body]
  `(do
    (try
      (when @jline-reader
        (simple-jline/prepare-for-next-read @jline-reader))
      (setup-reader! ~options)
      (prepare-for-read reply.initialization/eval-in-user-ns
                        (eval-state/get-ns))
      (binding [*in* @jline-pushback-reader]
        (Thread/interrupted) ; just to clear the status
        ~@body)
      ; NOTE: this indirection is for wrapped exceptions in 1.3
      (catch Throwable e#
        (if (#{IOException InterruptedException}
               (type (clojure.main/repl-exception e#)))
          (do (simple-jline/reset-reader @jline-reader) nil)
          (throw e#))))))

(defn read [request-prompt request-exit options]
  (with-jline-in options
    (clojure.main/repl-read request-prompt request-exit)))

(ns reply.reader.jline
  (:refer-clojure :exclude [read])
  (:require [reply.reader.jline.completion :as jline.completion]
            [reply.eval-state :as eval-state]
            [reply.reader.simple-jline :as simple-jline]
            [clojure.main])
  (:import [java.io File IOException PrintStream ByteArrayOutputStream
            FileInputStream FileDescriptor]
           [reply.reader.jline JlineInputReader]
           [reply.hacks CustomizableBufferLineNumberingPushbackReader]
           [jline.console ConsoleReader]
           [jline.internal Configuration Log]))

(def jline-reader (atom nil))
(def jline-pushback-reader (atom nil))

(def prompt-end "=> ")

(defmulti get-prompt type)
(defmethod get-prompt :default [ns]
  (format (str "%s" prompt-end) ns))
(defmethod get-prompt clojure.lang.Namespace [ns]
  (get-prompt (ns-name ns)))

(def prompt-fn (atom get-prompt))
(defn set-prompt-fn! [f]
  (when f (reset! prompt-fn f)))

(defn subsequent-prompt [options ns]
  (let [subsequent-prompt (:subsequent-prompt options)]
    (if subsequent-prompt
      (subsequent-prompt ns)
      (let [prompt-end (str "#_" prompt-end)]
        (apply str
               (concat (repeat (- (count (@prompt-fn ns))
                                  (count prompt-end))
                               \space)
                       prompt-end))))))

(defn set-empty-prompt [options]
  (.setPrompt
    @jline-reader
    (apply str (subsequent-prompt options (eval-state/get-ns)))))

(defn ->fn [config default]
  (cond (fn? config) config
        (seq? config) (eval config)
        :else default))

(defn setup-reader! [{:keys [prompt custom-prompt subsequent-prompt]
                      :as options}]
  (simple-jline/set-jline-output!)
  (let [prompt-fn (->fn custom-prompt (fn [ns] (str ns "=> ")))
        subsequent-prompt-fn (->fn subsequent-prompt (constantly nil))]
    (set-prompt-fn! prompt-fn)
    ; since construction is side-effect-y
    (reset! jline-reader (simple-jline/setup-console-reader options))
    ; since this depends on jline-reader
    (reset! jline-pushback-reader
            (CustomizableBufferLineNumberingPushbackReader.
              (JlineInputReader.
                {:jline-reader @jline-reader
                 :set-empty-prompt
                 (partial set-empty-prompt
                          {:subsequent-prompt subsequent-prompt-fn})})
              1))))

(defn prepare-for-read [eval-fn ns]
  (.setPrompt @jline-reader (@prompt-fn ns))
  (eval-state/set-ns ns)
  (.addCompleter @jline-reader
    ((simple-jline/make-completer (str (ns-name ns)) eval-fn)
       @jline-reader)))

(defmacro with-jline-in [options & body]
  `(do
    (try
      (when @jline-reader
        (simple-jline/prepare-for-next-read @jline-reader))
      (setup-reader! ~options)
      (prepare-for-read reply.initialization/eval-in-user-ns
                        (eval-state/get-ns))
      (binding [*in* @jline-pushback-reader]
        (Thread/interrupted) ; just to clear the status
        ~@body)
      ; NOTE: this indirection is for wrapped exceptions in 1.3
      (catch Throwable e#
        (if (#{IOException InterruptedException}
               (type (clojure.main/repl-exception e#)))
          (do (simple-jline/reset-reader @jline-reader) nil)
          (throw e#))))))

(defn read [request-prompt request-exit options]
  (with-jline-in options
    (clojure.main/repl-read request-prompt request-exit)))

Use fn for subsequent prompts in standalone mode


(ns nightcode.core
  (:require [seesaw.core :as s]
            [nightcode.shortcuts :as shortcuts]
            [nightcode.editors :as editors]
            [nightcode.lein :as lein]
            [nightcode.projects :as p]
            [nightcode.utils :as utils])
  (:import [org.pushingpixels.substance.api SubstanceLookAndFeel]
           [org.pushingpixels.substance.api.skin GraphiteSkin])
  (:gen-class))

(defn get-project-pane
  "Returns the pane with the project tree."
  []
  (let [project-tree (s/tree :id :project-tree
                             :focusable? true)]
    (doto project-tree
          (.setRootVisible false)
          (.setShowsRootHandles true)
          (.addTreeExpansionListener
            (reify javax.swing.event.TreeExpansionListener
              (treeCollapsed [this e] (p/remove-expansion e))
              (treeExpanded [this e] (p/add-expansion e))))
          (.addTreeSelectionListener
            (reify javax.swing.event.TreeSelectionListener
              (valueChanged [this e] (p/set-selection e)))))
    (-> (s/vertical-panel
          :items [(s/horizontal-panel
                    :items [(s/button :id :new-project-button
                                      :text (utils/get-string :new_project)
                                      :listen [:action p/new-project])
                            (s/button :id :new-file-button
                                      :text (utils/get-string :new_file)
                                      :listen [:action p/new-file])
                            (s/button :id :rename-file-button
                                      :text (utils/get-string :rename_file)
                                      :listen [:action p/rename-file]
                                      :visible? false)
                            (s/button :id :import-button
                                      :text (utils/get-string :import)
                                      :listen [:action p/import-project])
                            (s/button :id :remove-button
                                      :text (utils/get-string :remove)
                                      :listen [:action p/remove-item])
                            :fill-h])
                  (s/scrollable project-tree)])
        (shortcuts/create-mappings {:new-project-button p/new-project
                                    :new-file-button p/new-file
                                    :rename-file-button p/rename-file
                                    :import-button p/import-project
                                    :remove-button p/remove-item}))))

(defn get-repl-pane
  "Returns the pane with the REPL."
  []
  (let [console (s/config! (utils/create-console) :id :repl-console)
        thread (atom nil)
        out (utils/get-console-output console)]
    (lein/run-repl thread (utils/get-console-input console) out)
    (->> {:repl-console
          (fn [e]
            (s/request-focus! (.getView (.getViewport console)))
            (lein/run-repl thread (utils/get-console-input console) out))}
         (shortcuts/create-mappings console))))

(defn get-editor-pane
  "Returns the pane with the editors."
  []
  (-> (s/card-panel :id :editor-pane
                    :items [["" :default-card]])
      (shortcuts/create-mappings {:save-button editors/save-file})))

(defn get-build-pane
  "Returns the pane with the build actions."
  []
  (let [console (utils/create-console)
        process (atom nil)
        thread (atom nil)
        in (utils/get-console-input console)
        out (utils/get-console-output console)
        run-action (fn [e]
                     (lein/run-project
                       process thread in out (p/get-project-path)))
        run-repl-action (fn [e]
                          (lein/run-repl-project
                            process thread in out (p/get-project-path))
                          (s/request-focus! (.getView (.getViewport console))))
        build-action (fn [e]
                       (lein/build-project
                         process thread in out (p/get-project-path)))
        test-action (fn [e]
                      (lein/test-project thread in out (p/get-project-path)))
        clean-action (fn [e]
                       (lein/clean-project thread in out (p/get-project-path)))
        stop-action (fn [e]
                      (lein/stop-process process)
                      (lein/stop-thread thread))]
    (-> (s/vertical-panel
          :items [(s/horizontal-panel
                    :items [(s/button :id :run-button
                                      :text (utils/get-string :run)
                                      :listen [:action run-action])
                            (s/button :id :run-repl-button
                                      :text (utils/get-string :run_with_repl)
                                      :listen [:action run-repl-action])
                            (s/button :id :build-button
                                      :text (utils/get-string :build)
                                      :listen [:action build-action])
                            (s/button :id :test-button
                                      :text (utils/get-string :test)
                                      :listen [:action test-action])
                            (s/button :id :clean-button
                                      :text (utils/get-string :clean)
                                      :listen [:action clean-action])
                            (s/button :id :stop-button
                                      :text (utils/get-string :stop)
                                      :listen [:action stop-action])
                            :fill-h])
                  (s/config! console :id :build-console)])
        (shortcuts/create-mappings {:run-button run-action
                                    :run-repl-button run-repl-action
                                    :build-button build-action
                                    :test-button test-action
                                    :clean-button clean-action
                                    :stop-button stop-action}))))

(defn get-window-content []
  "Returns the entire window with all panes."
  (s/left-right-split
    (s/top-bottom-split (get-project-pane)
                        (get-repl-pane)
                        :divider-location 0.8
                        :resize-weight 0.5)
    (s/top-bottom-split (get-editor-pane)
                        (get-build-pane)
                        :divider-location 0.8
                        :resize-weight 0.5)
    :divider-location 0.4))

(defn -main
  "Launches the main window."
  [& args]
  (s/native!)
  (SubstanceLookAndFeel/setSkin (GraphiteSkin.))
  (s/invoke-later
    ; show the frame
    (reset! utils/ui-root
            (-> (s/frame :title (utils/get-string :app_name)
                         :content (get-window-content)
                         :width 1024
                         :height 768
                         :on-close :exit)
                shortcuts/create-hints
                s/show!))
    ; initialize the project pane
    (p/update-project-tree)))

(ns nightcode.core
  (:require [seesaw.core :as s]
            [nightcode.shortcuts :as shortcuts]
            [nightcode.editors :as editors]
            [nightcode.lein :as lein]
            [nightcode.projects :as p]
            [nightcode.utils :as utils])
  (:import [java.awt.event WindowAdapter]
           [org.pushingpixels.substance.api SubstanceLookAndFeel]
           [org.pushingpixels.substance.api.skin GraphiteSkin])
  (:gen-class))

(defn get-project-pane
  "Returns the pane with the project tree."
  []
  (let [project-tree (s/tree :id :project-tree
                             :focusable? true)]
    (doto project-tree
          (.setRootVisible false)
          (.setShowsRootHandles true)
          (.addTreeExpansionListener
            (reify javax.swing.event.TreeExpansionListener
              (treeCollapsed [this e] (p/remove-expansion e))
              (treeExpanded [this e] (p/add-expansion e))))
          (.addTreeSelectionListener
            (reify javax.swing.event.TreeSelectionListener
              (valueChanged [this e] (p/set-selection e)))))
    (-> (s/vertical-panel
          :items [(s/horizontal-panel
                    :items [(s/button :id :new-project-button
                                      :text (utils/get-string :new_project)
                                      :listen [:action p/new-project])
                            (s/button :id :new-file-button
                                      :text (utils/get-string :new_file)
                                      :listen [:action p/new-file])
                            (s/button :id :rename-file-button
                                      :text (utils/get-string :rename_file)
                                      :listen [:action p/rename-file]
                                      :visible? false)
                            (s/button :id :import-button
                                      :text (utils/get-string :import)
                                      :listen [:action p/import-project])
                            (s/button :id :remove-button
                                      :text (utils/get-string :remove)
                                      :listen [:action p/remove-item])
                            :fill-h])
                  (s/scrollable project-tree)])
        (shortcuts/create-mappings {:new-project-button p/new-project
                                    :new-file-button p/new-file
                                    :rename-file-button p/rename-file
                                    :import-button p/import-project
                                    :remove-button p/remove-item}))))

(defn get-repl-pane
  "Returns the pane with the REPL."
  []
  (let [console (s/config! (utils/create-console) :id :repl-console)
        thread (atom nil)
        out (utils/get-console-output console)]
    (lein/run-repl thread (utils/get-console-input console) out)
    (->> {:repl-console
          (fn [e]
            (s/request-focus! (.getView (.getViewport console)))
            (lein/run-repl thread (utils/get-console-input console) out))}
         (shortcuts/create-mappings console))))

(defn get-editor-pane
  "Returns the pane with the editors."
  []
  (-> (s/card-panel :id :editor-pane
                    :items [["" :default-card]])
      (shortcuts/create-mappings {:save-button editors/save-file})))

(defn get-build-pane
  "Returns the pane with the build actions."
  []
  (let [console (utils/create-console)
        process (atom nil)
        thread (atom nil)
        in (utils/get-console-input console)
        out (utils/get-console-output console)
        run-action (fn [e]
                     (lein/run-project
                       process thread in out (p/get-project-path)))
        run-repl-action (fn [e]
                          (lein/run-repl-project
                            process thread in out (p/get-project-path))
                          (s/request-focus! (.getView (.getViewport console))))
        build-action (fn [e]
                       (lein/build-project
                         process thread in out (p/get-project-path)))
        test-action (fn [e]
                      (lein/test-project thread in out (p/get-project-path)))
        clean-action (fn [e]
                       (lein/clean-project thread in out (p/get-project-path)))
        stop-action (fn [e]
                      (lein/stop-process process)
                      (lein/stop-thread thread))]
    (-> (s/vertical-panel
          :items [(s/horizontal-panel
                    :items [(s/button :id :run-button
                                      :text (utils/get-string :run)
                                      :listen [:action run-action])
                            (s/button :id :run-repl-button
                                      :text (utils/get-string :run_with_repl)
                                      :listen [:action run-repl-action])
                            (s/button :id :build-button
                                      :text (utils/get-string :build)
                                      :listen [:action build-action])
                            (s/button :id :test-button
                                      :text (utils/get-string :test)
                                      :listen [:action test-action])
                            (s/button :id :clean-button
                                      :text (utils/get-string :clean)
                                      :listen [:action clean-action])
                            (s/button :id :stop-button
                                      :text (utils/get-string :stop)
                                      :listen [:action stop-action])
                            :fill-h])
                  (s/config! console :id :build-console)])
        (shortcuts/create-mappings {:run-button run-action
                                    :run-repl-button run-repl-action
                                    :build-button build-action
                                    :test-button test-action
                                    :clean-button clean-action
                                    :stop-button stop-action}))))

(defn get-window-content []
  "Returns the entire window with all panes."
  (s/left-right-split
    (s/top-bottom-split (get-project-pane)
                        (get-repl-pane)
                        :divider-location 0.8
                        :resize-weight 0.5)
    (s/top-bottom-split (get-editor-pane)
                        (get-build-pane)
                        :divider-location 0.8
                        :resize-weight 0.5)
    :divider-location 0.4))

(defn -main
  "Launches the main window."
  [& args]
  (s/native!)
  (SubstanceLookAndFeel/setSkin (GraphiteSkin.))
  (s/invoke-later
    ; show the frame
    (reset! utils/ui-root
            (-> (s/frame :title (utils/get-string :app_name)
                         :content (get-window-content)
                         :width 1024
                         :height 768
                         :on-close :exit)
                shortcuts/create-hints
                (doto (.addWindowListener
                        (proxy [WindowAdapter] []
                          (windowActivated [e]
                            (p/update-project-tree)))))
                s/show!))
    ; initialize the project pane
    (p/update-project-tree)))

Refresh project tree when window is focused


(ns nightmod.utils
  (:require [clojure.edn :as edn]
            [clojure.java.io :as io]
            [clojure.string :as string]
            [nightcode.dialogs :as dialogs]
            [nightcode.editors :as editors]
            [nightcode.ui :as ui]
            [nightcode.utils :as nc-utils]
            [nightmod.input :as input]
            [seesaw.core :as s])
  (:import [java.awt BorderLayout KeyboardFocusManager]
           [java.text SimpleDateFormat]
           [javax.swing JDialog]))

(def ^:const window-width 1200)
(def ^:const window-height 768)
(def ^:const editor-width 700)
(def ^:const core-file "core.clj")
(def ^:const settings-file "settings.edn")
(def ^:const screenshot-file "screenshot.png")
(def ^:const docs-name "*Docs*")
(def ^:const repl-name "*REPL*")
(def ^:const game-ns 'nightmod.run)

(def main-dir (atom nil))
(def project-dir (atom nil))
(def error (atom nil))
(def out (atom nil))
(def stack-trace? (atom false))
(def editor (atom nil))

(defn get-data-dir
  []
  (.getCanonicalPath (io/file (System/getProperty "user.home") "Nightmod")))

(defn format-project-dir
  [project-name]
  (-> project-name
      (string/replace " " "-")
      nc-utils/format-project-name))

(defn new-project-name!
  [template]
  (when-not (-> (KeyboardFocusManager/getCurrentKeyboardFocusManager)
                .getFocusedWindow
                type
                (isa? JDialog))
    (dialogs/show-text-field-dialog!
      (nc-utils/get-string :enter-project-name)
      (nc-utils/get-string template))))

(defn new-project-dir!
  [project-name]
  (let [dir-name (format-project-dir project-name)
        project-file (io/file @main-dir dir-name)]
    (cond
      (= 0 (count dir-name))
      (dialogs/show-simple-dialog! (nc-utils/get-string :invalid-name))
      (.exists project-file)
      (dialogs/show-simple-dialog! (nc-utils/get-string :file-exists))
      :else
      project-file)))

(defn new-project!
  [template project-name project-file]
  (.mkdirs project-file)
  (doseq [file-name (-> (str template "/files.edn")
                        io/resource
                        slurp
                        edn/read-string)]
    (-> (str template "/" file-name)
        io/resource
        io/input-stream
        (io/copy (io/file project-file file-name))))
  (->> (format (slurp (io/resource settings-file)) project-name)
       (spit (io/file project-file settings-file)))
  (.getCanonicalPath project-file))

(defn canvas-focus?
  []
  (-> (System/getProperty "os.name") string/lower-case (.indexOf "win") (>= 0)))

(defn add!
  [frame component]
  (if (= :ext (s/id-of frame))
    (.setContentPane frame component)
    (.add (.getContentPane frame) component BorderLayout/EAST)))

(defn remove!
  [frame component]
  (when-not (= :ext (s/id-of frame))
    (.remove (.getContentPane frame) component)))

(defn visibility!
  [frame component show?]
  (.setVisible component (or show? (= :ext (s/id-of frame)))))

(defn toggle-editor!
  ([]
    (toggle-editor! (not (.isVisible @editor))))
  ([show?]
    (if show?
      (add! @ui/root @editor)
      (remove! @ui/root @editor))
    (visibility! @ui/root @editor show?)
    (.revalidate @ui/root)
    (if show?
      ; clear the key down buffer so keys don't get stuck in the down position
      (input/clear-key-buffer!)
      ; focus on the root so the game can receive keyboard events
      (s/request-focus! @ui/root))))

(defn set-out!
  [s initialize?]
  (when (or initialize? (seq s))
    (reset! out s)))

(ns nightmod.utils
  (:require [clojure.edn :as edn]
            [clojure.java.io :as io]
            [clojure.string :as string]
            [nightcode.dialogs :as dialogs]
            [nightcode.editors :as editors]
            [nightcode.ui :as ui]
            [nightcode.utils :as nc-utils]
            [nightmod.input :as input]
            [seesaw.core :as s])
  (:import [java.awt BorderLayout KeyboardFocusManager]
           [java.text SimpleDateFormat]))

(def ^:const window-width 1200)
(def ^:const window-height 768)
(def ^:const editor-width 700)
(def ^:const core-file "core.clj")
(def ^:const settings-file "settings.edn")
(def ^:const screenshot-file "screenshot.png")
(def ^:const docs-name "*Docs*")
(def ^:const repl-name "*REPL*")
(def ^:const game-ns 'nightmod.run)

(def main-dir (atom nil))
(def project-dir (atom nil))
(def error (atom nil))
(def out (atom nil))
(def stack-trace? (atom false))
(def editor (atom nil))

(defn get-data-dir
  []
  (.getCanonicalPath (io/file (System/getProperty "user.home") "Nightmod")))

(defn format-project-dir
  [project-name]
  (-> project-name
      (string/replace " " "-")
      nc-utils/format-project-name))

(defn new-project-name!
  [template]
  (dialogs/show-text-field-dialog!
    (nc-utils/get-string :enter-project-name)
    (nc-utils/get-string template)))

(defn new-project-dir!
  [project-name]
  (let [dir-name (format-project-dir project-name)
        project-file (io/file @main-dir dir-name)]
    (cond
      (= 0 (count dir-name))
      (dialogs/show-simple-dialog! (nc-utils/get-string :invalid-name))
      (.exists project-file)
      (dialogs/show-simple-dialog! (nc-utils/get-string :file-exists))
      :else
      project-file)))

(defn new-project!
  [template project-name project-file]
  (.mkdirs project-file)
  (doseq [file-name (-> (str template "/files.edn")
                        io/resource
                        slurp
                        edn/read-string)]
    (-> (str template "/" file-name)
        io/resource
        io/input-stream
        (io/copy (io/file project-file file-name))))
  (->> (format (slurp (io/resource settings-file)) project-name)
       (spit (io/file project-file settings-file)))
  (.getCanonicalPath project-file))

(defn canvas-focus?
  []
  (-> (System/getProperty "os.name") string/lower-case (.indexOf "win") (>= 0)))

(defn add!
  [frame component]
  (if (= :ext (s/id-of frame))
    (.setContentPane frame component)
    (.add (.getContentPane frame) component BorderLayout/EAST)))

(defn remove!
  [frame component]
  (when-not (= :ext (s/id-of frame))
    (.remove (.getContentPane frame) component)))

(defn visibility!
  [frame component show?]
  (.setVisible component (or show? (= :ext (s/id-of frame)))))

(defn toggle-editor!
  ([]
    (toggle-editor! (not (.isVisible @editor))))
  ([show?]
    (if show?
      (add! @ui/root @editor)
      (remove! @ui/root @editor))
    (visibility! @ui/root @editor show?)
    (.revalidate @ui/root)
    (if show?
      ; clear the key down buffer so keys don't get stuck in the down position
      (input/clear-key-buffer!)
      ; focus on the root so the game can receive keyboard events
      (s/request-focus! @ui/root))))

(defn set-out!
  [s initialize?]
  (when (or initialize? (seq s))
    (reset! out s)))

Remove unnecessary dialog check

Remove unnecessary dialog check


;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL

(ns uxbox.main.ui.workspace.shapes.frame
  (:require
   [rumext.alpha :as mf]
   [uxbox.common.data :as d]
   [uxbox.main.constants :as c]
   [uxbox.main.data.workspace :as dw]
   [uxbox.main.refs :as refs]
   [uxbox.main.store :as st]
   [uxbox.main.ui.workspace.shapes.common :as common]
   [uxbox.main.data.workspace.selection :as dws]
   [uxbox.main.ui.shapes.frame :as frame]
   [uxbox.common.geom.matrix :as gmt]
   [uxbox.common.geom.point :as gpt]
   [uxbox.common.geom.shapes :as geom]
   [uxbox.util.dom :as dom]
   [uxbox.main.streams :as ms]
   [uxbox.util.timers :as ts]))

(defn- frame-wrapper-factory-equals?
  [np op]
  (let [n-shape (aget np "shape")
        o-shape (aget op "shape")
        n-objs  (aget np "objects")
        o-objs  (aget op "objects")

        ids (:shapes n-shape)]
    (and (identical? n-shape o-shape)
         (loop [id (first ids)
                ids (rest ids)]
           (if (nil? id)
             true
             (if (identical? (get n-objs id)
                             (get o-objs id))
               (recur (first ids) (rest ids))
               false))))))

(defn use-mouse-over
  [{:keys [id] :as shape}]
  (mf/use-callback
   (mf/deps shape)
   (fn []
     (st/emit! (dws/change-hover-state id true)))))

(defn use-mouse-out
  [{:keys [id] :as shape}]
  (mf/use-callback
   (mf/deps shape)
   (fn []
     (st/emit! (dws/change-hover-state id false)))))

(defn frame-wrapper-factory
  [shape-wrapper]
  (let [frame-shape (frame/frame-shape shape-wrapper)]
    (mf/fnc frame-wrapper
      {::mf/wrap [#(mf/memo' % frame-wrapper-factory-equals?)
                  #(mf/deferred % ts/schedule-on-idle)]
       ::mf/wrap-props false}
      [props]
      (let [shape   (unchecked-get props "shape")
            objects (unchecked-get props "objects")

            selected-iref (mf/use-memo (mf/deps (:id shape))
                                       #(refs/make-selected (:id shape)))
            selected? (mf/deref selected-iref)
            zoom (mf/deref refs/selected-zoom)

            on-mouse-down   (mf/use-callback (mf/deps shape)
                                             #(common/on-mouse-down % shape))
            on-context-menu (mf/use-callback (mf/deps shape)
                                             #(common/on-context-menu % shape))

            shape (geom/transform-shape shape)
            {:keys [x y width height]} shape

            inv-zoom    (/ 1 zoom)
            children    (mapv #(get objects %) (:shapes shape))
            ds-modifier (get-in shape [:modifiers :displacement])

            label-pos (gpt/point x (- y (/ 10 zoom)))

            on-double-click
            (mf/use-callback
             (mf/deps (:id shape))
             (fn [event]
               (dom/prevent-default event)
               (st/emit! dw/deselect-all
                         (dw/select-shape (:id shape)))))]

        (when-not (:hidden shape)
          [:g {:class (when selected? "selected")
               :on-context-menu on-context-menu
               :on-double-click on-double-click
               :on-mouse-down on-mouse-down}
           [:text {:x 0
                   :y 0
                   :width width
                   :height 20
                   :class "workspace-frame-label"
                   ;; Ensure that the label has always the same font
                   ;; size, regardless of zoom
                   ;; https://css-tricks.com/transforms-on-svg-elements/
                   :transform (str
                               "scale(" inv-zoom ", " inv-zoom ") "
                               "translate(" (* zoom (:x label-pos)) ", "
                               (* zoom (:y label-pos))
                               ")")
                   ;; User may also select the frame with single click in the label
                   :on-click on-double-click
                   :on-mouse-over (use-mouse-over shape)
                   :on-mouse-out (use-mouse-out shape)}
            (:name shape)]
           [:*
            [:& frame-shape
             {:shape shape
              :childs children}]]])))))

;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL

(ns uxbox.main.ui.workspace.shapes.frame
  (:require
   [rumext.alpha :as mf]
   [uxbox.common.data :as d]
   [uxbox.main.constants :as c]
   [uxbox.main.data.workspace :as dw]
   [uxbox.main.refs :as refs]
   [uxbox.main.store :as st]
   [uxbox.main.ui.workspace.shapes.common :as common]
   [uxbox.main.data.workspace.selection :as dws]
   [uxbox.main.ui.shapes.frame :as frame]
   [uxbox.common.geom.matrix :as gmt]
   [uxbox.common.geom.point :as gpt]
   [uxbox.common.geom.shapes :as geom]
   [uxbox.util.dom :as dom]
   [uxbox.main.streams :as ms]
   [uxbox.util.timers :as ts]))

(defn- frame-wrapper-factory-equals?
  [np op]
  (let [n-shape (aget np "shape")
        o-shape (aget op "shape")
        n-objs  (aget np "objects")
        o-objs  (aget op "objects")

        ids (:shapes n-shape)]
    (and (identical? n-shape o-shape)
         (loop [id (first ids)
                ids (rest ids)]
           (if (nil? id)
             true
             (if (identical? (get n-objs id)
                             (get o-objs id))
               (recur (first ids) (rest ids))
               false))))))

(defn frame-wrapper-factory
  [shape-wrapper]
  (let [frame-shape (frame/frame-shape shape-wrapper)]
    (mf/fnc frame-wrapper
      {::mf/wrap [#(mf/memo' % frame-wrapper-factory-equals?)
                  #(mf/deferred % ts/schedule-on-idle)]
       ::mf/wrap-props false}
      [props]
      (let [shape   (unchecked-get props "shape")
            objects (unchecked-get props "objects")

            selected-iref (mf/use-memo (mf/deps (:id shape))
                                       #(refs/make-selected (:id shape)))
            selected? (mf/deref selected-iref)
            zoom (mf/deref refs/selected-zoom)

            on-mouse-down   (mf/use-callback (mf/deps shape)
                                             #(common/on-mouse-down % shape))
            on-context-menu (mf/use-callback (mf/deps shape)
                                             #(common/on-context-menu % shape))

            shape (geom/transform-shape shape)
            {:keys [x y width height]} shape

            inv-zoom    (/ 1 zoom)
            children    (mapv #(get objects %) (:shapes shape))
            ds-modifier (get-in shape [:modifiers :displacement])

            label-pos (gpt/point x (- y (/ 10 zoom)))

            on-double-click
            (mf/use-callback
             (mf/deps (:id shape))
             (fn [event]
               (dom/prevent-default event)
               (st/emit! dw/deselect-all
                         (dw/select-shape (:id shape)))))

            on-mouse-over
            (mf/use-callback
             (mf/deps (:id shape))
             (fn []
               (st/emit! (dws/change-hover-state (:id shape) true))))

            on-mouse-out
            (mf/use-callback
             (mf/deps (:id shape))
             (fn []
               (st/emit! (dws/change-hover-state (:id shape) false))))]

        (when-not (:hidden shape)
          [:g {:class (when selected? "selected")
               :on-context-menu on-context-menu
               :on-double-click on-double-click
               :on-mouse-down on-mouse-down}
           [:text {:x 0
                   :y 0
                   :width width
                   :height 20
                   :class "workspace-frame-label"
                   ;; Ensure that the label has always the same font
                   ;; size, regardless of zoom
                   ;; https://css-tricks.com/transforms-on-svg-elements/
                   :transform (str
                               "scale(" inv-zoom ", " inv-zoom ") "
                               "translate(" (* zoom (:x label-pos)) ", "
                               (* zoom (:y label-pos))
                               ")")
                   ;; User may also select the frame with single click in the label
                   :on-click on-double-click
                   :on-mouse-over on-mouse-over
                   :on-mouse-out on-mouse-out}
            (:name shape)]
           [:*
            [:& frame-shape
             {:shape shape
              :childs children}]]])))))

:bug: Fix unexpected internal error on frame hidding.

Because of incorrect use of hooks.


(ns bakyeono.litedocx.util
  "Custom utilities used in litedocx."
  (:import [java.io DataInputStream FileInputStream OutputStream])
  (:import [java.io StringReader StringWriter])
  (:import [java.util.zip ZipEntry ZipOutputStream])
  (:require [clojure.string :as str])
  (:require [clojure.zip :as z])
  (:require [clojure.java.io :as io])
  (:require [clojure.data.xml :as xml]))

;;; def~
(defmacro defconst-
  [symbol init]
  `(def ^:const ^{:private true}
     ~symbol ~init))

;;; Collection
(defn mapstr
  "Returns the result of applying str to the result of applying map
  to f and colls.  Thus function f should return a collection."
  [f & colls]
  (apply str (apply map f colls)))

(defn remove-nil
  "Returns sequence filtered nil-values."
  [s]
  (filter identity s))

;;; String
(defn to-camel-case
  [str]
  (str/replace str #"-(\w)" #(str/upper-case (second %))))

;;; Java
(def array-of-bytes-type (Class/forName "[B"))
(defn is-byte-array?
  [object]
  (= (class object) array-of-bytes-type))

;;; I/O
(defn- write-zip-entry-body-as-text
  "Writes a text entry on zip-ostream.
  Called by write-zip-entry."
  [zip-ostream entry-body]
  (let [writer (io/writer zip-ostream)]
    (.write writer #^String entry-body)
    (.flush writer)))

(defn- write-zip-entry-body-as-bytes
  "Writes a binary entry on zip-ostream.
  Called by write-zip-entry."
  [zip-ostream entry-body]
  (.write zip-ostream #^array-of-bytes-type entry-body)
  (.flush zip-ostream))

(defn- write-zip-entry
  "Writes an entry on zip-ostream with given filename & body of entry.
  Called by write-zip."
  [zip-ostream [entry-filename entry-body]]
  (.putNextEntry zip-ostream (ZipEntry. #^String entry-filename))
  (cond (string? entry-body)
        (write-zip-entry-body-as-text zip-ostream entry-body)
        (is-byte-array? entry-body)
        (write-zip-entry-body-as-bytes zip-ostream entry-body))
  (.closeEntry zip-ostream))

(defn write-zip
  "Writes a zip file into the 'dst' path, with given 'entries'.
  Parameters:
  - dst: <string> filename of the file to be written
  - & entries: <string> filename of entry, <string or byte array> body of entry, ...
  you can add as many entries as needed as '& entries' argument.
  Examples:
  (write-zip \"foo.zip\" \"bar.txt\" \"Lorem ipsum\" \"baz.bin\" (byte-array 10))"
  [dst & entries]
  (with-open [ostream (io/output-stream dst)
              zip-ostream (ZipOutputStream. ostream)]
    (doseq [entry (partition 2 entries)]
      (write-zip-entry zip-ostream entry))))

(defn compress-files-as-zip
  "Compress files as zip format."
  [target]
  (println "Hello, World!"))

(defn line-and-print-tags
  "Prints xml-like document with every tag line feeded."
  [s]
  (print (str/replace s #">" ">\n")))

(defn read-xml
  "Returns a XML tree filled with the data of given source file path."
  [src]
  (-> src slurp StringReader. xml/parse))

(defn emit-xml-as-str
  "Emits XML data as string."
  [data]
  (with-open [writer (StringWriter.)]
    (xml/emit data writer)
    (.flush writer)
    (.toString writer)))

(defn load-byte-array
  "Loads data from the given source file path as a byte array."
  [src]
  (let [file (io/file src)
        array (make-array Byte/TYPE (.length file))]
    (with-open [ifstream (FileInputStream. file)
                idstream (DataInputStream. ifstream)]
      (.readFully idstream array)
      array)))

(ns bakyeono.litedocx.util
  "Custom utilities used in litedocx."
  (:import [java.io DataInputStream FileInputStream OutputStream])
  (:import [java.io StringReader StringWriter])
  (:import [java.util.zip ZipEntry ZipOutputStream])
  (:require [clojure.string :as str])
  (:require [clojure.zip :as z])
  (:require [clojure.java.io :as io])
  (:require [clojure.data.xml :as xml]))

;;; def~
(defmacro defconst-
  [symbol init]
  `(def
    ~(with-meta symbol
       (assoc (meta symbol)
        :const true
        :private true))
    ~init))

;;; Collection
(defn mapstr
  "Returns the result of applying str to the result of applying map
  to f and colls.  Thus function f should return a collection."
  [f & colls]
  (apply str (apply map f colls)))

(defn remove-nil
  "Returns sequence filtered nil-values."
  [s]
  (filter identity s))

;;; String
(defn to-camel-case
  [str]
  (str/replace str #"-(\w)" #(str/upper-case (second %))))

;;; Java
(def array-of-bytes-type (Class/forName "[B"))
(defn is-byte-array?
  [object]
  (= (class object) array-of-bytes-type))

;;; I/O
(defn- write-zip-entry-body-as-text
  "Writes a text entry on zip-ostream.
  Called by write-zip-entry."
  [zip-ostream entry-body]
  (let [writer (io/writer zip-ostream)]
    (.write writer #^String entry-body)
    (.flush writer)))

(defn- write-zip-entry-body-as-bytes
  "Writes a binary entry on zip-ostream.
  Called by write-zip-entry."
  [zip-ostream entry-body]
  (.write zip-ostream #^array-of-bytes-type entry-body)
  (.flush zip-ostream))

(defn- write-zip-entry
  "Writes an entry on zip-ostream with given filename & body of entry.
  Called by write-zip."
  [zip-ostream [entry-filename entry-body]]
  (.putNextEntry zip-ostream (ZipEntry. #^String entry-filename))
  (cond (string? entry-body)
        (write-zip-entry-body-as-text zip-ostream entry-body)
        (is-byte-array? entry-body)
        (write-zip-entry-body-as-bytes zip-ostream entry-body))
  (.closeEntry zip-ostream))

(defn write-zip
  "Writes a zip file into the 'dst' path, with given 'entries'.
  Parameters:
  - dst: <string> filename of the file to be written
  - & entries: <string> filename of entry, <string or byte array> body of entry, ...
  you can add as many entries as needed as '& entries' argument.
  Examples:
  (write-zip \"foo.zip\" \"bar.txt\" \"Lorem ipsum\" \"baz.bin\" (byte-array 10))"
  [dst & entries]
  (with-open [ostream (io/output-stream dst)
              zip-ostream (ZipOutputStream. ostream)]
    (doseq [entry (partition 2 entries)]
      (write-zip-entry zip-ostream entry))))

(defn compress-files-as-zip
  "Compress files as zip format."
  [target]
  (println "Hello, World!"))

(defn line-and-print-tags
  "Prints xml-like document with every tag line feeded."
  [s]
  (print (str/replace s #">" ">\n")))

(defn read-xml
  "Returns a XML tree filled with the data of given source file path."
  [src]
  (-> src slurp StringReader. xml/parse))

(defn emit-xml-as-str
  "Emits XML data as string."
  [data]
  (with-open [writer (StringWriter.)]
    (xml/emit data writer)
    (.flush writer)
    (.toString writer)))

(defn load-byte-array
  "Loads data from the given source file path as a byte array."
  [src]
  (let [file (io/file src)
        array (make-array Byte/TYPE (.length file))]
    (with-open [ifstream (FileInputStream. file)
                idstream (DataInputStream. ifstream)]
      (.readFully idstream array)
      array)))

Fix util/defconst-

Fix util/defconst-