├── lint.cmd ├── dev ├── user │ └── .keep ├── app │ └── config │ │ ├── postcss.config.js │ │ └── default.props └── dev │ ├── env │ ├── shadow_cljs │ │ └── server.clj │ ├── system │ │ ├── integrant │ │ │ ├── nrepl.clj │ │ │ ├── shadow_cljs.clj │ │ │ ├── watcher.clj │ │ │ ├── app_reload.clj │ │ │ └── tailwind.clj │ │ ├── integrant.clj │ │ ├── app.clj │ │ └── core.clj │ ├── nrepl │ │ └── server.clj │ ├── main.clj │ ├── tailwind │ │ └── watcher.clj │ └── reload │ │ ├── ring_refresh.clj │ │ ├── watcher.clj │ │ └── app_reload.clj │ └── config │ └── default.edn ├── tailwind └── app │ ├── config │ ├── tailwind.config.js │ └── postcss.config.js │ └── $_example │ ├── css │ ├── component_hello-world.css │ └── layout.css │ └── main.css ├── resources ├── app │ └── database │ │ ├── sql │ │ ├── example-user--select-all.sql │ │ └── _naming-convention.txt │ │ └── schema │ │ ├── changelog.xml │ │ └── table │ │ └── example_user.xml └── spy.properties ├── .idea ├── codeStyles │ ├── codeStyleConfig.xml │ └── Project.xml └── ClojureProjectResolveSettings.xml ├── src ├── app │ ├── rum │ │ ├── core.cljc │ │ ├── impl │ │ │ └── component.cljc │ │ ├── mixin │ │ │ ├── static_args.cljc │ │ │ └── local.cljc │ │ ├── component │ │ │ └── hello_world.cljc │ │ ├── component.cljc │ │ └── mount.cljc │ ├── $_example │ │ ├── impl │ │ │ ├── handler.clj │ │ │ └── html.clj │ │ ├── main.cljs │ │ ├── core.clj │ │ └── handler │ │ │ ├── example_database.clj │ │ │ ├── index.clj │ │ │ ├── example_react.clj │ │ │ └── example_path_param.clj │ ├── system │ │ ├── task │ │ │ └── update_database_schema.clj │ │ ├── service │ │ │ ├── mount.clj │ │ │ ├── webapp_http_handler.clj │ │ │ ├── hikari_data_source.clj │ │ │ ├── app_config.clj │ │ │ └── immutant_web.clj │ │ ├── integrant.clj │ │ ├── integrant_config │ │ │ ├── app_config_setup.clj │ │ │ ├── hikari_data_source_mixin.clj │ │ │ └── http_server_setup.clj │ │ └── core.clj │ ├── config │ │ └── core.clj │ ├── html │ │ └── core.clj │ ├── database │ │ ├── hugsql_adapter.clj │ │ ├── result_set.clj │ │ ├── core.clj │ │ └── hugsql.clj │ ├── main.clj │ └── webapp │ │ └── ring_handler.clj └── lib │ ├── clojure │ ├── core.cljs │ ├── future.clj │ ├── print.clj │ ├── core.clj │ ├── ns.clj │ ├── lang.cljs │ ├── exception.clj │ ├── lang.clj │ ├── perf.clj │ └── assert.clj │ ├── ring_middleware │ ├── session_immutant.clj │ ├── error_not_found.clj │ ├── error_exception.clj │ ├── response_logger.clj │ └── route_tag_reitit.clj │ ├── ring_util │ ├── headers.clj │ ├── cookie.clj │ ├── response.clj │ └── request.clj │ ├── cognitect_transit │ ├── core.cljs │ └── core.clj │ ├── config │ ├── core.clj │ └── props.clj │ ├── slf4j │ └── mdc.clj │ ├── liquibase │ └── core.clj │ ├── util │ ├── ansi_escape.clj │ ├── uuid.clj │ └── secret.clj │ ├── hugsql │ └── core.clj │ ├── integrant │ ├── system.clj │ └── async.clj │ ├── hikari_cp │ └── data_source.clj │ ├── clojure_tools_logging │ └── logger.clj │ └── clojure_string │ └── core.clj ├── .gitignore ├── shadow-cljs.edn ├── package.json ├── .clj-kondo ├── config.edn └── clj_kondo │ └── rum.clj ├── LICENSE ├── README.md └── project.clj /lint.cmd: -------------------------------------------------------------------------------- 1 | clj-kondo --lint src;dev -------------------------------------------------------------------------------- /dev/user/.keep: -------------------------------------------------------------------------------- 1 | Temporary user sources excluded from the hot-reload watcher. -------------------------------------------------------------------------------- /tailwind/app/config/tailwind.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | content: ['./src/app/$_example/**/*.clj'], 3 | } 4 | -------------------------------------------------------------------------------- /resources/app/database/sql/example-user--select-all.sql: -------------------------------------------------------------------------------- 1 | -- :doc Fetch all example users 2 | -- :command :query 3 | -- :result :many 4 | SELECT 5 | * 6 | FROM 7 | example_user 8 | -------------------------------------------------------------------------------- /.idea/codeStyles/codeStyleConfig.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | -------------------------------------------------------------------------------- /tailwind/app/$_example/css/component_hello-world.css: -------------------------------------------------------------------------------- 1 | #hello-world { 2 | @apply mt-4; 3 | @apply py-2 px-3; 4 | @apply bg-gray-100; 5 | @apply rounded; 6 | @apply shadow; 7 | @apply text-center; 8 | 9 | &:hover { 10 | @apply bg-yellow-100; 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /dev/app/config/postcss.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | plugins: { 3 | 'postcss-import': {path: ['tailwind', 'node_modules']}, 4 | 'tailwindcss/nesting': {}, 5 | 'tailwindcss': 'tailwind/app/config/tailwind.config.js', 6 | 'postcss-nested': {}, 7 | 'postcss-reporter': {}, 8 | } 9 | }; 10 | -------------------------------------------------------------------------------- /src/app/rum/core.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.core 2 | 3 | "Setup rum components." 4 | 5 | (:require [app.rum.component.hello-world])) 6 | 7 | #?(:clj (set! *warn-on-reflection* true) 8 | :cljs (set! *warn-on-infer* true)) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | -------------------------------------------------------------------------------- /tailwind/app/config/postcss.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | plugins: { 3 | 'postcss-import': {path: ['tailwind', 'node_modules']}, 4 | 'tailwindcss/nesting': {}, 5 | 'tailwindcss': 'tailwind/app/config/tailwind.config.js', 6 | 'autoprefixer': {}, 7 | 'cssnano': {preset: 'default'}, 8 | 'postcss-reporter': {}, 9 | } 10 | }; 11 | -------------------------------------------------------------------------------- /dev/app/config/default.props: -------------------------------------------------------------------------------- 1 | # suppress inspection "UnusedProperty" for whole file 2 | 3 | Webapp.ListEnabled=example 4 | Webapp.Hosts(example)=example.localtest.me 5 | 6 | Database.DataSourceClassName=org.h2.jdbcx.JdbcDataSource 7 | Database.Url=jdbc:h2:file:./.database 8 | Database.Url.ReadOnly=jdbc:h2:file:./.database 9 | Database.User= 10 | Database.Password= 11 | -------------------------------------------------------------------------------- /resources/spy.properties: -------------------------------------------------------------------------------- 1 | # suppress inspection "UnusedProperty" for whole file 2 | appender=com.p6spy.engine.spy.appender.Slf4JLogger 3 | excludecategories=info,debug,result,resultset 4 | logMessageFormat=com.p6spy.engine.spy.appender.CustomLineFormat 5 | customLogMessageFormat=%(category) | connection %(connectionId) | \u001b[33m%(sqlSingleLine)\u001b[0m | %(executionTime) ms 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.class 2 | *.iml 3 | *.jar 4 | .cache/ 5 | .cpcache/ 6 | .database.*.db 7 | .idea/ 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins/ 11 | .lein-repl-history 12 | .nrepl-port 13 | .shadow-cljs/ 14 | /checkouts/ 15 | /classes/ 16 | /dev/app/config/user.* 17 | /dev/dev/config/user.* 18 | /dev/user/ 19 | /lib/ 20 | /target/ 21 | node_modules/ 22 | pom.xml 23 | pom.xml.asc 24 | resources/public/app/ 25 | -------------------------------------------------------------------------------- /shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | ;; shadow-cljs configuration 2 | {:lein true 3 | :nrepl false 4 | :socket-repl false 5 | :source-paths ["src"] 6 | :builds {:example {:target :browser 7 | :modules {:main {:entries [app.$-example.main]}} 8 | :asset-path "/app/example" 9 | :output-dir "resources/public/app/example" 10 | #_#_:devtools {:watch-dir "resources/public"}}}} 11 | -------------------------------------------------------------------------------- /tailwind/app/$_example/css/layout.css: -------------------------------------------------------------------------------- 1 | html { 2 | @apply bg-gray-50; 3 | } 4 | 5 | body { 6 | @apply m-4; 7 | @apply p-4; 8 | @apply rounded; 9 | @apply shadow-md; 10 | @apply bg-white; 11 | } 12 | 13 | h1 { 14 | @apply font-bold; 15 | @apply text-lg; 16 | @apply mb-4; 17 | } 18 | 19 | a { 20 | @apply text-blue-500; 21 | } 22 | 23 | ul { 24 | @apply list-disc; 25 | @apply list-inside; 26 | 27 | li { 28 | @apply ml-2; 29 | @apply pl-2; 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /resources/app/database/schema/changelog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /src/app/rum/impl/component.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.impl.component) 2 | 3 | #?(:clj (set! *warn-on-reflection* true) 4 | :cljs (set! *warn-on-infer* true)) 5 | 6 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 7 | 8 | (defmulti create-component 9 | "Component constructor by ID keyword." 10 | :app.rum/component-id) 11 | 12 | (defmethod create-component :default 13 | [data] 14 | (println "Calling default `create-component` for" data)) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | -------------------------------------------------------------------------------- /src/lib/clojure/core.cljs: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.core 2 | {:clj-kondo/config {:linters {:missing-docstring {:level :off}}}} 3 | (:require [lib.clojure.lang :as lang])) 4 | 5 | (set! *warn-on-infer* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (def add-method lang/add-method) 10 | (def first-arg, lang/first-arg) 11 | (def second-arg lang/second-arg) 12 | (def invoke,,,, lang/invoke) 13 | (def asserted,, lang/asserted) 14 | (def unwrap-fn, lang/unwrap-fn) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | -------------------------------------------------------------------------------- /src/lib/ring_middleware/session_immutant.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-middleware.session-immutant 2 | (:require [immutant.web.middleware :as immutant] 3 | [ring.middleware.flash :as flash])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn wrap-session 10 | "Wrap handler with immutant-web session middleware." 11 | [handler] 12 | (-> handler 13 | (flash/wrap-flash) 14 | (immutant/wrap-session {:cookie-attrs {:http-only true}}))) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | -------------------------------------------------------------------------------- /src/lib/clojure/future.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.future 2 | (:refer-clojure :exclude [future]) 3 | (:import (org.slf4j MDC))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defmacro future 10 | "Same as `clojure.core/future` but preserving MDC context map." 11 | [& body] 12 | `(let [cm# (MDC/getCopyOfContextMap)] 13 | (clojure.core/future 14 | (some-> cm# (MDC/setContextMap)) 15 | (try 16 | ~@body 17 | (finally (MDC/clear)))))) 18 | 19 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 20 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "website", 3 | "devDependencies": { 4 | "autoprefixer": "10.4.4", 5 | "browserslist": "latest", 6 | "cssnano": "5.1.4", 7 | "postcss": "8.4.12", 8 | "postcss-cli": "9.1.0", 9 | "postcss-combine-duplicated-selectors": "10.0.3", 10 | "postcss-import": "14.0.2", 11 | "postcss-nested": "5.0.6", 12 | "postcss-reporter": "7.0.5", 13 | "purgecss": "4.1.3", 14 | "react": "17.0.2", 15 | "react-dom": "17.0.2", 16 | "shadow-cljs": "2.17.8", 17 | "tailwindcss": "3.0.23" 18 | }, 19 | "repository": { 20 | "type": "git", 21 | "url": "https://github.com/serioga/webapp-clojure-2020.git" 22 | }, 23 | "license": "UNLICENSED" 24 | } 25 | -------------------------------------------------------------------------------- /.idea/ClojureProjectResolveSettings.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | PROJECT 11 | 12 | -------------------------------------------------------------------------------- /src/app/$_example/impl/handler.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.impl.handler 2 | (:require [lib.clojure.core :as c])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 7 | 8 | (defmulti route-path 9 | "Returns route path for tag." 10 | {:arglists '([route-tag])} 11 | c/first-arg) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | (defmulti example-handler 16 | "Handle ring request by route-tag." 17 | :route-tag) 18 | 19 | (c/add-method example-handler nil (constantly nil)) 20 | 21 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 22 | -------------------------------------------------------------------------------- /src/app/$_example/main.cljs: -------------------------------------------------------------------------------- 1 | (ns app.$-example.main 2 | ;; React components 3 | (:require [app.rum.core]) 4 | ;; Imports 5 | (:require [app.rum.mount :as rum.mount])) 6 | 7 | (set! *warn-on-infer* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | #_(defn ^:dev/after-load ^:private teardown 12 | [] 13 | (println "reloading page...") 14 | (.reload (-> js/window .-location) true)) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | 18 | (enable-console-print!) 19 | 20 | (rum.mount/mount-all) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | -------------------------------------------------------------------------------- /src/lib/ring_util/headers.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-util.headers 2 | (:import (java.time Instant ZonedDateTime ZoneOffset) 3 | (java.time.format DateTimeFormatter))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn instant->http-date 10 | "RFC-1123 date string from `java.time.Instant`." 11 | [^Instant instant] 12 | (let [d (ZonedDateTime/ofInstant instant ZoneOffset/UTC) 13 | formatter DateTimeFormatter/RFC_1123_DATE_TIME] 14 | (.format formatter d))) 15 | 16 | (comment 17 | (instant->http-date (Instant/now))) 18 | 19 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 20 | 21 | -------------------------------------------------------------------------------- /src/lib/cognitect_transit/core.cljs: -------------------------------------------------------------------------------- 1 | (ns lib.cognitect-transit.core 2 | (:require [cognitect.transit :as transit])) 3 | 4 | (set! *warn-on-infer* true) 5 | 6 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 7 | 8 | (defn read-transit-string 9 | "Read a transit encoded string into ClojureScript values 10 | given :json reader." 11 | [s] 12 | (transit/read (transit/reader :json) s)) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defn write-transit-string 17 | "Encode an object into a transit string given :json writer." 18 | [o] 19 | (transit/write (transit/writer :json) o)) 20 | 21 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 22 | -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:linters {:missing-docstring {:level :warning} 2 | :redundant-fn-wrapper {:level :warning} 3 | :shadowed-var {:level :warning 4 | :exclude [ref test] 5 | :suggest {key k val v keys ks}} 6 | :unsorted-required-namespaces {:level :warning}} 7 | :hooks {:analyze-call {rum.core/defc clj-kondo.rum/defc 8 | rum.core/defcs clj-kondo.rum/defcs}} 9 | :lint-as {app.database.hugsql/def clojure.core/declare 10 | mount.core/defstate clojure.core/def 11 | mount.tools.macrovich/deftime clojure.core/do 12 | rum.core/defcc rum.core/defc} 13 | :config-in-comment {:linters {:redundant-expression {:level :off} 14 | :unresolved-namespace {:level :off}}} 15 | :output {:exclude-files ["^dev\\\\user\\\\"]}} -------------------------------------------------------------------------------- /src/app/system/task/update_database_schema.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.task.update-database-schema 2 | (:require [integrant.core :as ig] 3 | [lib.clojure-tools-logging.logger :as logger] 4 | [lib.clojure.core :as c] 5 | [lib.liquibase.core :as liquibase])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (defmethod ig/init-key :app.system.task/update-database-schema 12 | [_ {:keys [data-source, changelog-path, system-is-enabled] :as config}] 13 | (when system-is-enabled 14 | (logger/info (logger/get-logger *ns*) (c/pr-str* "Update database schema" config)) 15 | (liquibase/update-database data-source, changelog-path)) 16 | system-is-enabled) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | -------------------------------------------------------------------------------- /dev/dev/env/shadow_cljs/server.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.shadow-cljs.server 2 | (:require [shadow.cljs.devtools.api :as api] 3 | [shadow.cljs.devtools.server :as server] 4 | [shadow.cljs.devtools.server.runtime :as runtime])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn start 11 | "Starts Shadow CLJS server." 12 | [{:keys [builds-to-start]}] 13 | (server/start!) 14 | (doseq [build builds-to-start] 15 | (api/watch build)) 16 | (runtime/get-instance)) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (defn stop! 21 | "Stops Shadow CLJS server." 22 | [_] 23 | (server/stop!)) 24 | 25 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 26 | -------------------------------------------------------------------------------- /src/lib/config/core.clj: -------------------------------------------------------------------------------- 1 | (ns lib.config.core) 2 | 3 | (set! *warn-on-reflection* true) 4 | 5 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 6 | 7 | (defn get-required 8 | "Get required value from config. 9 | Raise exception for missing keys." 10 | [config k] 11 | (let [none (Object.), v (config k none)] 12 | (when (identical? v none) 13 | (throw (Exception. (str "Missing configuration property " k)))) 14 | v)) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | 18 | (defn get-optional 19 | "Get optional value from config. 20 | Return `nil` or `default` for missing keys." 21 | ([config k] 22 | (get-optional config k nil)) 23 | ([config k default] 24 | (get config k default))) 25 | 26 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 27 | -------------------------------------------------------------------------------- /src/app/rum/mixin/static_args.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.mixin.static-args) 2 | 3 | #?(:clj (set! *warn-on-reflection* true) 4 | :cljs (set! *warn-on-infer* true)) 5 | 6 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 7 | 8 | (defn static-args-mixin 9 | "Avoid re-render if specific component’s arguments have not changed." 10 | [get-arg] 11 | {:should-update 12 | (fn [old-state new-state] 13 | (not= (get-arg (:rum/args old-state)) 14 | (get-arg (:rum/args new-state))))}) 15 | 16 | (def static-first-arg-mixin 17 | "Avoid re-render if first component’s arguments have not changed." 18 | (static-args-mixin first)) 19 | 20 | (def static-second-arg-mixin 21 | "Avoid re-render if second component’s arguments have not changed." 22 | (static-args-mixin second)) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | -------------------------------------------------------------------------------- /dev/dev/env/system/integrant/nrepl.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.integrant.nrepl 2 | (:require [dev.env.nrepl.server :as nrepl] 3 | [integrant.core :as ig])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (derive :dev.env.system.integrant/nrepl 10 | :lib.integrant.system/keep-running-on-suspend) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (defmethod ig/init-key :dev.env.system.integrant/nrepl 15 | [_ options] 16 | (nrepl/start-server options)) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (defmethod ig/halt-key! :dev.env.system.integrant/nrepl 21 | [_ server] 22 | (nrepl/stop-server server)) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | -------------------------------------------------------------------------------- /src/app/system/service/mount.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.service.mount 2 | (:require [integrant.core :as ig] 3 | [mount-up.core :as mu] 4 | [mount.core :as mount])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (mu/on-up :info mu/log :before) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (defmethod ig/init-key :app.system.service/mount 15 | [_ args] 16 | (try 17 | (mount/start-with-args args) 18 | (catch Throwable e 19 | (mount/stop) 20 | (throw e)))) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defmethod ig/halt-key! :app.system.service/mount 25 | [_ _] 26 | (mount/stop)) 27 | 28 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 29 | -------------------------------------------------------------------------------- /dev/dev/env/system/integrant/shadow_cljs.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.integrant.shadow-cljs 2 | (:require [dev.env.shadow-cljs.server :as server] 3 | [integrant.core :as ig])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (derive :dev.env.system.integrant/shadow-cljs 10 | :lib.integrant.system/keep-running-on-suspend) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (defmethod ig/init-key :dev.env.system.integrant/shadow-cljs 15 | [_ options] 16 | (server/start options)) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (defmethod ig/halt-key! :dev.env.system.integrant/shadow-cljs 21 | [_ server] 22 | (server/stop! server)) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | -------------------------------------------------------------------------------- /src/lib/slf4j/mdc.clj: -------------------------------------------------------------------------------- 1 | (ns lib.slf4j.mdc 2 | "MDC logging context utility." 3 | (:import (java.io Closeable) 4 | (org.slf4j MDC))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (def ^:private noop-closeable 11 | (reify Closeable (close [_]))) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | (defn ^Closeable put-closeable 16 | "Puts a diagnostic context value `v` as identified with the key `k` 17 | into the current thread's diagnostic context map. 18 | Returns a Closeable object who can remove key when close is called. 19 | The `k` cannot be null. 20 | If the `v` is null then nothing is put and noop Closeable returned." 21 | [k v] 22 | (if (some? v) (MDC/putCloseable k v), noop-closeable)) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | -------------------------------------------------------------------------------- /src/lib/clojure/print.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.print) 2 | 3 | (set! *warn-on-reflection* true) 4 | 5 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 6 | 7 | (deftype StringLiteral [x]) 8 | 9 | (defmethod print-method StringLiteral [o, w] 10 | (binding [*print-readably* nil] 11 | (print-method (.x ^StringLiteral o) w))) 12 | 13 | (defmacro pr-str* 14 | "Prints to string like `clojure.core/pr-str` but string literals without quotes." 15 | [& more] 16 | `(pr-str ~@(->> more (map #(if (string? %) (list ->StringLiteral %), %))))) 17 | 18 | (comment 19 | (macroexpand-1 '(pr-str* "a" "b" "c" 'd (str "e") {:f "f"} "" (str ""))) 20 | (pr-str* "a" "b" "c" 'd (str "e") {:f "f"} nil (str "")) 21 | #_"a b c d \"e\" {:f \"f\"} nil \"\"" 22 | (println (pr-str* "a" "b" "c" 'd (str "e") {:f "f"} nil (str ""))) 23 | ;;a b c d "e" {:f "f"} nil "" 24 | ) 25 | 26 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 27 | -------------------------------------------------------------------------------- /src/lib/liquibase/core.clj: -------------------------------------------------------------------------------- 1 | (ns lib.liquibase.core 2 | (:import (javax.sql DataSource) 3 | (liquibase.database Database DatabaseFactory) 4 | (liquibase.database.jvm JdbcConnection) 5 | (liquibase Liquibase Contexts) 6 | (liquibase.resource ClassLoaderResourceAccessor))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (defn update-database 13 | "Updates database schema using liquibase." 14 | [^DataSource ds, ^String changelog-path] 15 | 16 | (with-open [jdbc-conn (JdbcConnection. (.getConnection ds))] 17 | (let [db (-> (DatabaseFactory/getInstance) 18 | (.findCorrectDatabaseImplementation jdbc-conn)) 19 | contexts (Contexts.) 20 | resource-accessor (ClassLoaderResourceAccessor.) 21 | liquibase (Liquibase. changelog-path resource-accessor ^Database db)] 22 | (.update liquibase contexts)))) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | -------------------------------------------------------------------------------- /src/app/$_example/core.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.core 2 | (:require [app.$-example.impl.handler :as handler] 3 | [app.rum.core #_"React components"] 4 | [app.webapp.ring-handler :as ring-handler] 5 | [lib.clojure.ns :as ns])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (ns/require-dir 'app.$-example.handler._) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | (defn- example-routes 16 | [] 17 | (ring-handler/collect-routes handler/route-path)) 18 | 19 | (comment 20 | (example-routes)) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defn example-http-handler 25 | "HTTP server handler for `example` webapp." 26 | [config] 27 | (ring-handler/webapp-http-handler handler/example-handler, (example-routes), config)) 28 | 29 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 30 | -------------------------------------------------------------------------------- /src/app/rum/component/hello_world.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.component.hello-world 2 | "Example react component, modification of 3 | https://github.com/tonsky/rum/blob/gh-pages/examples/rum/examples/local_state.cljc" 4 | (:require [app.rum.impl.component :as impl] 5 | [lib.clojure.core :as c] 6 | [rum.core :as rum])) 7 | 8 | #?(:clj (set! *warn-on-reflection* true) 9 | :cljs (set! *warn-on-infer* true)) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (rum/defcs hello-world 14 | "Example react component." 15 | < (rum/local 0) 16 | [state greeting] 17 | (let [count! (:rum/local state)] 18 | [:div 19 | {:style {"-webkit-user-select" "none" 20 | "cursor" "pointer"} 21 | :on-click (fn [_] (swap! count! inc))} 22 | (str "Hello, " greeting ": " @count! " clicks.")])) 23 | 24 | (c/add-method impl/create-component :react-component/hello-world 25 | (comp hello-world :name)) 26 | 27 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 28 | -------------------------------------------------------------------------------- /resources/app/database/schema/table/example_user.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /tailwind/app/$_example/main.css: -------------------------------------------------------------------------------- 1 | /** 2 | * This injects Tailwind's base styles, which is a combination of 3 | * Normalize.css and some additional base styles. 4 | */ 5 | @import "tailwindcss/base"; 6 | 7 | /** 8 | * This injects any component classes registered by plugins. 9 | */ 10 | @import "tailwindcss/components"; 11 | 12 | /** 13 | * Here you would add any of your custom component classes; stuff that you'd 14 | * want loaded *before* the utilities so that the utilities could still 15 | * override them. 16 | */ 17 | @import "css/layout"; 18 | @import "css/component_hello-world"; 19 | 20 | /** 21 | * This injects all of Tailwind's utility classes, generated based on your 22 | * config file. 23 | */ 24 | @import "tailwindcss/utilities"; 25 | 26 | /** 27 | * Here you would add any custom utilities you need that don't come out of the 28 | * box with Tailwind. 29 | * 30 | * Example : 31 | * 32 | * .bg-pattern-graph-paper { ... } 33 | * .skew-45 { ... } 34 | * 35 | * Or if using a preprocessor or `postcss-import`: 36 | * 37 | * @import "utilities/background-patterns"; 38 | * @import "utilities/skew-transforms"; 39 | */ 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Sergey Trofimov 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /resources/app/database/sql/_naming-convention.txt: -------------------------------------------------------------------------------- 1 | Goals: 2 | - Consolidate same table operations. 3 | - Group reading and modifying queries separately. 4 | - Provide info about query result type. 5 | 6 | 7 | Read-write queries (:command :execute): 8 | 9 | {table}--do-{execute}-{extra}{result}.sql 10 | ----------------------------------------- 11 | 12 | 13 | Read-only queries (:command :query): 14 | 15 | {table}--select-{where}-{extra}{result}.sql 16 | ------------------------------------------- 17 | 18 | 19 | where 20 | 21 | {table} Table name (real or alias). 22 | 23 | {execute} Description of :execute command operations. 24 | Can include {where} for the update/delete commands. 25 | 26 | {where} Descriptions of the conditions which defines query result. 27 | The `all` is user for `select` queries without conditions. 28 | 29 | {extra} Optional clarification of query purpose. 30 | 31 | {result} Optional suffix for query result 32 | - `-one` - one row (:result :one) 33 | - `-n` - affected rows (:result :affected) 34 | - `!` - :execute command without result 35 | -------------------------------------------------------------------------------- /src/lib/ring_util/cookie.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-util.cookie) 2 | 3 | (set! *warn-on-reflection* true) 4 | 5 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 6 | 7 | (defn get-cookie-value 8 | "Reads cookie value from request." 9 | [request cookie-name] 10 | (get-in request [:cookies cookie-name :value])) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (defn set-cookie 15 | "Sets named cookie in ring response." 16 | [response cookie-name cookie] 17 | (let [c (assoc cookie :path "/" 18 | #_#_#_#_:http-only true 19 | :same-site :strict)] 20 | (update response :cookies assoc cookie-name c))) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defn remove-cookie 25 | "Removes named cookie in ring response." 26 | [response cookie-name] 27 | (set-cookie response cookie-name {:value "removing_cookie_value..." :max-age -1})) 28 | 29 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 30 | -------------------------------------------------------------------------------- /dev/dev/env/nrepl/server.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.nrepl.server 2 | (:require [clojure.java.io :as io] 3 | [nrepl.server :as nrepl])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn start-server 10 | "Starts nREPL server." 11 | [{:keys [port, write-port-file]}] 12 | (let [server (nrepl/start-server :port port)] 13 | (when (some? write-port-file) 14 | (let [nrepl-port-file (io/file write-port-file)] 15 | (spit nrepl-port-file (str (:port server))) 16 | (.deleteOnExit nrepl-port-file))) 17 | server)) 18 | 19 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 20 | 21 | (defn stop-server 22 | "Stops nREPL server." 23 | [server] 24 | (nrepl/stop-server server)) 25 | 26 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 27 | 28 | (comment 29 | (time (let [server (time (start-server {}))] 30 | (time (stop-server server))))) 31 | 32 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 33 | -------------------------------------------------------------------------------- /src/app/config/core.clj: -------------------------------------------------------------------------------- 1 | (ns app.config.core 2 | (:require [lib.clojure.core :as c] 3 | [lib.config.core :as config] 4 | [mount.core :as mount])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (mount/defstate optional 11 | "Get optional value from global app-config. 12 | Return `nil` or `default` for missing keys." 13 | {:arglists '([key] [key default]) :on-reload :noop} 14 | :start (let [app-config (::app-config (mount/args))] 15 | (c/assert-pred app-config map?) 16 | (partial config/get-optional app-config))) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (mount/defstate required 21 | "Get required value from global app-config. 22 | Raise exception for missing keys." 23 | {:arglists '([key]) :on-reload :noop} 24 | :start (let [app-config (::app-config (mount/args))] 25 | (c/assert-pred app-config map?) 26 | (partial config/get-required app-config))) 27 | 28 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 29 | -------------------------------------------------------------------------------- /src/app/$_example/handler/example_database.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.handler.example-database 2 | (:require [app.$-example.impl.handler :as impl] 3 | [app.$-example.impl.html :as html] 4 | [app.database.core :as db] 5 | [clojure.pprint :as pprint] 6 | [lib.clojure.core :as c])) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (c/add-method impl/route-path :route/example-database (constantly "/example-database")) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defmethod impl/example-handler :route/example-database 17 | [_] 18 | (let [title "SQL Database example" 19 | result (db/example-user--select-all)] 20 | (-> [:html [:head 21 | [:title title] 22 | (html/include-app-css)] 23 | [:body 24 | [:h1 title] 25 | [:div 26 | [:pre (with-out-str (pprint/pprint result))] 27 | (html/link-to-index)]]] 28 | (html/response)))) 29 | 30 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 31 | -------------------------------------------------------------------------------- /.idea/codeStyles/Project.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 31 | -------------------------------------------------------------------------------- /src/app/rum/mixin/local.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.mixin.local 2 | "Similar to rum/local but but with function of state as initial value." 3 | #?(:cljs (:require [rum.core :as rum]))) 4 | 5 | #?(:clj (set! *warn-on-reflection* true) 6 | :cljs (set! *warn-on-infer* true)) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn local-mixin 11 | "Mixin constructor. Adds an atom to component’s state that can be used to keep stuff 12 | during component’s lifecycle. Component will be re-rendered if atom’s value changes. 13 | Atom is stored under user-provided key or under `:rum/local` by default" 14 | ([init-state] (local-mixin init-state :rum/local)) 15 | ([init-state k] 16 | {:will-mount #?(:clj (fn [state] 17 | (assoc state k (atom (init-state state)))) 18 | 19 | :cljs (fn [state] 20 | (let [local! (atom (init-state state)) 21 | component (:rum/react-component state)] 22 | (add-watch local! k (fn [_ _ _ _] (rum/request-render component))) 23 | (assoc state k local!))))})) 24 | 25 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 26 | -------------------------------------------------------------------------------- /src/app/$_example/handler/index.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.handler.index 2 | (:require [app.$-example.impl.handler :as impl] 3 | [app.$-example.impl.html :as html] 4 | [lib.clojure.core :as c])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (c/add-method impl/route-path :route/index (constantly "/")) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (defmethod impl/example-handler :route/index 15 | [{:keys [route-tag/path-for-route]}] 16 | (-> [:html [:head 17 | [:title "Homepage"] 18 | (html/include-app-css)] 19 | [:body 20 | [:h1 "Examples"] 21 | [:ul 22 | [:li [:a {:href (path-for-route :route/example-react)} "React Component"]] 23 | [:li [:a {:href (path-for-route :route/example-database)} "SQL Database"]] 24 | [:li [:a {:href (path-for-route :route/example-path-param {:name "Test Name" 25 | :value "Test Value"})} "Path Parameter"]]]]] 26 | (html/response))) 27 | 28 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 29 | -------------------------------------------------------------------------------- /src/lib/ring_middleware/error_not_found.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-middleware.error-not-found 2 | (:require [clojure.pprint :as pprint] 3 | [lib.ring-util.response :as ring.response'] 4 | [ring.util.request :as ring.request])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn- response-error-not-found 11 | [request, dev-mode] 12 | (-> (str "[HTTP 404] Resource not found.\n\n" 13 | "URL: " 14 | (ring.request/request-url request) 15 | (when dev-mode 16 | (str 17 | "\n\n" "---" "\n" 18 | "Default not-found handler, dev mode." 19 | "\n\n" 20 | (with-out-str (pprint/pprint request))))) 21 | (ring.response'/plain-text 404))) 22 | 23 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 24 | 25 | (defn wrap-error-not-found 26 | "Wrap handler with middleware replacing `nil` response with default." 27 | [handler, dev-mode] 28 | (fn [request] (or (handler request) 29 | (response-error-not-found request, dev-mode)))) 30 | 31 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 32 | -------------------------------------------------------------------------------- /dev/dev/env/system/integrant/watcher.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.integrant.watcher 2 | (:require [dev.env.reload.watcher :as watcher] 3 | [integrant.core :as ig] 4 | [lib.clojure-tools-logging.logger :as logger] 5 | [lib.clojure.core :as c])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (def ^:private logger (logger/get-logger *ns*)) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | (defmethod ig/init-key :dev.env.system.integrant/watcher 16 | [_ {:keys [handler, options, handler-run-on-init]}] 17 | (let [watcher (watcher/start-watcher handler options)] 18 | (when handler-run-on-init 19 | (try 20 | (handler :init-watcher) 21 | (catch Throwable e 22 | (logger/log-throwable logger e (c/pr-str* "Run handler on init" handler options))))) 23 | watcher)) 24 | 25 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 26 | 27 | (defmethod ig/halt-key! :dev.env.system.integrant/watcher 28 | [_ watcher] 29 | (watcher/stop-watcher watcher)) 30 | 31 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 32 | -------------------------------------------------------------------------------- /src/app/rum/component.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.component 2 | (:require [app.rum.impl.component :as impl])) 3 | 4 | #?(:clj (set! *warn-on-reflection* true) 5 | :cljs (set! *warn-on-infer* true)) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn create-component 10 | "Component constructor by ID keyword in `data`." 11 | [data] 12 | (impl/create-component data)) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defn component-id 17 | "Get component ID." 18 | [data] 19 | (:app.rum/component-id data)) 20 | 21 | (defn set-component-id 22 | "Set component ID." 23 | [data comp-id] 24 | (assoc data :app.rum/component-id comp-id)) 25 | 26 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 27 | 28 | (defn instance-id 29 | "Instance ID to differentiate several components with same component. 30 | Optional, defaults to `component-id`." 31 | [data] 32 | (or (::instance-id data) 33 | (component-id data))) 34 | 35 | (defn set-instance-id 36 | "Set component instance ID." 37 | [data id] 38 | (assoc data ::instance-id id)) 39 | 40 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 41 | -------------------------------------------------------------------------------- /src/app/$_example/handler/example_react.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.handler.example-react 2 | (:require [app.$-example.impl.handler :as impl] 3 | [app.$-example.impl.html :as html] 4 | [app.rum.mount :as rum.mount] 5 | [lib.clojure.core :as c])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (c/add-method impl/route-path :route/example-react (constantly "/example-react")) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | ;; TODO: Deferred JS loading in release. 16 | 17 | (defmethod impl/example-handler :route/example-react 18 | [request] 19 | (let [[components!, mount-component] (rum.mount/init-mounter request) 20 | title "React Component example"] 21 | (-> [:html [:head 22 | [:title title] 23 | (html/include-app-css)] 24 | [:body 25 | [:h1 title] 26 | (mount-component :react-component/hello-world {:name "World"}) 27 | (html/link-to-index) 28 | (rum.mount/react-mount-data-js @components!) 29 | (html/include-app-js)]] 30 | (html/response)))) 31 | 32 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 33 | -------------------------------------------------------------------------------- /src/app/system/service/webapp_http_handler.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.service.webapp-http-handler 2 | (:require [app.$-example.core :as example] 3 | [integrant.core :as ig] 4 | [lib.clojure.core :as c])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defmulti webapp-http-handler 11 | "Provide webapp server handler by :name from config." 12 | :name) 13 | 14 | (defmethod webapp-http-handler :default 15 | [{webapp-name :name}] 16 | (throw (Exception. (c/pr-str* "Webapp handler is not found for name" webapp-name) nil))) 17 | 18 | (c/add-method webapp-http-handler "example" 19 | example/example-http-handler) 20 | 21 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 22 | 23 | (defmethod ig/init-key :app.system.service/webapp-http-handler 24 | [_ {:keys [hosts, system-is-enabled] :or {system-is-enabled true} :as config}] 25 | (cond-> config 26 | system-is-enabled (-> (assoc :handler (webapp-http-handler config) 27 | :options (cond-> {} 28 | (seq hosts) (assoc :virtual-host (vec hosts))))))) 29 | 30 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 31 | -------------------------------------------------------------------------------- /dev/dev/config/default.edn: -------------------------------------------------------------------------------- 1 | {:dev.env.system/config 2 | {:dev.env.system.integrant/nrepl {:write-port-file ".nrepl-port"} 3 | 4 | :dev.env.system.integrant/shadow-cljs {:builds-to-start [:example]} 5 | 6 | :dev.env.system.integrant/app-reload 7 | {:watcher {:handler {:ns-tracker-dirs ["src" "dev"] 8 | :always-reload-ns [app.database.core] 9 | :never-reload-ns [] 10 | :never-reload-ns-in ["user"]} 11 | :options {:dirs ["src" "dev" "resources/app"] 12 | ;; See http://docs.caudate.me/hara/hara-io-watch.html#watch-options 13 | ;; :filter will pick out only files that match this pattern. 14 | :files [".props$" ".clj$" ".cljc$" ".cljs$" ".sql$" ".xml$"] 15 | ;; See http://docs.caudate.me/hara/hara-io-watch.html#watch-options 16 | ;; :exclude will leave out files that match this pattern. 17 | :exclude ["dev\\\\user"]}}} 18 | 19 | :dev.env.system.integrant/tailwind 20 | {:webapp "example" 21 | :watcher {:options {:dirs ["tailwind/app/config" "tailwind/app/$_example"] 22 | :files [".css" ".js$"]}} 23 | :content-watcher {:options {:dirs ["src/app/$_example"] :files [".clj"]}} 24 | :dependent-mount-states ["#'app.$-example.impl.html/styles-css-uri"]}}} 25 | -------------------------------------------------------------------------------- /src/lib/ring_middleware/error_exception.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-middleware.error-exception 2 | (:require [lib.clojure-tools-logging.logger :as logger] 3 | [lib.clojure.core :as c] 4 | [lib.ring-util.response :as ring.response'])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn- response-error-exception 11 | [throwable, dev-mode] 12 | (let [status 500 13 | message (str "[HTTP " status "] " 14 | (c/ex-message-all throwable) 15 | (when dev-mode 16 | (str "\n\n" "---" "\n" 17 | "Default exception handler, dev mode." 18 | "\n\n" 19 | (prn-str throwable))))] 20 | (ring.response'/plain-text message status))) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defn wrap-error-exception 25 | "Wrap handler with exception handler." 26 | [handler, dev-mode] 27 | (fn [request] 28 | (try 29 | (handler request) 30 | (catch Throwable e 31 | (logger/log-throwable e "Handle HTTP request") 32 | (response-error-exception e, dev-mode))))) 33 | 34 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 35 | -------------------------------------------------------------------------------- /dev/dev/env/system/integrant/app_reload.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.integrant.app-reload 2 | (:require [dev.env.reload.app-reload :as app-reload] 3 | [dev.env.system.app :as app.system] 4 | [integrant.core :as ig])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn- build-watch-handler 11 | [config] 12 | (app-reload/watch-handler (assoc config :app-stop #'app.system/suspend 13 | :app-start #'app.system/resume 14 | :on-success #'app-reload/log-reload-success 15 | :on-failure #'app-reload/log-reload-failure))) 16 | 17 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 18 | 19 | (defmethod ig/init-key :dev.env.system.integrant/app-reload 20 | [_ {:keys [watcher]}] 21 | (ig/init-key :dev.env.system.integrant/watcher 22 | (-> watcher (update :handler build-watch-handler)))) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | 26 | (defmethod ig/halt-key! :dev.env.system.integrant/app-reload 27 | [_ watcher] 28 | (ig/halt-key! :dev.env.system.integrant/watcher watcher)) 29 | 30 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 31 | -------------------------------------------------------------------------------- /src/lib/cognitect_transit/core.clj: -------------------------------------------------------------------------------- 1 | (ns lib.cognitect-transit.core 2 | (:require [cognitect.transit :as transit]) 3 | (:import (java.io ByteArrayOutputStream ByteArrayInputStream))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn read-transit-stream 10 | "Read data from input stream with transit bytes." 11 | [stream] 12 | (transit/read (transit/reader stream :json))) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defn read-transit-string 17 | "Read data from string with transit bytes." 18 | [^String s] 19 | (read-transit-stream (ByteArrayInputStream. (.getBytes s "UTF-8")))) 20 | 21 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 22 | 23 | (defn- write-transit 24 | [o out] 25 | (transit/write (transit/writer out :json) o)) 26 | 27 | (defn- write-bytes 28 | ^bytes [o] 29 | (let [os (ByteArrayOutputStream.)] 30 | (write-transit o os) 31 | (.toByteArray os))) 32 | 33 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 34 | 35 | (defn write-transit-string 36 | "Write data as transit string." 37 | [o] 38 | (String. (write-bytes o) "UTF-8")) 39 | 40 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 41 | -------------------------------------------------------------------------------- /src/app/$_example/impl/html.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.impl.html 2 | (:require [app.html.core :as html] 3 | [lib.ring-util.response :as ring.response'] 4 | [mount.core :as mount])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (mount/defstate styles-css-uri 11 | "Path to CSS with hash parameter" 12 | {:on-reload :noop} 13 | :start (html/static-uri-with-hash "/app/example/main.css")) 14 | 15 | (defn include-app-css 16 | "Hiccup including main.css." 17 | [] 18 | (html/include-css styles-css-uri)) 19 | 20 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 21 | 22 | (defn include-app-js 23 | "Hiccup including main.js." 24 | [] 25 | (html/include-js "/app/example/main.js")) 26 | 27 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 28 | 29 | (defn link-to-index 30 | "Build hiccup for the link to index page." 31 | [] 32 | [:p.mt-4 [:a {:href "/"} "< index"]]) 33 | 34 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 35 | 36 | (defn response 37 | "Render hiccup to HTML response." 38 | [hiccup] 39 | (-> hiccup 40 | (html/render-page) 41 | (ring.response'/html))) 42 | 43 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 44 | -------------------------------------------------------------------------------- /src/lib/ring_util/response.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-util.response) 2 | 3 | (set! *warn-on-reflection* true) 4 | 5 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 6 | 7 | (defn- response-type-charset* 8 | ([body content-type] 9 | (response-type-charset* body content-type 200)) 10 | ([body content-type status] 11 | {:body body 12 | :headers {"Content-Type" (.concat ^String content-type "; charset=utf-8")} 13 | :status status})) 14 | 15 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 16 | 17 | (defn plain-text 18 | "Ring response with `text/plain` type." 19 | ([body] 20 | (plain-text body 200)) 21 | ([body status] 22 | (response-type-charset* body "text/plain" status))) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | 26 | (defn xml 27 | "Ring response with `application/xml` type." 28 | ([body] 29 | (xml body 200)) 30 | ([body status] 31 | (response-type-charset* body "application/xml" status))) 32 | 33 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 34 | 35 | (defn html 36 | "Ring response with `text/html` type." 37 | ([body] 38 | (html body 200)) 39 | ([body status] 40 | (response-type-charset* body "text/html" status))) 41 | 42 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 43 | -------------------------------------------------------------------------------- /src/lib/util/ansi_escape.clj: -------------------------------------------------------------------------------- 1 | (ns lib.util.ansi-escape 2 | "ANSI color escape sequences. 3 | See https://stackoverflow.com/questions/4842424/list-of-ansi-color-escape-sequences.") 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | ;;; Font effects. 10 | 11 | (def ^:const reset "Reset/Normal." "\033[0m") 12 | 13 | ;;; 4-bit colors. 14 | 15 | (def ^:const fg-black,,,, "Black FG color.",,,,,,,,, "\033[30m") 16 | (def ^:const fg-black-b,, "Bright Black FG color.",, "\033[90m") 17 | (def ^:const fg-red,,,,,, "Red FG color.",,,,,,,,,,, "\033[31m") 18 | (def ^:const fg-red-b,,,, "Bright Red FG color.",,,, "\033[91m") 19 | (def ^:const fg-green,,,, "Green FG color.",,,,,,,,, "\033[32m") 20 | (def ^:const fg-green-b,, "Bright Green FG color.",, "\033[92m") 21 | (def ^:const fg-yellow,,, "Yellow FG color.",,,,,,,, "\033[33m") 22 | (def ^:const fg-yellow-b, "Bright Yellow FG color.", "\033[93m") 23 | (def ^:const fg-blue,,,,, "Blue FG color.",,,,,,,,,, "\033[34m") 24 | (def ^:const fg-blue-b,,, "Bright Blue FG color.",,, "\033[94m") 25 | (def ^:const fg-magenta,, "Magenta FG color.",,,,,,, "\033[35m") 26 | (def ^:const fg-magenta-b "Bright Magenta FG color." "\033[95m") 27 | (def ^:const fg-cyan,,,,, "Cyan FG color.",,,,,,,,,, "\033[36m") 28 | (def ^:const fg-cyan-b,,, "Bright Cyan FG color.",,, "\033[96m") 29 | 30 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 31 | -------------------------------------------------------------------------------- /src/app/$_example/handler/example_path_param.clj: -------------------------------------------------------------------------------- 1 | (ns app.$-example.handler.example-path-param 2 | (:require [app.$-example.impl.handler :as impl] 3 | [app.$-example.impl.html :as html] 4 | [clojure.walk :as walk] 5 | [lib.clojure.core :as c])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (c/add-method impl/route-path :route/example-path-param (constantly "/example-path-param/:name")) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | (defmethod impl/example-handler :route/example-path-param 16 | [request] 17 | (let [title "Path Parameter example" 18 | {name-param :name value-param :value} (:params request)] 19 | (-> [:html [:head 20 | [:title title] 21 | (html/include-app-css)] 22 | [:body 23 | [:h1 title] 24 | [:div 25 | [:div.border.p-2.mb-4 26 | [:tt (str (walk/prewalk-replace {'name-param name-param 'value-param value-param} 27 | '(path-for-route :route/example-path-param {:name name-param :value value-param})))]] 28 | [:ul 29 | [:li "Name: " [:tt.bg-gray-100 name-param]] 30 | [:li "Value: " [:tt.bg-gray-100 value-param]]] 31 | (html/link-to-index)]]] 32 | (html/response)))) 33 | 34 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 35 | -------------------------------------------------------------------------------- /src/lib/util/uuid.clj: -------------------------------------------------------------------------------- 1 | (ns lib.util.uuid 2 | (:require [lib.clojure.core :as c]) 3 | (:import (java.util UUID))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn from-string 10 | "Returns UUID for the string representation. Accepts only zero-padded 11 | representation. Returns `nil` for `nil`." 12 | [s] 13 | (when (some? s) 14 | (c/assert-pred s string? `from-string) 15 | (try (let [uuid (UUID/fromString s)] 16 | (when (= s (str uuid)) 17 | uuid)) 18 | (catch Throwable _)))) 19 | 20 | (comment 21 | (from-string "123") ; Execution time mean : 4506,021 ns 22 | #_nil 23 | (from-string "49230eb0-9e0c-4d5e-b22e-3bd022cc72d0") ; Execution time mean : 344,776 ns 24 | #_#uuid"49230eb0-9e0c-4d5e-b22e-3bd022cc72d0" 25 | (UUID/fromString "4-9-4-b-3") ; Execution time mean : 142,046 ns 26 | #_#uuid"00000004-0009-0004-000b-000000000003" 27 | (from-string "4-9-4-b-3") ; Execution time mean : 191,114 ns 28 | #_nil 29 | (from-string nil) ; Execution time mean : 1,315 ns 30 | #_nil 31 | (from-string [1 2 3]) 32 | ;;clojure.lang.ExceptionInfo: lib.util.uuid/from-string - Assert failed: (assert-pred s string?) 33 | ;; #:lib.clojure.assert{:value [1 2 3], :type clojure.lang.PersistentVector, :failure :assertion-failed} 34 | ) 35 | 36 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 37 | -------------------------------------------------------------------------------- /src/app/system/service/hikari_data_source.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.service.hikari-data-source 2 | (:require [integrant.core :as ig] 3 | [lib.hikari-cp.data-source :as data-source]) 4 | (:import (com.p6spy.engine.spy P6DataSource) 5 | (java.io Closeable))) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (defn- init-data-source 12 | [options] 13 | (let [ds (data-source/create-data-source options) 14 | spy-wrapped-ds (P6DataSource. ds)] 15 | spy-wrapped-ds)) 16 | 17 | (defn- close-data-source! 18 | [^P6DataSource spy-wrapped-ds] 19 | (.close ^Closeable (.unwrap spy-wrapped-ds Closeable))) 20 | 21 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 22 | 23 | (defmethod ig/init-key :app.system.service/hikari-data-source 24 | [_ {:keys [dev-mode] :as options}] 25 | (init-data-source (-> {:minimum-idle 1 26 | :maximum-pool-size 10 27 | :connection-timeout 5000 28 | :leak-detection-threshold 30000} 29 | (cond-> dev-mode (assoc :max-lifetime 300000 30 | :idle-timeout 60000)) 31 | (merge options)))) 32 | 33 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 34 | 35 | (defmethod ig/halt-key! :app.system.service/hikari-data-source 36 | [_ data-source] 37 | (close-data-source! data-source)) 38 | 39 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 40 | -------------------------------------------------------------------------------- /src/lib/clojure/core.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.core 2 | (:refer-clojure :exclude [assert, future]) 3 | (:require [lib.clojure.assert] 4 | [lib.clojure.exception] 5 | [lib.clojure.future] 6 | [lib.clojure.lang] 7 | [lib.clojure.print] 8 | [medley.core] 9 | [potemkin :refer [import-vars]])) 10 | 11 | (set! *warn-on-reflection* true) 12 | 13 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 14 | 15 | (import-vars [lib.clojure.assert assert, assert-pred, assert-try] 16 | 17 | [lib.clojure.exception ex-message-all, ex-root-cause] 18 | 19 | [lib.clojure.future future] 20 | 21 | [lib.clojure.print pr-str*] 22 | 23 | [lib.clojure.lang add-method, first-arg, second-arg, invoke, select, unwrap-fn, unwrap-future]) 24 | 25 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 26 | 27 | ;; The `declare` is a workaround for name resolution in Cursive. 28 | ;; See https://github.com/cursive-ide/cursive/issues/2411. 29 | 30 | (declare find-first map-entry) 31 | (import-vars [medley.core find-first map-entry]) 32 | 33 | (declare map-kv map-keys map-vals) 34 | (import-vars [medley.core map-kv map-keys map-vals]) 35 | 36 | (declare filter-kv filter-keys filter-vals) 37 | (import-vars [medley.core filter-kv filter-keys filter-vals]) 38 | 39 | (declare remove-kv remove-keys remove-vals) 40 | (import-vars [medley.core remove-kv remove-keys remove-vals]) 41 | 42 | (declare deep-merge) 43 | (import-vars [medley.core deep-merge]) 44 | 45 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 46 | -------------------------------------------------------------------------------- /src/lib/hugsql/core.clj: -------------------------------------------------------------------------------- 1 | (ns lib.hugsql.core 2 | (:require [hugsql.core :as hugsql] 3 | [lib.clojure.core :as c])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn- sql-with-name 10 | "Adds function name in the body of SQL query as comment. 11 | For tracing SQL queries in logs." 12 | [s nom] 13 | (str "/* " nom " */\n" s)) 14 | 15 | (defn- name-parsed-def 16 | "Adds name to anonymously parsed def." 17 | [pdef nom] 18 | (-> pdef 19 | (update :hdr assoc :name [nom]) 20 | (update-in [:sql 0] sql-with-name nom))) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defn intern-db-fn 25 | "Intern the db fn from a parsed def." 26 | [pdef options wrap-db-fn-map] 27 | (let [fm (cond-> (hugsql/db-fn-map pdef options) wrap-db-fn-map wrap-db-fn-map) 28 | fk (ffirst fm)] 29 | (intern *ns* 30 | (with-meta (symbol (name fk)) (-> fm fk :meta (assoc :sql (:sql pdef)))) 31 | (-> fm fk :fn)))) 32 | 33 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 34 | 35 | (defn def-db-fn-from-file 36 | "Interns the db fn for symbol `sym` from file in `path`." 37 | [sym path wrap-db-fn-map options] 38 | (-> (str path sym ".sql") 39 | (hugsql/parsed-defs-from-file) 40 | (first) 41 | (doto (c/assert-pred some? (str "Parsed SQL with name " sym))) 42 | (name-parsed-def sym) 43 | (intern-db-fn options wrap-db-fn-map))) 44 | 45 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 46 | -------------------------------------------------------------------------------- /src/lib/clojure/ns.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.ns 2 | (:require [clojure.java.io :as io] 3 | [clojure.string :as string]) 4 | (:import (java.io FilenameFilter))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn- ns->path 11 | [s] 12 | (-> (name s) 13 | (string/replace "." "/") 14 | (string/replace "-" "_"))) 15 | 16 | (defn- filename->ns 17 | [s] 18 | (-> (re-find #"[^.]+" s) 19 | (string/replace "_" "-"))) 20 | 21 | (defn- list-dir-ns 22 | ([n] (list-dir-ns n :clj)) 23 | ([n ext] 24 | (let [n (-> n name (string/replace #"\.[_*]?$" "")) 25 | ext (str "." (name ext)) 26 | path (ns->path n)] 27 | (map (fn [filename] 28 | (symbol (str n "." (filename->ns filename)))) 29 | (-> (or (io/resource path) 30 | (throw (Exception. (str "Folder not found " path)))) 31 | (io/as-file) 32 | (.list (reify FilenameFilter 33 | (accept [_ _ filename] (string/ends-with? filename ext))))))))) 34 | 35 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 36 | 37 | (defmacro require-dir 38 | "Loads all child namespaces in namespace `n` from files with extension `ext`. 39 | Trailing characters '_' or '*' of `n` are ignored. 40 | Extension `ext` is string or keyword, default extension is \"clj\". 41 | Examples: 42 | `(require-dir 'app.my-ns._)` 43 | `(require-dir 'app.my-ns.* :cljc)`" 44 | ([n] `(require-dir ~n :clj)) 45 | ([n ext] 46 | `(require ~@(map (partial list `quote) 47 | (list-dir-ns (eval n) ext))))) 48 | 49 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 50 | -------------------------------------------------------------------------------- /src/app/html/core.clj: -------------------------------------------------------------------------------- 1 | (ns app.html.core 2 | (:require [clojure.java.io :as io] 3 | [rum.core :as rum]) 4 | (:import (org.apache.commons.codec.digest DigestUtils))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn render-page 11 | "Renders hiccup to HTML page string." 12 | [hiccup] 13 | (str "\n" 14 | (rum/render-static-markup hiccup))) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | 18 | (defn include-css 19 | "Hiccup to include external CSS." 20 | [href] 21 | [:link {:type "text/css", :href href, :rel "stylesheet"}]) 22 | 23 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 24 | 25 | (defn include-js 26 | "Hiccup to include external JS." 27 | ([src] 28 | (include-js src nil)) 29 | ([src, defer-or-async] 30 | (list [:script {:type "text/javascript" 31 | :src src 32 | :defer (= :defer defer-or-async) 33 | :async (= :async defer-or-async)}]))) 34 | 35 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 36 | 37 | (defn static-uri-with-hash 38 | "Attach hash parameter to URI of static resource." 39 | [uri] 40 | (let [path (str "public" uri) 41 | content (slurp (or (io/resource path) 42 | (throw (ex-info (print-str "Missing static resource" (pr-str path)) 43 | {:name name :resource-path path})))) 44 | content-hash (DigestUtils/sha256Hex content)] 45 | (str uri "?" content-hash))) 46 | 47 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 48 | -------------------------------------------------------------------------------- /dev/dev/env/main.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.main 2 | "Initial namespace for development. 3 | Not included to release application! 4 | See `core` namespace as initial release application." 5 | (:require [dev.env.system.app :as app.system] 6 | [dev.env.system.core :as env.system] 7 | [lib.clojure-tools-logging.logger :as logger] 8 | [lib.clojure.core :as c])) 9 | 10 | (set! *warn-on-reflection* true) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (def ^:private logger (logger/get-logger *ns*)) 15 | 16 | (defn- init 17 | [] 18 | (try 19 | (try (env.system/start) 20 | (catch Throwable e (throw (->> e (ex-info "Start environment" {:reason ::env}))))) 21 | 22 | (try (app.system/start) 23 | (catch Throwable e (throw (->> e (ex-info "Start application" {:reason ::app}))))) 24 | 25 | (when-some [server (env.system/nrepl-server)] 26 | (logger/info logger (c/pr-str* "Running nREPL server on port" (:port server)))) 27 | 28 | (logger/info logger "[DONE] Application has been started for development. Happy coding!") 29 | 30 | (env.system/prompt-reload-on-enter) 31 | 32 | (catch Throwable e 33 | (logger/error logger (c/ex-message-all e)) 34 | (when (env.system/nrepl-server) 35 | (env.system/prompt-reload-on-enter))))) 36 | 37 | (defn- shutdown 38 | "Shutdown `env` system." 39 | [] 40 | (app.system/stop) 41 | (env.system/stop)) 42 | 43 | (comment 44 | (time (init)) 45 | (time (shutdown))) 46 | 47 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 48 | 49 | (defn -main 50 | "Runs development environment." 51 | [] 52 | (.addShutdownHook (Runtime/getRuntime) (Thread. ^Runnable shutdown)) 53 | (init)) 54 | 55 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 56 | -------------------------------------------------------------------------------- /src/lib/util/secret.clj: -------------------------------------------------------------------------------- 1 | (ns lib.util.secret 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.test :as test])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (declare secret?) 10 | 11 | (deftype Secret [value] 12 | Object 13 | (equals [_ obj] (and (secret? obj) (= value (.value ^Secret obj)))) 14 | (toString [_] "******")) 15 | 16 | (test/deftest deftype-test 17 | (test/are [expr result] (= result expr) 18 | (str (->Secret "secret value")) #_=> "******" 19 | (= (->Secret "secret value") (->Secret "secret value")) #_=> true)) 20 | 21 | (comment 22 | (str (->Secret "xxx")) 23 | (str "My secret: " (->Secret "xxx")) 24 | (pr-str (->Secret "xxx")) 25 | (.value (->Secret "xxx")) 26 | (= (->Secret "xxx") (->Secret "xxx")) 27 | (= (->Secret nil) (->Secret nil))) 28 | 29 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 30 | 31 | (defn secret? 32 | "Test if `x` is a secret." 33 | [x] 34 | (instance? Secret x)) 35 | 36 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 37 | 38 | (s/def ::spec 39 | (s/or :string string? :secret secret?)) 40 | 41 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 42 | 43 | (test/with-test 44 | 45 | (defn read-secret 46 | "Read value from secret." 47 | [value] 48 | (if (secret? value) 49 | (.value ^Secret value) 50 | value)) 51 | 52 | (test/are [expr result] (= result expr) 53 | (read-secret (->Secret "xxx")) #_=> "xxx" 54 | (read-secret "xxx"),,,,,,,,,,, #_=> "xxx")) 55 | 56 | (comment 57 | (read-secret "xxx") 58 | (read-secret (->Secret "xxx")) 59 | (test/test-var #'read-secret)) 60 | 61 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 62 | -------------------------------------------------------------------------------- /src/app/database/hugsql_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns app.database.hugsql-adapter 2 | "Modified next.jdbc adapter for HugSQL." 3 | (:require [hugsql.adapter :as adapter] 4 | [hugsql.adapter.next-jdbc :as next-jdbc]) 5 | (:import (hugsql.adapter HugsqlAdapter))) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (defn- embed-fn-name 12 | "Adds function name in the body of SQL query as comment. 13 | For tracing SQL queries in logs." 14 | [sqlvec options] 15 | (assoc sqlvec 0 (-> "/* " 16 | (.concat (name (options :fn-name))) 17 | (.concat " */\n") 18 | (.concat (sqlvec 0))))) 19 | 20 | (comment 21 | (embed-fn-name ["SQL" 1 2] {:fn-name 'db-fn-name}) #_["/* db-fn-name */\nSQL" 1 2] #_"95 ns") 22 | 23 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 24 | 25 | (defn hugsql-adapter-next-jdbc 26 | "Modified next.jdbc adapter for HugSQL: 27 | - function names in the body of SQL queries." 28 | ([] 29 | (hugsql-adapter-next-jdbc {})) 30 | ([default-command-options] 31 | (let [a ^HugsqlAdapter (next-jdbc/hugsql-adapter-next-jdbc default-command-options)] 32 | (reify 33 | adapter/HugsqlAdapter 34 | (execute [_ db sqlvec options] (.execute a db (embed-fn-name sqlvec options) options)) 35 | (query [_ db sqlvec options] (.query a db (embed-fn-name sqlvec options) options)) 36 | (result-one [_ result options] (.result_one a result options)) 37 | (result-many [_ result options] (.result_many a result options)) 38 | (result-affected [_ result options] (.result_affected a result options)) 39 | (result-raw [_ result options] (.result_raw a result options)) 40 | (on-exception [_ exception] (.on_exception a exception)))))) 41 | 42 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 43 | -------------------------------------------------------------------------------- /src/app/system/service/app_config.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.service.app-config 2 | (:require [clojure.edn :as edn] 3 | [clojure.string :as string] 4 | [integrant.core :as ig] 5 | [lib.config.props :as props] 6 | [lib.util.secret :as secret])) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (defn- split [v] (string/split v #"[\s,]+")) 13 | 14 | (props/add-conform-rule :edn,,, edn/read-string) 15 | (props/add-conform-rule :vector split) 16 | (props/add-conform-rule :set,,, (comp set split)) 17 | (props/add-conform-rule :secret secret/->Secret) 18 | 19 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 20 | 21 | (defmethod ig/init-key :app.system.service/app-config 22 | [_ {:keys [prop-files conform-rules prop-defaults :dev/prepare-prop-files]}] 23 | (let [prepare-prop-files (or prepare-prop-files identity) 24 | loaded (-> prop-files 25 | (prepare-prop-files) 26 | (props/load-prop-files)) 27 | merged (merge prop-defaults 28 | (-> loaded 29 | (merge (System/getProperties)) 30 | (props/apply-conform-rules conform-rules)))] 31 | (with-meta merged (meta loaded)))) 32 | 33 | (comment 34 | (into (sorted-map) 35 | (ig/init-key :app.system.service/app-config 36 | {:prop-files "dev/app/config/default.props" 37 | :prop-defaults {"xxx" :xxx 38 | "Vk.App.Id" nil} 39 | :conform-rules {"Mailer.Smtp.Port" :edn 40 | "Mailer.Smtp.Options" :edn 41 | #"System\.Switch\..+" :edn 42 | #"Webapp\.Hosts\(.+\)" :set}}))) 43 | 44 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 45 | -------------------------------------------------------------------------------- /src/app/system/service/immutant_web.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.service.immutant-web 2 | (:require [immutant.web :as web] 3 | [integrant.core :as ig] 4 | [lib.clojure-tools-logging.logger :as logger] 5 | [lib.clojure.core :as c])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (defn- start-webapp 12 | [server, {webapp-name :name :as webapp}, server-options] 13 | (let [options (merge server-options (webapp :options))] 14 | (logger/debug (logger/get-logger *ns*) (c/pr-str* "Start webapp" webapp-name options)) 15 | (-> (web/run (webapp :handler) (merge server options)) 16 | (with-meta (update (meta server) :running-webapps 17 | conj [webapp-name options]))))) 18 | 19 | (defn- skip-webapp 20 | [server, webapp] 21 | (logger/debug (logger/get-logger *ns*) (c/pr-str* "Skip webapp" webapp)) 22 | server) 23 | 24 | (defn- start-server 25 | [{:keys [options, webapps, dev/prepare-webapp]}] 26 | (let [prepare-webapp (or prepare-webapp identity)] 27 | (reduce (fn [server, {:keys [webapp-is-enabled] :or {webapp-is-enabled true} :as webapp}] 28 | (if webapp-is-enabled 29 | (start-webapp server (prepare-webapp webapp) options) 30 | (skip-webapp server webapp))) 31 | (-> (or options {}) 32 | (with-meta {:running-webapps []})) 33 | webapps))) 34 | 35 | (defn- stop-server 36 | [server] 37 | (web/stop server)) 38 | 39 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 40 | 41 | (defmethod ig/init-key :app.system.service/immutant-web 42 | [_ options] 43 | (start-server options)) 44 | 45 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 46 | 47 | (defmethod ig/halt-key! :app.system.service/immutant-web 48 | [_ server] 49 | (stop-server server)) 50 | 51 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 52 | -------------------------------------------------------------------------------- /src/app/main.clj: -------------------------------------------------------------------------------- 1 | (ns app.main 2 | "Initial namespace for release application. 3 | Affected in development mode! 4 | See `dev` namespace as initial for development." 5 | (:require [app.system.core :as app.system] 6 | [lib.clojure-tools-logging.logger :as logger]) 7 | (:import (org.slf4j.bridge SLF4JBridgeHandler)) 8 | (:gen-class :implements [org.apache.commons.daemon.Daemon])) 9 | 10 | (set! *warn-on-reflection* true) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (Thread/setDefaultUncaughtExceptionHandler 15 | (reify Thread$UncaughtExceptionHandler 16 | (uncaughtException [_ _ e] 17 | (logger/log-throwable e "UncaughtExceptionHandler")))) 18 | 19 | (SLF4JBridgeHandler/removeHandlersForRootLogger) 20 | (SLF4JBridgeHandler/install) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defn- start 25 | [] 26 | (try 27 | (app.system/start) 28 | (logger/info (logger/get-logger *ns*) "[DONE] Application init") 29 | (catch Throwable e 30 | (logger/log-throwable e "[FAIL] Application init") 31 | (throw e)))) 32 | 33 | (defn- stop 34 | [] 35 | (app.system/stop)) 36 | 37 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 38 | 39 | (defn -main 40 | "Application entry point." 41 | [] 42 | (start) 43 | (.addShutdownHook (Runtime/getRuntime) (Thread. ^Runnable stop))) 44 | 45 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 46 | 47 | ;;; Daemon implementation 48 | 49 | (defn -init 50 | "Initializes this `Daemon` instance." 51 | [_ _]) 52 | 53 | (defn -start 54 | "Starts the operation of this `Daemon` instance." 55 | [_] 56 | (start)) 57 | 58 | (defn -stop 59 | "Stops the operation of this `Daemon` instance." 60 | [_] 61 | (stop)) 62 | 63 | (defn -destroy 64 | "Frees any resources allocated by this daemon." 65 | [_]) 66 | 67 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 68 | -------------------------------------------------------------------------------- /src/lib/clojure/lang.cljs: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.lang) 2 | 3 | (set! *warn-on-infer* true) 4 | 5 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 6 | 7 | (defn add-method 8 | "Installs a method of multimethod associated with dispatch-value." 9 | [multi-fn dispatch-val method] 10 | (-add-method ^cljs.core/MultiFn multi-fn dispatch-val method)) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (defn first-arg 15 | "Returns first argument. To be used as multimethod dispatch function." 16 | ([a] a) 17 | ([a _] a) 18 | ([a _ _] a) 19 | ([a _ _ & _] a)) 20 | 21 | (defn second-arg 22 | "Returns second argument. To be used as multimethod dispatch function." 23 | ([_ a] a) 24 | ([_ a _] a) 25 | ([_ a _ & _] a)) 26 | 27 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 28 | 29 | (defn invoke 30 | "Invokes function `f` with arguments. 31 | Performance implications for 5+ arguments." 32 | ([f] (f)) 33 | ([f a] (f a)) 34 | ([f a b] (f a b)) 35 | ([f a b c] (f a b c)) 36 | ([f a b c d] (f a b c d)) 37 | ([f a b c d e] (f a b c d e)) 38 | ([f a b c d e & args] (apply f a b c d e args))) 39 | 40 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 41 | 42 | (defn asserted 43 | "Returns `x` if `(pred x)` is logical true, else `nil`. 44 | Returns #(asserted % pred) in case of 1-arity." 45 | ([pred] 46 | #(asserted % pred)) 47 | ([x pred] 48 | (when (pred x) x))) 49 | 50 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 51 | 52 | (defn unwrap-fn 53 | "If `x` is a function, returns `(x)`, else returns `x`. 54 | Useful to represent function parameters as value or function without arguments." 55 | [x] 56 | (if (fn? x) (x) x)) 57 | 58 | (comment 59 | (unwrap-fn 1) 60 | (unwrap-fn (constantly 1)) 61 | (unwrap-fn nil) 62 | (unwrap-fn :kw)) 63 | 64 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 65 | -------------------------------------------------------------------------------- /dev/dev/env/tailwind/watcher.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.tailwind.watcher 2 | (:require [clojure.java.shell :as shell] 3 | [clojure.string :as string] 4 | [lib.clojure-tools-logging.logger :as logger])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (def ^:private logger (logger/get-logger *ns*)) 11 | 12 | (def ^:private postcss-cmd 13 | (let [os-name (System/getProperty "os.name")] 14 | (if (string/includes? os-name "Windows") 15 | "node_modules/.bin/postcss.cmd" 16 | "node_modules/.bin/postcss"))) 17 | 18 | (defn- tailwind-shell-cmd 19 | [webapp] 20 | [postcss-cmd 21 | (str "tailwind/app/$_" webapp "/main.css") 22 | "-o" (str "resources/public/app/" webapp "/main.css") 23 | "--config" "dev/app/config/"]) 24 | 25 | (defn- build-webapp-css 26 | [{:keys [webapp on-rebuild]}] 27 | (let [cmd (tailwind-shell-cmd webapp) 28 | _ (logger/info logger (print-str "Building webapp CSS..." webapp cmd)) 29 | {:keys [out err]} (apply shell/sh cmd)] 30 | (if (empty? err) 31 | (do (logger/info logger (print-str "[OK] Building webapp CSS" webapp out)) 32 | (when on-rebuild (on-rebuild))) 33 | (logger/error logger err)))) 34 | 35 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 36 | 37 | (defn watch-handler 38 | "Watch handler for Tailwind CSS sources." 39 | [options] 40 | (fn [& _] 41 | (build-webapp-css options))) 42 | 43 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 44 | 45 | (def ^:private content-build-fn! (atom nil)) 46 | 47 | (defn build-content-if-updated 48 | "Invokes [[content-build-fn!]] once if it’s set by [[content-watch-handler]]." 49 | [] 50 | (when-let [f @content-build-fn!] 51 | (reset! content-build-fn! nil) 52 | (f))) 53 | 54 | (defn content-watch-handler 55 | "Watch handler for Tailwind CSS content changes." 56 | [options] 57 | (fn [& _] 58 | (reset! content-build-fn! (partial build-webapp-css options)))) 59 | 60 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 61 | -------------------------------------------------------------------------------- /src/app/database/result_set.clj: -------------------------------------------------------------------------------- 1 | (ns app.database.result-set 2 | (:require [lib.clojure.core :as c] 3 | [next.jdbc.optional :as optional]) 4 | (:import (java.sql ResultSet ResultSetMetaData))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn- get-simple-column-names 11 | "Given `ResultSetMetaData`, return a vector of modified column names, each 12 | qualified by the `column-ns`." 13 | [^ResultSetMetaData rsmeta] 14 | (mapv (fn [^Integer i] (keyword (.getColumnLabel rsmeta i))) 15 | (range 1 (inc (.getColumnCount rsmeta))))) 16 | 17 | (defn- get-namespaced-column-names 18 | "Given `ResultSetMetaData`, return a vector of modified column names, each 19 | qualified by the `column-ns`." 20 | [^ResultSetMetaData rsmeta, column-ns] 21 | (mapv (fn [^Integer i] (keyword column-ns (.getColumnLabel rsmeta i))) 22 | (range 1 (inc (.getColumnCount rsmeta))))) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | 26 | (defn as-simple-maps 27 | "Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder` 28 | that produces bare vectors of hash map rows, with simple keys and nil 29 | columns omitted." 30 | [^ResultSet rs _] 31 | (let [rsmeta (.getMetaData rs) 32 | cols (get-simple-column-names rsmeta)] 33 | (optional/->MapResultSetOptionalBuilder rs rsmeta cols))) 34 | 35 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 36 | 37 | (defn as-namespaced-maps 38 | "Given a `ResultSet` and options, return a `RowBuilder` / `ResultSetBuilder` 39 | that produces bare vectors of hash map rows, with namespaced keys and nil 40 | columns omitted." 41 | [ns-tag] 42 | (let [column-ns (cond-> ns-tag 43 | (ident? ns-tag) (namespace))] 44 | (c/assert-pred column-ns string?) 45 | (c/assert-pred column-ns seq) 46 | (fn as-maps 47 | [^ResultSet rs _] 48 | (let [rsmeta (.getMetaData rs) 49 | cols (get-namespaced-column-names rsmeta column-ns)] 50 | (optional/->MapResultSetOptionalBuilder rs rsmeta cols))))) 51 | 52 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 53 | -------------------------------------------------------------------------------- /src/lib/clojure/exception.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.exception 2 | (:require [lib.clojure-string.core :as string'])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 7 | 8 | (defn ex-message-or-name 9 | "Returns the exception message or class name if the message is empty." 10 | [throwable] 11 | (or (-> (.getMessage ^Throwable throwable) (string'/not-empty)) 12 | (.getCanonicalName (class throwable)))) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defn ex-message-all 17 | "Builds single message from all nested exceptions. 18 | Includes optional `context` string as part of the message." 19 | ([throwable] (ex-message-all throwable nil)) 20 | ([throwable, context] 21 | (when throwable 22 | (loop [sb (-> (StringBuilder.) 23 | (cond-> context (-> (.append (str context)) 24 | (.append " > "))) 25 | (.append (ex-message-or-name throwable))) 26 | cause (.getCause ^Throwable throwable)] 27 | (if cause 28 | (recur (-> sb (.append " > ") (.append (ex-message-or-name cause))) 29 | (.getCause cause)) 30 | (.toString sb)))))) 31 | 32 | (comment 33 | (ex-message-all (ex-info "One" {:x :one} 34 | (ex-info "Two" {:x :two} 35 | (ex-info "Three" {:x :three})))) 36 | #_"One > Two > Three" 37 | (ex-message-all (ex-info "One" {:x :one} 38 | (ex-info "Two" {:x :two} 39 | (ex-info "Three" {:x :three}))) 40 | "Prefix") 41 | #_"Prefix > One > Two > Three") 42 | 43 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 44 | 45 | (defn ex-root-cause 46 | "Find root cause for the throwable." 47 | [throwable] 48 | (if-let [cause (ex-cause throwable)] 49 | (recur cause) 50 | throwable)) 51 | 52 | (comment 53 | (ex-root-cause (ex-info "One" {:x :one} 54 | (ex-info "Two" {:x :two} 55 | (ex-info "Three" {:x :three}))))) 56 | 57 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 58 | -------------------------------------------------------------------------------- /dev/dev/env/system/integrant/tailwind.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.integrant.tailwind 2 | (:require [dev.env.reload.ring-refresh :as ring-refresh] 3 | [dev.env.tailwind.watcher :as tailwind] 4 | [integrant.core :as ig] 5 | [mount.core :as mount])) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 10 | 11 | (defn- mount-restart-running 12 | [state] 13 | (some-> ((mount/running-states) state) 14 | (doto (mount/stop) 15 | (mount/start)))) 16 | 17 | (defonce ^:private handler-was-run! (atom false)) 18 | 19 | (defn- wrap-handler-was-run 20 | [handler] 21 | (fn [& args] 22 | (apply handler args) 23 | (reset! handler-was-run! true))) 24 | 25 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 26 | 27 | (defmethod ig/init-key :dev.env.system.integrant/tailwind 28 | [_ {:keys [webapp, watcher, content-watcher, dependent-mount-states]}] 29 | {::watcher (ig/init-key :dev.env.system.integrant/watcher 30 | (-> watcher (assoc :handler (-> {:webapp webapp 31 | :on-rebuild (fn [] 32 | (->> dependent-mount-states (run! mount-restart-running)) 33 | (ring-refresh/send-refresh))} 34 | (tailwind/watch-handler) 35 | (wrap-handler-was-run)) 36 | :handler-run-on-init (not @handler-was-run!)))) 37 | ::content-watcher (ig/init-key :dev.env.system.integrant/watcher 38 | (assoc content-watcher 39 | :handler (tailwind/content-watch-handler {:webapp webapp})))}) 40 | 41 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 42 | 43 | (defmethod ig/halt-key! :dev.env.system.integrant/tailwind 44 | [_ {::keys [watcher, content-watcher]}] 45 | (ig/halt-key! :dev.env.system.integrant/watcher watcher) 46 | (ig/halt-key! :dev.env.system.integrant/watcher content-watcher)) 47 | 48 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 49 | -------------------------------------------------------------------------------- /src/app/database/core.clj: -------------------------------------------------------------------------------- 1 | (ns app.database.core 2 | (:require [app.database.hugsql :as hugsql] 3 | [lib.clojure.core :as c] 4 | [mount.core :as mount] 5 | [next.jdbc :as jdbc]) 6 | (:import (java.sql Connection) 7 | (javax.sql DataSource))) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | ;;; Database connection 14 | 15 | (mount/defstate ^Connection get-read-write-connection 16 | "Creates a connection to a database using read-write `data-source`." 17 | {:arglists '([] [options]) :on-reload :noop} 18 | 19 | :start (let [data-source (::data-source-read-write (mount/args))] 20 | (c/assert-pred data-source (partial instance? DataSource) ::data-source-read-write) 21 | (fn get-read-write-connection 22 | ([] 23 | (get-read-write-connection {})) 24 | ([options] 25 | (jdbc/get-connection data-source options))))) 26 | 27 | (mount/defstate ^Connection get-read-only-connection 28 | "Creates a connection to a database using read-only `data-source`." 29 | {:arglists '([] [options]) :on-reload :noop} 30 | 31 | :start (let [data-source (::data-source-read-only (mount/args))] 32 | (c/assert-pred data-source (partial instance? DataSource) ::data-source-read-only) 33 | (fn get-read-only-connection 34 | ([] 35 | (get-read-only-connection {})) 36 | ([options] 37 | (jdbc/get-connection data-source options))))) 38 | 39 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 40 | 41 | ;;; JDBC helpers 42 | 43 | (defmacro with-transaction 44 | "Helper for `jdbc/with-transaction` allowing specify connection 45 | symbol only once and shading non-transactable name." 46 | [spec & body] 47 | (let [spec (if (vector? spec) 48 | (into [(spec 0)] spec) 49 | [spec spec])] 50 | `(jdbc/with-transaction ~spec 51 | ~@body))) 52 | 53 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 54 | 55 | ;;; HugSQL query functions 56 | 57 | (hugsql/def example-user--select-all :example-user/_) 58 | 59 | (comment 60 | (example-user--select-all)) 61 | 62 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 63 | -------------------------------------------------------------------------------- /src/lib/clojure/lang.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.lang 2 | (:import (clojure.lang MultiFn) 3 | (java.util.concurrent Future))) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn add-method 10 | "Installs a method of multimethod associated with dispatch-value." 11 | [multi-fn dispatch-val method] 12 | (.addMethod ^MultiFn multi-fn dispatch-val method)) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defn first-arg 17 | "Returns first argument. To be used as multimethod dispatch function." 18 | ([a] a) 19 | ([a _] a) 20 | ([a _ _] a) 21 | ([a _ _ & _] a)) 22 | 23 | (defn second-arg 24 | "Returns second argument. To be used as multimethod dispatch function." 25 | ([_ a] a) 26 | ([_ a _] a) 27 | ([_ a _ & _] a)) 28 | 29 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 30 | 31 | (defn invoke 32 | "Invokes function `f` with arguments. 33 | Performance implications for 5+ arguments." 34 | ([f] (f)) 35 | ([f a] (f a)) 36 | ([f a b] (f a b)) 37 | ([f a b c] (f a b c)) 38 | ([f a b c d] (f a b c d)) 39 | ([f a b c d e] (f a b c d e)) 40 | ([f a b c d e & args] (apply f a b c d e args))) 41 | 42 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 43 | 44 | (defn select 45 | "Returns `x` if `(pred x)` is logical true, else `nil`. 46 | Returns #(select % pred) in case of 1-arity." 47 | ([pred] 48 | #(select % pred)) 49 | ([x pred] 50 | (when (pred x) x))) 51 | 52 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 53 | 54 | (defn unwrap-fn 55 | "If `x` is a function, returns `(x)`, else returns `x`. 56 | Useful to represent function parameters as value or function without arguments." 57 | [x] 58 | (if (fn? x) (x) x)) 59 | 60 | (comment 61 | (unwrap-fn 1) 62 | (unwrap-fn (constantly 1)) 63 | (unwrap-fn nil) 64 | (unwrap-fn :kw)) 65 | 66 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 67 | 68 | (defn unwrap-future 69 | "If `x` is future?, returns `(deref x)`, else returns `x`." 70 | [x] 71 | (if (future? x) (.get ^Future x), x)) 72 | 73 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 74 | -------------------------------------------------------------------------------- /src/app/webapp/ring_handler.clj: -------------------------------------------------------------------------------- 1 | (ns app.webapp.ring-handler 2 | "Ring-based definition for request-response handling." 3 | (:require [lib.clojure.core :as c] 4 | [lib.ring-middleware.error-exception :as error-exception] 5 | [lib.ring-middleware.error-not-found :as error-not-found] 6 | [lib.ring-middleware.response-logger :as debug-response] 7 | [lib.ring-middleware.route-tag-reitit :as route-tag] 8 | [lib.slf4j.mdc :as mdc] 9 | [reitit.core :as reitit] 10 | [ring.middleware.defaults :as defaults]) 11 | (:import (java.util UUID))) 12 | 13 | (set! *warn-on-reflection* true) 14 | 15 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 16 | 17 | (defn collect-routes 18 | "Returns vector of reitit routes defined by `route-path` multimethod." 19 | [route-path] 20 | (->> (keys (methods route-path)) 21 | (group-by route-path) 22 | (sort-by first) 23 | (mapv (fn [[path tags]] 24 | (c/assert (= 1 (count tags)) (c/pr-str* "Duplicate route-path" path "for tags" tags)) 25 | [path (first tags)])))) 26 | 27 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 28 | 29 | (defn- wrap-mdc 30 | [handler] 31 | (fn [request] 32 | (with-open [_ (mdc/put-closeable "hostname" (request :server-name)) 33 | _ (mdc/put-closeable "route-tag" (some-> (request :route-tag) (str))) 34 | _ (mdc/put-closeable "session" (some-> (request :session) (str))) 35 | _ (mdc/put-closeable "request-id" (.toString (UUID/randomUUID)))] 36 | (handler request)))) 37 | 38 | (defn webapp-http-handler 39 | "Build HTTP server handler for webapp with common middleware." 40 | [http-handler, routes, {:keys [dev-mode]}] 41 | (-> http-handler 42 | (error-not-found/wrap-error-not-found dev-mode) 43 | (debug-response/wrap-response-logger) 44 | (wrap-mdc) 45 | (route-tag/wrap-route-tag (reitit/router routes)) 46 | (defaults/wrap-defaults (-> defaults/site-defaults 47 | (assoc-in [:security :anti-forgery] false) 48 | (assoc-in [:security :frame-options] false) 49 | (dissoc :session))) 50 | (error-exception/wrap-error-exception dev-mode))) 51 | 52 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 53 | -------------------------------------------------------------------------------- /src/lib/ring_util/request.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-util.request 2 | (:require [lib.clojure-string.core :as string'] 3 | [lib.ring-util.cookie])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn request-uri 10 | "Extract path with query string from ring request." 11 | [request] 12 | (let [query (:query-string request)] 13 | (cond-> (:uri request) 14 | query (string'/concat "?" query)))) 15 | 16 | (comment 17 | (request-uri {:uri "http://localhost/"}) 18 | (request-uri {:uri "http://localhost/" :query-string "a=1"})) 19 | 20 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 21 | 22 | (defn url-for-path 23 | "Build URL for path with same scheme like incoming request." 24 | [request path] 25 | (let [headers (:headers request)] 26 | (string'/concat (or (headers "x-forwarded-proto") 27 | (-> request :scheme name)) 28 | "://" (headers "host") path))) 29 | 30 | (comment 31 | (url-for-path {:headers {"x-forwarded-proto" "http", "host" "localhost"}} "/") 32 | (url-for-path {:headers {"host" "localhost"}, :scheme "http"} "/")) 33 | 34 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 35 | 36 | (defn url-for-current-path 37 | "Absolute URL for the request." 38 | [request] 39 | (url-for-path request (request-uri request))) 40 | 41 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 42 | 43 | (defn- anonymize-ip 44 | "Replace last octet in IP address with zero." 45 | [ip] 46 | (some-> (string'/drop-end ip #(case % (\. \:) false true)) 47 | (string'/concat "0"))) 48 | 49 | (defn client-ip 50 | "Read client IP address from ring request. 51 | Respects proxy headers. Anonymizes IP address." 52 | [request] 53 | (-> (or (some-> request :headers (get "x-forwarded-for") (string'/take-before ",")) 54 | (:remote-addr request)) 55 | (anonymize-ip))) 56 | 57 | (comment 58 | (anonymize-ip "127.0.0.122") 59 | (anonymize-ip "2001:db8::ff00:42:125") 60 | (anonymize-ip nil) 61 | (client-ip {:remote-addr "127.0.0.122"}) 62 | (client-ip {:headers {"x-forwarded-for" "127.0.0.122"}}) 63 | (client-ip {:headers {"x-forwarded-for" "127.0.0.122,127.0.0.122"}})) 64 | 65 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 66 | -------------------------------------------------------------------------------- /src/lib/ring_middleware/response_logger.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-middleware.response-logger 2 | (:require [lib.clojure-tools-logging.logger :as logger] 3 | [lib.clojure.perf :as p] 4 | [lib.ring-util.request :as ring.request'])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (def ^:private logger (logger/get-logger *ns*)) 11 | 12 | (defn- response-description 13 | [request response time-millis] 14 | (let [{:keys [server-name, request-method, form-params, route-tag]} request 15 | {:keys [status, response-logger/log-response]} response 16 | uri (ring.request'/request-uri request) 17 | form-params (not-empty form-params) 18 | log-response (or log-response (some-> response :headers (get "Content-Type")))] 19 | (p/inline-str "HTTP " status " << " 20 | route-tag (when route-tag " ") 21 | request-method " " server-name " " uri 22 | (when form-params " ") form-params 23 | (when log-response " > ") log-response 24 | " | " time-millis " ms"))) 25 | 26 | (defn- session-update-description 27 | [response] 28 | (when-let [session (:session response)] 29 | (if (:recreate (meta session)) 30 | (.concat "Recreate :session " (pr-str session)) 31 | (.concat "Update :session " (pr-str session))))) 32 | 33 | (defn- flash-update-description 34 | [response] 35 | (when-let [flash (:flash response)] 36 | (.concat "Set :flash " (pr-str flash)))) 37 | 38 | (defn- cookies-update-description 39 | [response] 40 | (when-let [cookies (:cookies response)] 41 | (.concat "Set :cookies " (pr-str cookies)))) 42 | 43 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 44 | 45 | (defn wrap-response-logger 46 | "Wrap handler with response logging." 47 | [handler] 48 | (fn [request] 49 | (let [start-millis (System/currentTimeMillis) 50 | response (handler request) 51 | time-millis (- (System/currentTimeMillis) start-millis)] 52 | (logger/debug logger (response-description request response time-millis)) 53 | (some->> (session-update-description response) (logger/debug logger)) 54 | (some->> (flash-update-description response) (logger/debug logger)) 55 | (some->> (cookies-update-description response) (logger/debug logger)) 56 | response))) 57 | 58 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 59 | -------------------------------------------------------------------------------- /src/lib/ring_middleware/route_tag_reitit.clj: -------------------------------------------------------------------------------- 1 | (ns lib.ring-middleware.route-tag-reitit 2 | (:require [lib.clojure.perf :as p] 3 | [reitit.core :as reitit])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defn- get-path-fn 10 | [reitit-router, route-tag] 11 | (let [match (reitit/match-by-name reitit-router, route-tag)] 12 | (if (reitit/partial-match? match) 13 | ;; Route with path parameters. 14 | (let [required (:required match)] 15 | (fn get-param-path 16 | ([] 17 | (reitit/match-by-name! reitit-router, route-tag)) 18 | ([params] 19 | (let [match (reitit/match-by-name! reitit-router, route-tag, (select-keys params required))] 20 | (if (== (count required) (count params)) 21 | (reitit/match->path match) 22 | (reitit/match->path match (remove #(required (key %)) params))))))) 23 | ;; Route without path parameters. 24 | (fn get-simple-path 25 | ([] 26 | (reitit/match->path match)) 27 | ([params] 28 | (reitit/match->path match params)))))) 29 | 30 | (defn- path-for-route-fn 31 | [reitit-router] 32 | (let [get-path-fns (reduce (fn [m tag] (assoc m tag (get-path-fn reitit-router, tag))) 33 | {} (reitit/route-names reitit-router))] 34 | (fn path-for-route 35 | ([route-tag] 36 | (when-some [get-path (get-path-fns route-tag)] 37 | (get-path))) 38 | ([route-tag, params] 39 | (when-some [get-path (get-path-fns route-tag)] 40 | (get-path params)))))) 41 | 42 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 43 | 44 | (defn wrap-route-tag 45 | "Wrap handler with route-tag functionality." 46 | [handler, reitit-router] 47 | 48 | {:pre [(reitit/router? reitit-router)]} 49 | 50 | (fn route-tag 51 | [request] 52 | (let [match (reitit/match-by-path reitit-router, (request :uri)) 53 | route-tag (-> match :data :name) 54 | path-params (-> match :path-params not-empty)] 55 | (handler (cond-> (assoc request :route-tag/path-for-route (path-for-route-fn reitit-router)) 56 | route-tag,, (assoc :route-tag route-tag) 57 | path-params (update :params (fn merge-route-params [params] 58 | (p/merge-not-empty params path-params)))))))) 59 | 60 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 61 | -------------------------------------------------------------------------------- /dev/dev/env/reload/ring_refresh.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.reload.ring-refresh 2 | (:require [compojure.core :as compojure] 3 | [lib.clojure-tools-logging.logger :as logger] 4 | [ring.middleware.params :as params] 5 | [ring.middleware.refresh :as refresh]) 6 | (:import (java.util UUID Date))) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (def ^:private refresh-state! 13 | (atom {::last-modified (Date.) 14 | ::refresh-is-enabled false})) 15 | 16 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 17 | 18 | (defn- watch-until 19 | [state!, pred, timeout-ms] 20 | (let [watch-promise (promise) 21 | watch-key (str (UUID/randomUUID))] 22 | (try 23 | (add-watch state! watch-key (fn [_ _ _ value] 24 | (deliver watch-promise (pred value)))) 25 | (if-some [v (pred @state!)] v 26 | (deref watch-promise timeout-ms false)) 27 | (finally 28 | (remove-watch state! watch-key))))) 29 | 30 | (def ^:private source-changed-route 31 | (compojure/GET "/__source_changed" [since] 32 | (let [timestamp (Long/parseLong since)] 33 | (str (watch-until refresh-state! (fn [{::keys [last-modified, refresh-is-enabled]}] 34 | (when (> (.getTime ^Date last-modified) timestamp) 35 | refresh-is-enabled)) 36 | 60000))))) 37 | 38 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 39 | 40 | (defn wrap-refresh 41 | "Modified `ring.middleware.refresh/wrap-refresh`." 42 | [handler] 43 | (params/wrap-params (compojure/routes source-changed-route 44 | (@#'refresh/wrap-with-script handler @#'refresh/refresh-script)))) 45 | 46 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 47 | 48 | (defn send-refresh 49 | "Send response to pages with flag if they should 50 | reload page or just reconnect to __source_changed." 51 | ([] (send-refresh (::refresh-is-enabled @refresh-state!))) 52 | ([refresh-is-enabled] 53 | (when refresh-is-enabled 54 | (logger/info (logger/get-logger *ns*) "Send refresh command to browser pages")) 55 | (reset! refresh-state! {::last-modified (Date.) 56 | ::refresh-is-enabled refresh-is-enabled}))) 57 | 58 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 59 | -------------------------------------------------------------------------------- /dev/dev/env/reload/watcher.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.reload.watcher 2 | (:require [hara.io.watch :as watch] 3 | [lib.clojure-tools-logging.logger :as logger] 4 | [lib.clojure.core :as c])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (def ^:private logger (logger/get-logger *ns*)) 11 | 12 | (defn- locking-handler 13 | "Wraps handler with locking for execution period." 14 | [handler] 15 | (let [running! (atom false)] 16 | (fn [& args] 17 | (when (compare-and-set! running! false true) 18 | (try 19 | (logger/debug logger (c/pr-str* "Trigger watcher" (str handler) args)) 20 | (apply handler args) 21 | (finally 22 | (reset! running! false))))))) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | 26 | (defn start-watcher 27 | "Starts the watcher." 28 | [handler, {:keys [dirs files exclude] :as options}] 29 | (logger/info logger (c/pr-str* "Start watcher" options)) 30 | (let [handler (locking-handler handler)] 31 | (-> (watch/start-watcher (watch/watcher dirs handler {#_#_:types #{:modify} 32 | :filter files 33 | :exclude exclude 34 | :mode :async})) 35 | (vary-meta assoc :handler handler)))) 36 | 37 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 38 | 39 | (defn stop-watcher 40 | "Stops the watcher." 41 | [watcher] 42 | (logger/info logger (c/pr-str* "Stop watcher" watcher)) 43 | (watch/stop-watcher watcher)) 44 | 45 | (comment 46 | (time (let [w (time (start-watcher (fn [& reason] (println reason)) 47 | 48 | {:dirs ["src" "resources/app" "dev"] 49 | 50 | ;; See http://docs.caudate.me/hara/hara-io-watch.html#watch-options 51 | ;; :filter will pick out only files that match this pattern. 52 | :files [".props$" ".clj$" ".cljc$" ".js$" ".xml$" 53 | ".sql$" ".properties$" ".mustache$" ".yaml"] 54 | 55 | ;; See http://docs.caudate.me/hara/hara-io-watch.html#watch-options 56 | ;; :exclude will leave out files that match this pattern. 57 | :exclude []}))] 58 | 59 | (time (stop-watcher w))))) 60 | 61 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 62 | -------------------------------------------------------------------------------- /dev/dev/env/system/integrant.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.integrant 2 | (:require [integrant.core :as ig] 3 | [lib.clojure-tools-logging.logger :as logger] 4 | [lib.integrant.system :as ig.system] 5 | [lib.slf4j.mdc :as mdc] 6 | [lib.util.ansi-escape :as ansi])) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (def ^:private wrap-key? 13 | (complement #{:dev.env.system.integrant/watcher})) 14 | 15 | (defn- init-key-fn 16 | "Returns wrapped version of the `integrant.core/init-key` with logging. To use 17 | with `with-redefs`." 18 | [] 19 | (let [ig-init-key ig/init-key 20 | logger (logger/get-logger *ns*)] 21 | (fn [k v] 22 | (if (wrap-key? k) 23 | (with-open [_ (mdc/put-closeable "integrant" (str ['start (ig.system/simple-key k)]))] 24 | (logger/info logger (str ansi/fg-green-b ">> starting.. " ansi/reset (ig.system/simple-key k))) 25 | (ig-init-key k v)) 26 | (ig-init-key k v))))) 27 | 28 | (defn- halt-key-fn 29 | "Returns wrapped version of the `integrant.core/halt-key!` with logging and 30 | exception handling. To use with `with-redefs`." 31 | [] 32 | (let [ig-halt-key! ig/halt-key! 33 | logger (logger/get-logger *ns*)] 34 | (fn [k v] 35 | (if (wrap-key? k) 36 | (when-let [method (ig.system/get-defined-key-method ig-halt-key! k)] 37 | (with-open [_ (mdc/put-closeable "integrant" (str ['stop (ig.system/simple-key k)]))] 38 | (logger/info logger (str ansi/fg-cyan-b ">> stopping.. " ansi/reset (ig.system/simple-key k))) 39 | (try 40 | (method k v) 41 | (catch Throwable e 42 | (logger/log-throwable logger e (str "Stopping " (ig.system/simple-key k))))))) 43 | (ig-halt-key! k v))))) 44 | 45 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 46 | 47 | (defn halt! 48 | "Halts system map." 49 | [system] 50 | (with-redefs [ig/halt-key! (halt-key-fn)] 51 | (ig/halt! system))) 52 | 53 | (defn suspend! 54 | "Suspends system map." 55 | [system] 56 | (with-redefs [ig/halt-key! (halt-key-fn)] 57 | (ig/suspend! system))) 58 | 59 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 60 | 61 | (defn init 62 | "Initializes integrant system." 63 | [config] 64 | (with-redefs [ig/init-key (init-key-fn)] 65 | (ig/init config))) 66 | 67 | (defn resume 68 | "Resumes integrant system." 69 | [config system] 70 | (with-redefs [ig/init-key (init-key-fn)] 71 | (ig/resume config system))) 72 | 73 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 74 | -------------------------------------------------------------------------------- /src/app/database/hugsql.clj: -------------------------------------------------------------------------------- 1 | (ns app.database.hugsql 2 | (:require [app.database.result-set :as rs] 3 | [hugsql.adapter.next-jdbc :as adapter] 4 | [lib.clojure.core :as c] 5 | [lib.hugsql.core :as hugsql'] 6 | [mount.core :as mount]) 7 | (:import (javax.sql DataSource))) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (def ^:const sql-rc-path 14 | "The resource path where loading .sql files are located." 15 | 16 | "app/database/sql/") 17 | 18 | (defn def-db-fns-opts 19 | "Default opts of the HugSQL adapter." 20 | ([] (def-db-fns-opts rs/as-simple-maps)) 21 | ([builder-fn] 22 | {:adapter (adapter/hugsql-adapter-next-jdbc {:builder-fn builder-fn})})) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | 26 | (mount/defstate ^:private data-source-read-write 27 | {:on-reload :noop} 28 | :start (-> (::data-source-read-write (mount/args)) 29 | (doto (c/assert-pred (partial instance? DataSource) ::data-source-read-write)))) 30 | 31 | (mount/defstate ^:private data-source-read-only 32 | {:on-reload :noop} 33 | :start (-> (::data-source-read-only (mount/args)) 34 | (doto (c/assert-pred (partial instance? DataSource) ::data-source-read-only)))) 35 | 36 | (defn- wrap-db-fn 37 | [f fn-name ds-var] 38 | (fn db-fn 39 | ([] (db-fn @ds-var {})) 40 | ([params] (db-fn @ds-var params)) 41 | ([db params] 42 | (try (f db params) 43 | (catch Throwable e 44 | (throw (->> e (ex-info fn-name {:sql-params params})))))))) 45 | 46 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 47 | 48 | (defn wrap-db-fn-map 49 | "Wraps db fn with customized behaviour." 50 | [fm] 51 | (let [fk (ffirst fm) 52 | ds-var (if (-> fm fk :meta :command #{:query}) #'data-source-read-only 53 | #'data-source-read-write)] 54 | (-> fm 55 | (update-in [fk :fn] wrap-db-fn (str "db/" (name fk)) ds-var) 56 | (update-in [fk :meta] assoc :arglists '([] [params] [db params]))))) 57 | 58 | (defmacro def 59 | "Defines database function with name `sym` in the current namespace. 60 | The function definition string is loaded from resource file. 61 | 62 | If `namespaced-as` (string or namespaced keyword) provided 63 | then all keys in result set are namespaced." 64 | ([sym] 65 | `(hugsql'/def-db-fn-from-file '~sym sql-rc-path wrap-db-fn-map (def-db-fns-opts))) 66 | ([sym, namespaced-as] 67 | `(hugsql'/def-db-fn-from-file '~sym sql-rc-path wrap-db-fn-map (def-db-fns-opts (rs/as-namespaced-maps ~namespaced-as))))) 68 | 69 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 70 | -------------------------------------------------------------------------------- /src/app/system/integrant.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.integrant 2 | (:require [integrant.core :as ig] 3 | [lib.clojure-tools-logging.logger :as logger] 4 | [lib.integrant.async :as ig.async] 5 | [lib.integrant.system :as ig.system] 6 | [lib.slf4j.mdc :as mdc] 7 | [lib.util.ansi-escape :as ansi])) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (defn- init-key-fn 14 | "Returns wrapped version of the `integrant.core/init-key` with logging. To use 15 | with `with-redefs`." 16 | [] 17 | (let [ig-init-key ig/init-key 18 | logger (logger/get-logger *ns*)] 19 | (fn [k v] 20 | (with-open [_ (mdc/put-closeable "integrant" (str ['start (ig.system/simple-key k)]))] 21 | (logger/info logger (str ansi/fg-green ">> starting.. " ansi/reset (ig.system/simple-key k))) 22 | (ig-init-key k v))))) 23 | 24 | (defn- halt-key-fn 25 | "Returns wrapped version of the `integrant.core/halt-key!` with logging and 26 | exception handling. To use with `with-redefs`." 27 | [] 28 | (let [ig-halt-key! ig/halt-key! 29 | logger (logger/get-logger *ns*)] 30 | (fn [k v] 31 | (when-let [method (ig.system/get-defined-key-method ig-halt-key! k)] 32 | (with-open [_ (mdc/put-closeable "integrant" (str ['stop (ig.system/simple-key k)]))] 33 | (logger/info logger (str ansi/fg-cyan ">> stopping.. " ansi/reset (ig.system/simple-key k))) 34 | (try 35 | (method k v) 36 | (catch Throwable e 37 | (logger/log-throwable logger e (str "Stopping " (ig.system/simple-key k)))))))))) 38 | 39 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 40 | 41 | (defn halt! 42 | "Halts system map asynchronously." 43 | [system] 44 | (with-redefs [ig/halt-key! (halt-key-fn)] 45 | (ig.async/halt! system))) 46 | 47 | (defn suspend! 48 | "Suspends system map asynchronously." 49 | [system] 50 | (with-redefs [ig/halt-key! (halt-key-fn)] 51 | (ig.async/suspend! system))) 52 | 53 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 54 | 55 | (defn- build-apply 56 | [init-fn & args] 57 | (try 58 | (with-redefs [ig/init-key (init-key-fn)] 59 | (apply init-fn args)) 60 | (catch Exception e 61 | (logger/log-throwable e "Build integrant system") 62 | (some-> (ig.system/ex-failed-system e) 63 | (halt!)) 64 | (throw e)))) 65 | 66 | (defn init 67 | "Initializes integrant system asynchronously." 68 | [config ks] 69 | (build-apply ig.async/init config ks)) 70 | 71 | (defn resume 72 | "Resumes integrant system asynchronously." 73 | [config system ks] 74 | (build-apply ig.async/resume config system ks)) 75 | 76 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 77 | -------------------------------------------------------------------------------- /.clj-kondo/clj_kondo/rum.clj: -------------------------------------------------------------------------------- 1 | (ns clj-kondo.rum 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn fn-body? [x] 5 | (and (seq? x) 6 | (vector? (first x)))) 7 | 8 | (defn rewrite-body [mixins body defcs?] 9 | (if defcs? 10 | (let [[binding-vec & body] (:children body) 11 | [state-arg & rest-args] (:children binding-vec) 12 | ;; the original vector without the state argument 13 | fn-args (assoc binding-vec :children rest-args) 14 | body (api/list-node 15 | (list* (api/token-node 'let*) 16 | (api/vector-node [state-arg (api/token-node nil)]) 17 | state-arg 18 | (concat mixins body))) 19 | body (api/list-node [fn-args body])] 20 | body) 21 | (let [[binding-vec & body] (:children body)] 22 | (api/list-node (cons binding-vec (concat mixins body)))))) 23 | 24 | (defn rewrite 25 | ([node] (rewrite node false)) 26 | ([node defcs?] 27 | (let [args (rest (:children node)) 28 | component-name (first args) 29 | ?docstring (when (string? (api/sexpr (second args))) 30 | (second args)) 31 | args (if ?docstring 32 | (nnext args) 33 | (next args)) 34 | bodies 35 | (loop [args* (seq args) 36 | mixins [] 37 | bodies []] 38 | (if args* 39 | (let [a (first args*) 40 | a-sexpr (api/sexpr a)] 41 | (cond (vector? a-sexpr) ;; a-sexpr is a binding vec and the rest is the body of the function 42 | [(rewrite-body mixins (api/list-node args*) defcs?)] 43 | (fn-body? a-sexpr) 44 | (recur (next args*) 45 | mixins 46 | (conj bodies (rewrite-body mixins a defcs?))) 47 | ;; assume mixin 48 | :else (recur (next args*) 49 | (conj mixins a) 50 | bodies))) 51 | bodies)) 52 | new-node (with-meta 53 | (api/list-node 54 | (list* (api/token-node 'defn) 55 | component-name 56 | (if ?docstring 57 | (cons ?docstring bodies) 58 | bodies))) 59 | (meta node))] 60 | new-node))) 61 | 62 | (defn defc [{:keys [:node]}] 63 | (let [new-node (rewrite node)] 64 | {:node new-node})) 65 | 66 | (defn defcs [{:keys [:node]}] 67 | (let [new-node (rewrite node true)] 68 | {:node new-node})) 69 | -------------------------------------------------------------------------------- /src/lib/integrant/system.clj: -------------------------------------------------------------------------------- 1 | (ns lib.integrant.system 2 | (:require [integrant.core :as ig] 3 | [lib.clojure.core :as c])) 4 | 5 | (set! *warn-on-reflection* true) 6 | 7 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 8 | 9 | (defmethod ig/init-key ::identity [_ v] v) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (defn- import-map 14 | [m from] 15 | (->> m (into {} (keep (fn [[k v]] (cond (map? v),,,,,,,,,, [k (import-map v from)] 16 | (fn? v),,,,,,,,,,, [k (v from)] 17 | (contains? from v) [k (from v)])))))) 18 | 19 | (defmethod ig/init-key ::import-map 20 | [_ {:keys [import-from import-keys init-map]}] 21 | (c/deep-merge (or init-map {}) 22 | (import-map import-keys import-from))) 23 | 24 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 25 | 26 | (defmethod ig/init-key ::system-property 27 | [_ {k :key default :default}] 28 | (System/getProperty k default)) 29 | 30 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 31 | 32 | (defn- restart-on-resume 33 | [old-impl k value] 34 | (ig/halt-key! k old-impl) 35 | (ig/init-key k value)) 36 | 37 | (defmethod ig/suspend-key! ::keep-running-on-suspend 38 | [_ _]) 39 | 40 | (defmethod ig/resume-key ::keep-running-on-suspend 41 | [k value old-value old-impl] 42 | (cond-> old-impl 43 | (not= value old-value) (restart-on-resume k value))) 44 | 45 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 46 | 47 | (defn simple-key 48 | "Returns key or the last component of composite key." 49 | [k] 50 | (cond-> k (vector? k) (peek))) 51 | 52 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 53 | 54 | (defn get-key-method 55 | "Given an integrant key multimethod and a dispatch value, returns the dispatch 56 | fn that would apply to that value, or nil if none apply and no default." 57 | [f k] 58 | (get-method f (#'ig/normalize-key k))) 59 | 60 | (defn get-defined-key-method 61 | "Given an integrant key multimethod and a dispatch value, returns the dispatch 62 | fn that would apply to that value, or nil if none or default apply." 63 | [f k] 64 | (let [method (get-key-method f k)] 65 | (when (and method (not= method (get-method f :default))) 66 | method))) 67 | 68 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 69 | 70 | (defn ex-failed-system 71 | "Returns system attached to the integrant build exception e." 72 | [e] 73 | (let [system (-> e ex-data :system)] 74 | (when (and (map? system) (some-> system meta ::ig/origin)) 75 | system))) 76 | 77 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 78 | -------------------------------------------------------------------------------- /src/app/rum/mount.cljc: -------------------------------------------------------------------------------- 1 | (ns app.rum.mount 2 | #?(:clj (:require [clojure.string :as string]) 3 | :cljs (:require [rum.core :as rum])) 4 | (:require [app.rum.component :as component] 5 | [lib.cognitect-transit.core :as transit'])) 6 | 7 | #?(:clj (set! *warn-on-reflection* true) 8 | :cljs (set! *warn-on-infer* true)) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (def ^:private data-js-var "appReactMountData") 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | #?(:cljs (defn mount-all 17 | "Mount all components with data from server." 18 | [] 19 | (let [components (some-> (aget js/window data-js-var) 20 | (transit'/read-transit-string))] 21 | (js-delete js/window data-js-var) 22 | (doseq [comp-data components] 23 | (let [instance-id (component/instance-id comp-data)] 24 | (rum/hydrate (component/create-component comp-data) 25 | (js/document.getElementById (name instance-id)))))))) 26 | 27 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 28 | 29 | ;; TODO: Push state. 30 | 31 | #?(:clj (defn mount-component! 32 | "Hiccup-style element with pre-rendered react component. 33 | All react components are registered in registry to be added 34 | in page HTML later." 35 | ([registry!, comp-id] 36 | (mount-component! registry! :div comp-id nil)) 37 | 38 | ([registry!, comp-id, comp-data] 39 | (mount-component! registry! :div comp-id comp-data)) 40 | 41 | ([registry!, tag, comp-id, comp-data] 42 | (let [comp-data (-> comp-data 43 | (component/set-component-id comp-id))] 44 | (swap! registry! conj comp-data) 45 | [tag 46 | {:id (component/instance-id comp-data)} 47 | (component/create-component comp-data)])))) 48 | 49 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 50 | 51 | #?(:clj (defn init-mounter 52 | "Create `components!` and function to declare component mounting in page hiccup." 53 | [_] 54 | (let [components! (atom [])] 55 | [components! (partial mount-component! components!)]))) 56 | 57 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 58 | 59 | #?(:clj (defn react-mount-data-js 60 | "Hiccup for JS with data for mounting react components." 61 | [react-data] 62 | [:script {:dangerouslySetInnerHTML 63 | {:__html (str "window." data-js-var "=`" 64 | (-> (transit'/write-transit-string react-data) 65 | (string/replace "\\" "\\\\") 66 | (string/replace "`" "\\`")) 67 | "`;")}}])) 68 | 69 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 70 | -------------------------------------------------------------------------------- /src/lib/hikari_cp/data_source.clj: -------------------------------------------------------------------------------- 1 | (ns lib.hikari-cp.data-source 2 | (:require [clojure.spec.alpha :as s] 3 | [lib.util.secret :as secret]) 4 | (:import (com.zaxxer.hikari HikariDataSource))) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (s/check-asserts true) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (s/def ::data-source-class string?) 15 | (s/def ::database-url string?) 16 | (s/def ::database-user string?) 17 | (s/def ::database-password ::secret/spec) 18 | (s/def ::minimum-idle int?) 19 | (s/def ::maximum-pool-size int?) 20 | (s/def ::connection-timeout int?) 21 | (s/def ::idle-timeout int?) 22 | (s/def ::max-lifetime int?) 23 | (s/def ::read-only boolean?) 24 | (s/def ::leak-detection-threshold int?) 25 | 26 | (s/def ::options (s/keys :req-un [::data-source-class 27 | ::database-url 28 | ::database-user 29 | ::database-password] 30 | :opt-un [::minimum-idle 31 | ::maximum-pool-size 32 | ::connection-timeout 33 | ::idle-timeout 34 | ::max-lifetime 35 | ::read-only 36 | ::leak-detection-threshold])) 37 | 38 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 39 | 40 | (defn- init-hikari-data-source 41 | "Force data source to connect after creation. 42 | Otherwise it's connected only during getting first connection." 43 | [^HikariDataSource ds] 44 | (.close (.getConnection ds)) 45 | ds) 46 | 47 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 48 | 49 | (defn create-data-source 50 | "Create HikariCP data source." 51 | [{:keys [data-source-class, database-url, database-user, database-password 52 | minimum-idle, maximum-pool-size, connection-timeout, idle-timeout, max-lifetime 53 | pool-name, read-only, leak-detection-threshold] 54 | :or {read-only false} :as options}] 55 | 56 | (s/assert ::options options) 57 | 58 | (doto (HikariDataSource.) 59 | (.setDataSourceClassName data-source-class) 60 | (.addDataSourceProperty "url" database-url) 61 | (.addDataSourceProperty "user" database-user) 62 | (.addDataSourceProperty "password" (secret/read-secret database-password)) 63 | (cond-> 64 | minimum-idle (doto (.setMinimumIdle minimum-idle)) 65 | maximum-pool-size (doto (.setMaximumPoolSize maximum-pool-size)) 66 | connection-timeout (doto (.setConnectionTimeout connection-timeout)) 67 | idle-timeout (doto (.setIdleTimeout idle-timeout)) 68 | max-lifetime (doto (.setMaxLifetime max-lifetime)) 69 | leak-detection-threshold (doto (.setLeakDetectionThreshold leak-detection-threshold))) 70 | (.setReadOnly read-only) 71 | (.setPoolName (str (when pool-name (str pool-name " ")) 72 | (if read-only "RO" "RW"))) 73 | (init-hikari-data-source))) 74 | 75 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 76 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # webapp-clojure-2020 2 | 3 | ## Rationale 4 | 5 | I needed project setup to support following workflow: 6 | 7 | - The application running in development mode behave like application running in production 8 | (as much as possible). So all development code is addictive and excluded from production build. 9 | - The application state keep running and reloading automatically on changes. 10 | - Developer can easily extend development environment with any required tools. 11 | 12 | So in about 2 years I've gradually built this prototype for my own needs. 13 | 14 | ## Features 15 | 16 | ### Project 17 | 18 | - Leiningen based project. 19 | - Code style settings for IntelliJ IDEA with Cursive. 20 | 21 | ### System 22 | 23 | - Integrant for application and development systems. 24 | - Parallel start of integrant components. 25 | - Separate sources for application and development code. 26 | - Hot reloading on source files changes. 27 | - `mount` as integrant component for compiled dependencies in code. 28 | - Configuration in JAVA properties files. 29 | - Daemon interface to be run as service with `jsvc`. 30 | 31 | ### HTTP Server 32 | 33 | - `Immutant` web server with multiple webapps, single port, multiple hostnames. 34 | - Routing: `metosin/reitit`. 35 | - Page-rendering: `hiccup`. 36 | 37 | ### Frontend 38 | 39 | - ClojureScript with Shadow CLJS (lein integration). 40 | - React JS + Rum + Server-side rendering (SSR) + Passing component data from server 41 | - Tailwind CSS 42 | - Reload pages without Shadow CLJS (adapted `ring-refresh`) 43 | 44 | ### SQL Database 45 | 46 | - `next.jdbc` JDBC wrapper. 47 | - `HugSQL` “query builder”. 48 | - `HikariCP` connection pool. 49 | - Log database queries via `p6spy`. 50 | - Database migrations with `Liquibase`. 51 | - Separate read-write and read-only database connections. 52 | 53 | ## Q&A 54 | 55 | ### Why mount _and_ integrant? 56 | 57 | During migration of my setup from mount to integrant I found: 58 | - that integrant is good for 59 | - managing “big” components like web server, database connection pool and so on, 60 | which don't require direct reference in the code, 61 | - managing multiple systems like application and development once. 62 | - but passing integrant state around as map to access it from code is 63 | - annoying, 64 | - not so performant as mount, 65 | - harder to trace dependencies in code using IDE's navigation tools. 66 | 67 | So I decided to take best from both worlds and use mount and integrant simultaneously. 68 | 69 | ## Installation 70 | 71 | 1. OpenJDK 11 https://adoptopenjdk.net/ 72 | 2. Leiningen https://leiningen.org/ 73 | 3. Node.js https://nodejs.org/ 74 | 4. npm modules: `npm install --no-package-lock` 75 | 76 | ## Usage 77 | 78 | Run for development: 79 | 80 | lein run 81 | 82 | Run to check build with release options: 83 | 84 | lein clean 85 | lein with-profile test-release run 86 | 87 | Build release: 88 | 89 | lein uberjar 90 | 91 | Run built release: 92 | 93 | java -Dconfig.file=dev/app/config/default.props -jar ./target/uberjar/website.jar 94 | 95 | ## Configuration 96 | 97 | Custom configuration properties can be placed in optional file (excluded from version control): 98 | 99 | dev/app/config/user.props 100 | 101 | Custom configuration for the development environment can be placed in the optional file 102 | (excluded from version control): 103 | 104 | dev/dev/config/user.edn 105 | -------------------------------------------------------------------------------- /src/app/system/integrant_config/app_config_setup.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.integrant-config.app-config-setup 2 | "Config template setup for application properties. 3 | Example: 4 | {:app.system.service/app-config 5 | #::config{:setup ::app-config-setup 6 | :mounts [:lib.online-config.core/app-config] 7 | :config {:default-props \"app/config/default.props\" 8 | :conform-rules {#\"System\\.Switch\\..+\" :edn 9 | #\"Webapp\\.Hosts\\(.+\\)\" :set 10 | #\".+\\.Password\" :secret 11 | #\".+\\.PublicKey\" :rsa-public-key 12 | #\".+\\.Secret\" :secret 13 | \"Mailer.Smtp.Port\" :edn 14 | \"Mailer.Smtp.Options\" :edn}}}}" 15 | (:require [app.system.integrant-config :as config] 16 | [clojure.test :as test] 17 | [integrant.core :as ig] 18 | [lib.clojure.core :as c])) 19 | 20 | (set! *warn-on-reflection* true) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (derive :dev.env.system/prepare-prop-files :lib.integrant.system/identity) 25 | 26 | (defn- app-config-setup 27 | "Returns config map with addons: 28 | - Key :{config-key}.prop-files with \"config.file\" system property referred 29 | as :prop-files it the config value; 30 | - Key :dev.env.system/prepare-prop-files referred as :dev/prepare-prop-files 31 | in the config value." 32 | [{:builder/keys [config-map config-key params]}] 33 | (let [prop-files-key (config/suffix-key config-key ".prop-files")] 34 | (config/build-config config-map {:dev.env.system/prepare-prop-files nil 35 | prop-files-key #::config{:derive :lib.integrant.system/system-property 36 | :config {:key "config.file"}} 37 | config-key (c/deep-merge params #::config{:config {:prop-files (ig/ref prop-files-key) 38 | :dev/prepare-prop-files (ig/ref :dev.env.system/prepare-prop-files)}})}))) 39 | 40 | (c/add-method config/setup-builder :app.system.core/app-config-setup app-config-setup) 41 | 42 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 43 | 44 | (test/deftest app-config-setup-test 45 | (test/are [expr result] (= result expr) 46 | (config/build-config {:test/app-config #::config{:setup :app.system.core/app-config-setup 47 | :mounts [:test/app-config-mount] 48 | :config {:default-props "default.props"}}}) 49 | #_=> {:dev.env.system/prepare-prop-files nil, 50 | [:lib.integrant.system/system-property :test/app-config.prop-files] {:key "config.file"}, 51 | :app.system.service/mount #:test{:app-config-mount #integrant.core.Ref{:key :test/app-config}}, 52 | :test/app-config {:prop-files #integrant.core.Ref{:key :test/app-config.prop-files}, 53 | :dev/prepare-prop-files #integrant.core.Ref{:key :dev.env.system/prepare-prop-files}, 54 | :default-props "default.props"}})) 55 | 56 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 57 | -------------------------------------------------------------------------------- /src/lib/clojure_tools_logging/logger.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure-tools-logging.logger 2 | "Logging macros using explicit logger instance." 3 | (:require [clojure.tools.logging :as log] 4 | [clojure.tools.logging.impl :as impl] 5 | [lib.clojure-string.core :as string'] 6 | [lib.clojure.core :as c])) 7 | 8 | (set! *warn-on-reflection* true) 9 | 10 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 11 | 12 | (defn get-logger 13 | "Returns an implementation-specific Logger by name." 14 | [logger-name] 15 | (impl/get-logger log/*logger-factory* logger-name)) 16 | 17 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 18 | 19 | (defmacro log-enabled 20 | "Evaluates and logs a message only if the specified level is enabled. See log* 21 | for more details." 22 | ([logger level message] `(log-enabled ~logger ~level nil ~message)) 23 | ([logger level throwable message] 24 | `(if (impl/enabled? ~logger ~level) 25 | (log/log* ~logger ~level ~throwable ~message)))) 26 | 27 | (comment 28 | (let [logger (impl/get-logger log/*logger-factory* "test") 29 | s "4" n nil] 30 | (log-enabled logger :info (c/pr-str* 1 2 3 "X" s n :k)) 31 | (log-enabled logger :error (c/pr-str* 1 2 3 "X" s n :k)))) 32 | 33 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 34 | 35 | (defn- str-ex-data 36 | "Converts all nested ex-data to the logging string." 37 | [throwable] 38 | (loop [sb (StringBuilder.), throwable throwable] 39 | (if throwable 40 | (let [data (not-empty (ex-data throwable))] 41 | (recur (cond-> sb data (-> (.append " $ ") 42 | (.append (str data)))) 43 | (.getCause ^Throwable throwable))) 44 | (when (pos? (.length sb)) 45 | (.toString sb))))) 46 | 47 | (defn str-throwable 48 | "Returns message string for the throwable." 49 | [throwable message] 50 | (let [data (str-ex-data throwable)] 51 | (cond-> ^String (c/ex-message-all throwable (-> (str message) (string'/not-empty))) 52 | data (.concat data)))) 53 | 54 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 55 | 56 | (defmacro info 57 | "Info level logging." 58 | [logger message] 59 | `(log-enabled ~logger :info ~message)) 60 | 61 | (defmacro debug 62 | "Debug level logging." 63 | [logger message] 64 | `(log-enabled ~logger :debug ~message)) 65 | 66 | (defmacro error 67 | "Error level logging. 68 | Uses logger `(get-logger *ns*)` if not specified." 69 | ([message] 70 | `(error (get-logger ~*ns*) ~message)) 71 | ([logger message] 72 | `(log-enabled ~logger :error ~message))) 73 | 74 | (defmacro log-throwable 75 | "Error level logging of the throwable. 76 | Uses logger `(get-logger *ns*)` if not specified." 77 | ([throwable message] 78 | `(log-throwable (get-logger ~*ns*) ~throwable ~message)) 79 | ([logger throwable message] 80 | `(let [throwable# ~throwable] 81 | (log/log* ~logger :error throwable# (str-throwable throwable# ~message))))) 82 | 83 | (comment 84 | (let [logger (get-logger "test") 85 | throwable (ex-info "Exception" {:error true} (ex-info "Cause" {:cause true})) 86 | message (c/pr-str* 1 2 3 (str "4") "X")] 87 | (info logger message) 88 | (debug logger message) 89 | (error logger message) 90 | (log-throwable logger throwable nil) 91 | (log-throwable logger throwable message))) 92 | 93 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 94 | -------------------------------------------------------------------------------- /src/lib/clojure/perf.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.perf 2 | "Faster implementation of some core functions." 3 | (:import (clojure.lang Counted))) 4 | 5 | (set! *warn-on-reflection* true) 6 | (set! *unchecked-math* :warn-on-boxed) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn merge-not-empty 11 | "Merges two hash-maps `a` and `b` skipping empty input. 12 | (!) Does not preserve meta of the empty `a`." 13 | [a b] 14 | (if b 15 | (if a 16 | (if (zero? (.count ^Counted b)) 17 | a 18 | (if (zero? (.count ^Counted a)) 19 | b 20 | (merge a b))) 21 | b) 22 | a)) 23 | 24 | (comment 25 | (merge {0 0} {5 5 6 6 7 7 8 8 9 9}) ;Execution time mean : 701,882584 ns 26 | (merge-not-empty {0 0} {5 5 6 6 7 7 8 8 9 9}) ;Execution time mean : 706,529319 ns 27 | 28 | (merge nil {0 0}) ;Execution time mean : 301,955790 ns 29 | (merge-not-empty nil {0 0}) ;Execution time mean : 5,475567 ns 30 | 31 | (merge {} {0 0}) ;Execution time mean : 274,920615 ns 32 | (merge-not-empty {} {0 0}) ;Execution time mean : 6,678426 ns 33 | 34 | (merge {0 0} nil) ;Execution time mean : 126,049276 ns 35 | (merge-not-empty {0 0} nil) ;Execution time mean : 6,130941 ns 36 | 37 | (merge {0 0} {}) ;Execution time mean : 267,252445 ns 38 | (merge-not-empty {0 0} {}) ;Execution time mean : 7,414466 ns 39 | 40 | (merge nil nil) ;Execution time mean : 68,336964 ns 41 | (merge-not-empty nil nil) ;Execution time mean : 0,298792 ns 42 | 43 | (merge {} {}) ;Execution time mean : 246,174180 ns 44 | (merge-not-empty {} {}) ;Execution time mean : 6,895146 ns 45 | ) 46 | 47 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 48 | 49 | (defmacro inline-str 50 | "Builds string inline." 51 | [& args] 52 | `(-> (StringBuilder.) 53 | ~@(->> args (map #(list '.append (cond->> % ((some-fn symbol? list?) %) (list 'clojure.core/str))))) 54 | (.toString))) 55 | 56 | (comment 57 | (macroexpand-1 '(inline-str 1 2 3 "" (do nil))) 58 | (str 1 2 3 "" :x (inc 3) [] {}) 59 | (inline-str 1 2 3 "" :x (inc 3) [] {}) 60 | 61 | (str "a: " 1 " b: " 2 " c: " 3) ;Execution time mean : 317,642476 ns 62 | #_"a: 1 b: 2 c: 3" 63 | (inline-str "a: " 1 " b: " 2 " c: " 3) ;Execution time mean : 45,411832 ns 64 | #_"a: 1 b: 2 c: 3" 65 | 66 | (str :a " " 1 " " :b " " 2 " " :c " " 3) ;Execution time mean : 527,635347 ns 67 | #_":a 1 :b 2 :c 3" 68 | (inline-str :a " " 1 " " :b " " 2 " " :c " " 3) ;Execution time mean : 75,721557 ns 69 | #_":a 1 :b 2 :c 3" 70 | 71 | (str :a \space 1 \space :b \space 2 \space :c \space 3) ;Execution time mean : 556,198887 ns 72 | #_":a 1 :b 2 :c 3" 73 | (inline-str :a \space 1 \space :b \space 2 \space ;Execution time mean : 84,851354 ns 74 | :c \space 3) 75 | #_":a 1 :b 2 :c 3" 76 | 77 | (str (comment nil) (comment nil) (comment nil) ;Execution time mean : 165,238901 ns 78 | (comment nil) (comment nil)) 79 | #_"" 80 | (inline-str (comment nil) (comment nil) (comment nil) ;Execution time mean : 21,796580 ns 81 | (comment nil) (comment nil)) 82 | #_"" 83 | ) 84 | 85 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 86 | -------------------------------------------------------------------------------- /src/app/system/integrant_config/hikari_data_source_mixin.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.integrant-config.hikari-data-source-mixin 2 | "Config template mixin for Hikari-CP data source. 3 | Example: 4 | {::data-source-read-write #::config{:mixins [::hikari-data-source-mixin]} 5 | ::data-source-read-only #::config{:mixins [::hikari-data-source-mixin] 6 | :config {:read-only true}}}" 7 | (:require [app.system.integrant-config :as config] 8 | [clojure.test :as test] 9 | [integrant.core :as ig] 10 | [lib.clojure.core :as c])) 11 | 12 | (set! *warn-on-reflection* true) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (defn- hikari-data-source-mixin 17 | "Merges Hikari-CP data source options in the builder params." 18 | [_ {:builder/keys [params]}] 19 | (c/deep-merge params #::config{:derive :app.system.service/hikari-data-source 20 | :config {:dev-mode (ig/ref :app.system.core/dev-mode)} 21 | :import {:data-source-class "Database.DataSourceClassName" 22 | :database-url (if (-> params ::config/config :read-only) 23 | "Database.Url.ReadOnly", "Database.Url") 24 | :database-user "Database.User" 25 | :database-password "Database.Password"}})) 26 | 27 | (c/add-method config/builder-mixin :app.system.core/hikari-data-source-mixin hikari-data-source-mixin) 28 | 29 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 30 | 31 | (test/deftest hikari-data-source-mixin-test 32 | (test/are [expr result] (= result expr) 33 | (config/build-config {:test/read-write #::config{:mixins [:app.system.core/hikari-data-source-mixin], :mounts [:test/mount-rw]} 34 | :test/read-only, #::config{:mixins [:app.system.core/hikari-data-source-mixin], :mounts [:test/mount-ro], :config {:read-only true}}}) 35 | #_=> {:app.system.service/mount {:test/mount-ro #integrant.core.Ref{:key :test/read-only} 36 | :test/mount-rw #integrant.core.Ref{:key :test/read-write}} 37 | [:app.system.service/hikari-data-source :test/read-only] #integrant.core.Ref{:key :test/read-only.config} 38 | [:app.system.service/hikari-data-source :test/read-write] #integrant.core.Ref{:key :test/read-write.config} 39 | [:lib.integrant.system/import-map :test/read-only.config] {:import-from #integrant.core.Ref{:key :app.system.service/app-config} 40 | :import-keys {:data-source-class "Database.DataSourceClassName" 41 | :database-password "Database.Password" 42 | :database-url "Database.Url.ReadOnly" 43 | :database-user "Database.User"} 44 | :init-map {:dev-mode #integrant.core.Ref{:key :app.system.core/dev-mode} 45 | :read-only true}} 46 | [:lib.integrant.system/import-map :test/read-write.config] {:import-from #integrant.core.Ref{:key :app.system.service/app-config} 47 | :import-keys {:data-source-class "Database.DataSourceClassName" 48 | :database-password "Database.Password" 49 | :database-url "Database.Url" 50 | :database-user "Database.User"} 51 | :init-map {:dev-mode #integrant.core.Ref{:key :app.system.core/dev-mode}}}})) 52 | 53 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 54 | -------------------------------------------------------------------------------- /dev/dev/env/system/app.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.app 2 | "Wrap app system with development related adjustments." 3 | (:require [app.system.core :as app.system] 4 | [clojure.string :as string] 5 | [dev.env.reload.ring-refresh :as ring-refresh] 6 | [dev.env.tailwind.watcher :as tailwind] 7 | [me.raynes.fs :as fs] 8 | [ring.middleware.lint :as lint])) 9 | 10 | (set! *warn-on-reflection* true) 11 | 12 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 13 | 14 | (derive :app.system.service/hikari-data-source, :lib.integrant.system/keep-running-on-suspend) 15 | (derive :app.system.task/update-database-schema :lib.integrant.system/keep-running-on-suspend) 16 | (derive :lib.integrant.system/import-map,,,,,,, :lib.integrant.system/keep-running-on-suspend) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (def ^:private user-props-file "dev/app/config/user.props") 21 | 22 | (defn- prepare-prop-files 23 | [prop-files] 24 | (cond 25 | (not (fs/file? user-props-file)), prop-files 26 | (string? prop-files), (string/join "," [prop-files user-props-file]) 27 | (sequential? prop-files), (-> (into [] prop-files) 28 | (conj user-props-file)) 29 | :else user-props-file)) 30 | 31 | (comment 32 | (prepare-prop-files nil) 33 | (prepare-prop-files "dev/app/config/default.props") 34 | (prepare-prop-files ["dev/app/config/default.props"]) 35 | (prepare-prop-files '("dev/app/config/default.props"))) 36 | 37 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 38 | 39 | (defn- wrap-webapp-handler 40 | [_webapp] 41 | (fn [handler] 42 | (-> handler 43 | lint/wrap-lint 44 | ring-refresh/wrap-refresh))) 45 | 46 | (defn- prepare-webapp 47 | [webapp] 48 | (-> webapp 49 | (update :handler (wrap-webapp-handler webapp)))) 50 | 51 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 52 | 53 | (def ^:private changelog-track-dir "resources/app/database/schema") 54 | 55 | (defn- dir-mod-time 56 | [dir] 57 | (->> (fs/iterate-dir dir) 58 | (map (comp fs/mod-time first)) 59 | (reduce max 0))) 60 | 61 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 62 | 63 | (defn- prepare-system-config 64 | [config] 65 | (assoc config ::app.system/dev-mode true 66 | :dev.env.system/prepare-prop-files prepare-prop-files 67 | :dev.env.system/prepare-webapp prepare-webapp 68 | :dev.env.system/db-changelog-mod-time (dir-mod-time changelog-track-dir))) 69 | 70 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 71 | 72 | (defn start 73 | "Start `app` system." 74 | ([] 75 | (start {})) 76 | ([{:keys [system-keys]}] 77 | (try (app.system/start (cond-> {:prepare-config prepare-system-config} 78 | system-keys (assoc :system-keys system-keys))) 79 | (catch Throwable e 80 | (throw (->> e (Exception. (str 'app.system/start)))))) 81 | (ring-refresh/send-refresh true))) 82 | 83 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 84 | 85 | (defn stop 86 | "Stop `app` system." 87 | [] 88 | (ring-refresh/send-refresh false) 89 | (app.system/stop)) 90 | 91 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 92 | 93 | (defn suspend 94 | "Suspend `app` system." 95 | [] 96 | (ring-refresh/send-refresh false) 97 | (app.system/suspend)) 98 | 99 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 100 | 101 | (defn resume 102 | "Resume `app` system." 103 | [] 104 | (tailwind/build-content-if-updated) 105 | (try (app.system/resume {:prepare-config prepare-system-config}) 106 | (catch Throwable e 107 | (throw (->> e (Exception. (str 'app.system/resume)))))) 108 | (ring-refresh/send-refresh true)) 109 | 110 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 111 | -------------------------------------------------------------------------------- /dev/dev/env/reload/app_reload.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.reload.app-reload 2 | (:require [clojure.main :as main] 3 | [clojure.string :as string] 4 | [lib.clojure-tools-logging.logger :as logger] 5 | [lib.clojure.core :as c] 6 | [ns-tracker.core :as ns-tracker]) 7 | (:import (java.io FileNotFoundException))) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (def ^:private logger (logger/get-logger *ns*)) 14 | 15 | (defn- ns-unalias-all 16 | "Removes all aliases in namespace." 17 | [ns-sym] 18 | (doseq [[alias-sym _] (try (ns-aliases ns-sym) (catch Throwable _))] 19 | (ns-unalias ns-sym alias-sym))) 20 | 21 | (defn- reload-ns 22 | "Reloads ns and returns nil or `[ns-sym err-msg]`." 23 | [ns-sym] 24 | (try 25 | (ns-unalias-all ns-sym) 26 | (require ns-sym :reload) 27 | (logger/info logger (str "[OK] Reload " ns-sym)) 28 | nil 29 | (catch FileNotFoundException _ 30 | (remove-ns ns-sym) 31 | nil) 32 | (catch Throwable e 33 | [ns-sym e]))) 34 | 35 | (defn- reload-namespaces 36 | "Returns vector of reload errors." 37 | [namespaces] 38 | (when-let [namespaces (some->> namespaces seq distinct)] 39 | ;; Reload can fail due to the incorrect order of namespaces. 40 | ;; So we reload multiple times recursively while this reduces amount of failed namespaces. 41 | (loop [xs (mapv vector namespaces)] 42 | (logger/info logger (str "Reloading namespaces: " (string/join ", " (map first xs)))) 43 | (let [errors (->> xs (into [] (comp (map first) (keep reload-ns))))] 44 | (if (and (seq errors), (< (count errors) (count xs))) 45 | (recur errors) 46 | errors))))) 47 | 48 | (defn- log-reload-error 49 | [[failed-ns, throwable]] 50 | (logger/error logger (str "[FAIL] Reload " (str failed-ns "\n\n" (-> throwable Throwable->map main/ex-triage main/ex-str))))) 51 | 52 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 53 | 54 | (defonce ^:private ^{:doc "Keeps namespace reload errors."} 55 | reload-errors! (atom nil)) 56 | 57 | (defn watch-handler 58 | "Builds app reloading function to be used in file watcher." 59 | [{:keys [ns-tracker-dirs, always-reload-ns, never-reload-ns, never-reload-ns-in, 60 | app-stop, app-start, on-success, on-failure]}] 61 | (let [ns-tracker (ns-tracker/ns-tracker ns-tracker-dirs)] 62 | (fn app-reload [& _] 63 | (when app-stop 64 | (try (app-stop) (catch Throwable e 65 | (logger/log-throwable logger e "Stop application before namespace reloading")))) 66 | (if-some [errors (seq (->> (concat always-reload-ns (ns-tracker) (map first @reload-errors!)) 67 | (remove (set never-reload-ns)) 68 | (remove (fn [n] (->> never-reload-ns-in (some (partial string/starts-with? (str n ".")))))) 69 | (reload-namespaces) 70 | (reset! reload-errors!)))] 71 | (do 72 | (run! log-reload-error errors) 73 | (when on-failure 74 | (on-failure (ex-info (c/pr-str* "Failed to reload namespaces" (map first errors)) 75 | {:reason ::reload-namespaces, :errors errors})))) 76 | (try 77 | (when app-start (app-start)) 78 | (when on-success (on-success)) 79 | (catch Throwable e 80 | (when on-failure (on-failure e)))))))) 81 | 82 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 83 | 84 | (defn print-reload-on-enter 85 | "Prints prompt for application reload." 86 | [] 87 | (print "\n<< Press ENTER to reload >>\n\n") 88 | (flush)) 89 | 90 | (defn log-reload-success 91 | "Prints confirmation of the successful application reload." 92 | [] 93 | (logger/info logger "[DONE] Application reload") 94 | (print-reload-on-enter)) 95 | 96 | (defn log-reload-failure 97 | "Prints error if application reload failed." 98 | [throwable] 99 | (logger/error logger (c/ex-message-all throwable)) 100 | (logger/info logger "[FAIL] Application reload") 101 | (print-reload-on-enter)) 102 | 103 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 104 | -------------------------------------------------------------------------------- /src/lib/config/props.clj: -------------------------------------------------------------------------------- 1 | (ns lib.config.props 2 | "Application configuration." 3 | (:require [clojure.java.io :as io] 4 | [clojure.string :as string] 5 | [clojurewerkz.propertied.properties :as properties] 6 | [lib.clojure.core :as c]) 7 | (:import (java.util.regex Pattern))) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (defn- load-map-from-props-file 14 | "Load props from single file as map." 15 | [file] 16 | (some-> file 17 | (io/file) 18 | (properties/load-from) 19 | (properties/properties->map))) 20 | 21 | (defn- string->filenames 22 | "Split comma separated file names to list." 23 | [s] 24 | (string/split s #",")) 25 | 26 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 27 | 28 | (defn load-prop-files 29 | "Load props files by sequence of filenames. Return combined hash-map." 30 | [filenames] 31 | (let [filenames (cond-> filenames 32 | (string? filenames) string->filenames)] 33 | (c/assert-pred filenames sequential?) 34 | (with-meta (->> filenames 35 | (map load-map-from-props-file) 36 | (reduce merge {})) 37 | {:prop-files filenames}))) 38 | 39 | (comment 40 | (meta (load-prop-files "dev/app/config/default.props")) 41 | (meta (load-prop-files ["dev/app/config/default.props"])) 42 | (meta (load-prop-files (list "dev/app/config/default.props"))) 43 | (meta (load-prop-files ["dev/app/config/default.props" 44 | "dev/app/config/default.props"])) 45 | (meta (load-prop-files nil)) 46 | (meta (merge (load-prop-files (list "dev/app/config/default.props")) 47 | (System/getProperties))) 48 | (re-matches #"Webapp\.Hosts\(.+\)" "Webapp.Hosts(ok)") 49 | (re-matches #"System\.Switch\..+" "System.Switch.BackendService") 50 | (keyword "Webapp.Hosts(ok)") 51 | (require '[integrant.core :as ig]) 52 | (into (sorted-map) 53 | (ig/init-key :app.system.service/app-config 54 | {:prop-files "dev/app/config/default.props" 55 | :conform-rules {"Mailer.Smtp.Port" :edn 56 | "Mailer.Smtp.Options" :edn 57 | #"System\.Switch\..+" :edn 58 | #"Webapp\.Hosts\(.+\)" :set}}))) 59 | 60 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 61 | 62 | (defmulti ^:private conform-prop-val 63 | "Define conform rule by rule keyword." 64 | {:arglists '([rule value])} 65 | c/first-arg) 66 | 67 | (defn- conform-prop-val* 68 | [k rule value] 69 | (try (conform-prop-val rule value) 70 | (catch Throwable e 71 | (throw (->> e (Exception. (c/pr-str* 'conform-prop-val k rule value))))))) 72 | 73 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 74 | 75 | (defn add-conform-rule 76 | "Installs function f as a handler for the rule keyword in the `conform-prop-val`." 77 | [rule, f] 78 | (c/add-method conform-prop-val rule #(f %2))) 79 | 80 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 81 | 82 | (defn apply-conform-rules 83 | "Apply conform rules to props map values." 84 | [m rules] 85 | (let [apply-regex (fn [pattern rule] 86 | (fn [cm! k v] 87 | (if (re-matches pattern k) 88 | (assoc! cm! k (conform-prop-val* pattern rule v)) 89 | cm!))) 90 | conformed (persistent! (reduce-kv (fn [cm! k rule] 91 | (cond 92 | (instance? Pattern k), (reduce-kv (apply-regex k rule), cm!, m) 93 | :else (if-some [v (m k)] 94 | (assoc! cm! k (conform-prop-val* k rule v)) 95 | cm!))) 96 | (transient {}) 97 | rules))] 98 | (merge m, conformed))) 99 | 100 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 101 | -------------------------------------------------------------------------------- /dev/dev/env/system/core.clj: -------------------------------------------------------------------------------- 1 | (ns dev.env.system.core 2 | (:require [clojure.edn :as edn] 3 | [dev.env.reload.app-reload :as app-reload] 4 | [dev.env.system.app :as app.system] 5 | [dev.env.system.integrant :as ig'] 6 | [integrant.core :as ig] 7 | [lib.clojure.core :as c] 8 | [lib.clojure.ns :as ns] 9 | [lib.integrant.system :as ig.system] 10 | [me.raynes.fs :as fs])) 11 | 12 | (set! *warn-on-reflection* true) 13 | 14 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 15 | 16 | (ns/require-dir 'dev.env.system.integrant._) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (defonce ^:private stats! 21 | (atom {::start-count 0})) 22 | 23 | (defn- register-successful-start 24 | [] 25 | (swap! stats! update ::start-count inc)) 26 | 27 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 28 | 29 | (defn- read-config-edn 30 | [f] 31 | (try (some-> (slurp f) 32 | (edn/read-string) 33 | :dev.env.system/config) 34 | (catch Throwable e 35 | (throw (->> e (Exception. (c/pr-str* #'read-config-edn f))))))) 36 | 37 | (defn- add-repl-dependency 38 | "Adds dependency for :dev.env.system.integrant/nrepl in every key to start 39 | REPL first because REPL is required to keep program running even if some key 40 | fails to start." 41 | [config] 42 | (into {} (map (fn [[k v]] 43 | [k (cond-> v 44 | (and (not= k :dev.env.system.integrant/nrepl) 45 | (map? v)) 46 | (assoc ::nrepl (ig/ref :dev.env.system.integrant/nrepl)))])) 47 | config)) 48 | 49 | (defn- read-config 50 | [] 51 | (-> (c/deep-merge (read-config-edn "./dev/dev/config/default.edn") 52 | (some-> (c/select "./dev/dev/config/user.edn" fs/file?) 53 | (read-config-edn))) 54 | (add-repl-dependency))) 55 | 56 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 57 | 58 | (defonce ^:private system! (atom nil)) 59 | 60 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 61 | 62 | (defn stop 63 | "Stop `env` system." 64 | [] 65 | (swap! system! #(some-> % ig'/halt!)) 66 | nil) 67 | 68 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 69 | 70 | (defn start 71 | "Start `env` system." 72 | [] 73 | (stop) 74 | (try (reset! system! (ig'/init (read-config))) 75 | (catch Exception e 76 | (when-let [system (some-> (ig.system/ex-failed-system e) 77 | (c/select :dev.env.system.integrant/nrepl))] 78 | ;; Keep partially started system if repl started successfully. 79 | (reset! system! system)) 80 | (throw e))) 81 | (register-successful-start) 82 | nil) 83 | 84 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 85 | 86 | (defn- restart 87 | "Restart (suspend/resume) `env` system." 88 | [] 89 | (when-some [system @system!] 90 | (let [config (read-config)] 91 | (reset! system! nil) 92 | (ig'/suspend! system) 93 | (try (reset! system! (ig'/resume config system)) 94 | (catch Exception e 95 | (when-let [system (ig.system/ex-failed-system e)] 96 | (reset! system! system)) 97 | (throw e))))) 98 | nil) 99 | 100 | (defn- trigger-watcher 101 | [k] 102 | (-> (get @system! k) meta :handler 103 | (doto (c/assert-pred fn? (str "Trigger watcher " k))) 104 | (c/invoke #'trigger-watcher k))) 105 | 106 | (defn- reload 107 | "Reload actions on ENTER keypress." 108 | [] 109 | (try 110 | (app.system/stop) 111 | (restart) 112 | (trigger-watcher :dev.env.system.integrant/app-reload) 113 | (catch Throwable e 114 | (app-reload/log-reload-failure e)))) 115 | 116 | (defn prompt-reload-on-enter 117 | "Prompts for manual reload on ENTER keypress." 118 | [] 119 | (app-reload/print-reload-on-enter) 120 | (while (some? (read-line)) 121 | (reload))) 122 | 123 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 124 | 125 | (defn nrepl-server 126 | "Get reference to global nREPL server instance." 127 | [] 128 | (some-> @system! 129 | :dev.env.system.integrant/nrepl)) 130 | 131 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 132 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject name.trofimov/webapp-clojure-2020 "1.0.0-SNAPSHOT" 2 | :description "Multi-page web application prototype with Clojure(Script)" 3 | :dependencies [;;; Clojure 4 | [org.clojure/clojure "1.11.0"] 5 | 6 | ;;; ClojureScript (shadow-cljs) 7 | [com.google.guava/guava "31.1-jre" :scope "provided"] 8 | [thheller/shadow-cljs "2.17.8" :scope "provided"] 9 | 10 | ;;; System 11 | [integrant "0.8.0"] 12 | [mount "0.1.16"] 13 | [tolitius/mount-up "0.1.3"] 14 | 15 | ;;; Web Server 16 | [io.undertow/undertow-core,,,,,,,,,, "2.2.16.Final"] 17 | [io.undertow/undertow-servlet,,,,,,, "2.2.16.Final"] 18 | [io.undertow/undertow-websockets-jsr "2.2.16.Final"] 19 | [metosin/reitit-core "0.5.17"] 20 | [org.immutant/web "2.1.10"] 21 | [ring/ring-core "1.9.5"] 22 | [ring/ring-defaults "0.3.3"] 23 | 24 | ;;; Database 25 | [com.h2database/h2 "2.1.210"] 26 | [com.layerware/hugsql "0.5.1" :exclusions [com.layerware/hugsql-adapter-clojure-java-jdbc]] 27 | [com.layerware/hugsql-adapter-next-jdbc "0.5.1"] 28 | [com.mattbertolini/liquibase-slf4j "4.0.0"] 29 | [com.zaxxer/HikariCP "5.0.1" :exclusions [org.slf4j/slf4j-api]] 30 | [org.liquibase/liquibase-core "4.9.0"] 31 | [seancorfield/next.jdbc "1.2.659"] 32 | [p6spy/p6spy "3.9.1"] 33 | 34 | ;;; Logging 35 | [ch.qos.logback/logback-classic "1.2.11"] 36 | [ch.qos.logback/logback-core "1.2.11"] 37 | [org.clojure/tools.logging "1.2.4"] 38 | [org.codehaus.janino/janino "3.1.6"] 39 | [org.slf4j/jul-to-slf4j "1.7.36"] 40 | [org.slf4j/slf4j-api "1.7.36"] 41 | 42 | ;;; Libs (Java) 43 | [com.fasterxml.jackson.core/jackson-core "2.13.2"] 44 | [commons-codec/commons-codec "1.15"] 45 | [org.apache.commons/commons-lang3 "3.12.0"] 46 | 47 | ;;; Libs (Clojure) 48 | [clojurewerkz/propertied "1.3.0"] 49 | [com.cognitect/transit-clj "1.0.329"] 50 | [medley "1.3.0"] 51 | [potemkin "0.4.5"] 52 | 53 | ;;; Libs (ClojureScript) 54 | [cljsjs/react "18.0.0-rc.0-0"] 55 | [cljsjs/react-dom "18.0.0-rc.0-0"] 56 | [rum "0.12.8"] 57 | 58 | ;;; Daemon 59 | [commons-daemon/commons-daemon "1.3.0"]] 60 | 61 | :main ^:skip-aot app.main 62 | :test-paths ["test" "src"] 63 | :target-path "target/%s" 64 | :plugins [[lein-shell "0.5.0"]] 65 | 66 | :clean-targets ^{:protect false} ["target" 67 | "resources/public/app"] 68 | 69 | :repl-options {:init-ns dev.env.main} 70 | 71 | :shell {:commands 72 | {"node_modules/.bin/postcss" 73 | {:windows "node_modules/.bin/postcss.cmd"}}} 74 | 75 | :aliases {"shadow-cljs" ["run" "-m" "shadow.cljs.devtools.cli"] 76 | 77 | "css-example-release" ["shell" 78 | "node_modules/.bin/postcss" 79 | "tailwind/app/\\$_example/main.css" 80 | "-o" "resources/public/app/example/main.css" 81 | "--config" "tailwind/app/config/"]} 82 | 83 | :profiles {:dev {:jvm-opts ["-Dconfig.file=dev/app/config/default.props"] 84 | :main ^:skip-aot dev.env.main 85 | :dependencies [[compojure "1.6.2" #_"For ring-refresh"] 86 | [me.raynes/fs "1.4.6"] 87 | [nrepl "0.9.0"] 88 | [ns-tracker "0.4.0"] 89 | [ring-refresh "0.1.2"] 90 | [ring/ring-devel "1.9.5"] 91 | [zcaudate/hara.io.watch "2.8.7"]] 92 | :source-paths ["dev" "tailwind"]} 93 | 94 | :test-release [:uberjar 95 | {:jvm-opts ["-Dconfig.file=dev/app/config/default.props"]}] 96 | 97 | :uberjar {:aot :all 98 | :prep-tasks ["compile" 99 | ["shadow-cljs" "release" "example"] 100 | "css-example-release"] 101 | :injections [(do (println "Disable clojure.test/*load-tests*") 102 | (require 'clojure.test) 103 | (alter-var-root #'clojure.test/*load-tests* (constantly false)))]}} 104 | 105 | :uberjar-name "website.jar") 106 | -------------------------------------------------------------------------------- /src/app/system/integrant_config/http_server_setup.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.integrant-config.http-server-setup 2 | "Config template setup for HTTP server. 3 | Example: 4 | {:app.system.service/immutant-web 5 | #::config{:setup ::http-server-setup 6 | :webapps {:app.system.service/homepage-http-handler 7 | #::config{:config {:name \"homepage\"} 8 | :import {:hosts \"Webapp.Hosts(homepage)\"}}} 9 | :import {:options {:port \"HttpServer.Port\"}} 10 | :awaits [::ready-to-serve]}" 11 | (:require [app.system.integrant-config :as config] 12 | [clojure.test :as test] 13 | [integrant.core :as ig] 14 | [lib.clojure.core :as c])) 15 | 16 | (set! *warn-on-reflection* true) 17 | 18 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 19 | 20 | (derive :dev.env.system/prepare-webapp :lib.integrant.system/identity) 21 | 22 | (defn- http-server-setup 23 | "Returns config map with addons: 24 | - Webapp keys from the ::config/webapps map, derived from 25 | :app.system.service/webapp-http-handler, referred as :webapps in the config 26 | value; 27 | - Key :dev.env.system/prepare-webapp referred as :dev/prepare-webapp it the 28 | config value." 29 | [{:builder/keys [config-map config-key params]}] 30 | (let [webapps (::config/webapps params)] 31 | (config/build-config config-map (into {:dev.env.system/prepare-webapp nil 32 | config-key (update params ::config/config merge 33 | {:webapps (->> webapps (mapv (comp ig/ref first))) 34 | :dev/prepare-webapp (ig/ref :dev.env.system/prepare-webapp)})} 35 | (map (fn [[k params]] 36 | [k (c/deep-merge params #::config{:derive :app.system.service/webapp-http-handler 37 | :config {:dev-mode (ig/ref :app.system.core/dev-mode)}})])) 38 | webapps)))) 39 | 40 | (c/add-method config/setup-builder :app.system.core/http-server-setup http-server-setup) 41 | 42 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 43 | 44 | (test/deftest http-server-setup-test 45 | (test/are [expr result] (= result expr) 46 | (config/build-config {:test/server #::config{:setup :app.system.core/http-server-setup 47 | :webapps {:app.system.service/homepage-http-handler #::config{:config {:name "homepage"} :import {:hosts "Webapp.Hosts(homepage)"}} 48 | :app.system.service/mobile-http-handler #::config{:config {:name "mobile"} :import {:hosts "Webapp.Hosts(mobile)"}}} 49 | :import {:options {:port "HttpServer.Port"}} 50 | :awaits [:test/ready-to-serve]}}) 51 | #_=> {:dev.env.system/prepare-webapp nil, 52 | [:app.system.service/webapp-http-handler :app.system.service/homepage-http-handler] #integrant.core.Ref{:key :app.system.service/homepage-http-handler.config}, 53 | [:lib.integrant.system/import-map :app.system.service/homepage-http-handler.config] {:init-map {:name "homepage", 54 | :dev-mode #integrant.core.Ref{:key :app.system.core/dev-mode}}, 55 | :import-from #integrant.core.Ref{:key :app.system.service/app-config}, 56 | :import-keys {:hosts "Webapp.Hosts(homepage)"}}, 57 | [:app.system.service/webapp-http-handler :app.system.service/mobile-http-handler] #integrant.core.Ref{:key :app.system.service/mobile-http-handler.config}, 58 | [:lib.integrant.system/import-map :app.system.service/mobile-http-handler.config] {:init-map {:name "mobile", 59 | :dev-mode #integrant.core.Ref{:key :app.system.core/dev-mode}}, 60 | :import-from #integrant.core.Ref{:key :app.system.service/app-config}, 61 | :import-keys {:hosts "Webapp.Hosts(mobile)"}}, 62 | [:lib.integrant.system/import-map :test/server] {:import-from #integrant.core.Ref{:key :app.system.service/app-config} 63 | :import-keys {:options {:port "HttpServer.Port"}} 64 | :init-map {:app.system.integrant-config/await-refs {:test/ready-to-serve #integrant.core.Ref{:key :test/ready-to-serve}} 65 | :dev/prepare-webapp #integrant.core.Ref{:key :dev.env.system/prepare-webapp} 66 | :webapps [#integrant.core.Ref{:key :app.system.service/homepage-http-handler} 67 | #integrant.core.Ref{:key :app.system.service/mobile-http-handler}]}}})) 68 | 69 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 70 | -------------------------------------------------------------------------------- /src/lib/integrant/async.clj: -------------------------------------------------------------------------------- 1 | (ns lib.integrant.async 2 | "Asynchronous utility for the integrant which allows to init/halt system keys 3 | in parallel." 4 | (:require [integrant.core :as ig])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defn- try-deref 11 | "Dereferences future/promise with 10 seconds timeout. Catches exceptions. 12 | Returns value of ref or nil on exception." 13 | [ref] 14 | (try (deref ref 10000 nil) 15 | (catch Throwable _))) 16 | 17 | (defn reverse-run! 18 | "Applies a side-effectful function f to each key value pair in a system map 19 | asynchronously. Keys are traversed in reverse dependency order. The function 20 | f should take two arguments, a key and value." 21 | [system ks f] 22 | {:pre [(map? system) (some-> system meta ::ig/origin)]} 23 | (let [origin (#'ig/system-origin system) 24 | ks (#'ig/reverse-dependent-keys origin ks) 25 | promises (zipmap ks (repeatedly promise))] 26 | (->> ks 27 | (map (fn [k] (future 28 | (try 29 | (some->> (#'ig/reverse-dependent-keys origin (list k)) 30 | (remove (partial identical? k)) 31 | (seq) 32 | (run! (comp try-deref promises))) 33 | (f k (system k)) 34 | (finally 35 | (deliver (promises k) nil)))))) 36 | (doall) 37 | (run! try-deref)))) 38 | 39 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 40 | 41 | (defn- build-key 42 | "Asynchronous version of the `integrant.core/build-key`." 43 | [f assertf resolvef system [k v]] 44 | (assoc system k (future 45 | (let [v' (#'ig/expand-key system resolvef v)] 46 | (assertf system k v') 47 | {::value v' ::impl (f k v')})))) 48 | 49 | (defn- build* 50 | "Copy of the `integrant.core/build` using modified `build-key` for 51 | asynchronous initialization." 52 | ([config, ks, f, assertf, resolvef] 53 | {:pre [(map? config)]} 54 | (let [relevant-keys (#'ig/dependent-keys config ks) 55 | relevant-config (select-keys config relevant-keys)] 56 | (when-let [invalid-key (first (#'ig/invalid-composite-keys config))] 57 | (throw (#'ig/invalid-composite-key-exception config invalid-key))) 58 | (when-let [ref (first (#'ig/ambiguous-refs relevant-config))] 59 | (throw (#'ig/ambiguous-key-exception config ref (map key (ig/find-derived config ref))))) 60 | (when-let [refs (seq (#'ig/missing-refs relevant-config))] 61 | (throw (#'ig/missing-refs-exception config refs))) 62 | (reduce (partial build-key f assertf resolvef) 63 | (with-meta {} {::ig/origin config}) 64 | (map (fn [k] [k (config k)]) relevant-keys))))) 65 | 66 | (defn build 67 | "Asynchronous version of the `integrant.core/build`." 68 | ([config, ks, f, assertf, resolvef] 69 | (let [system (build* config ks f assertf (comp ::impl deref resolvef)) 70 | system (reduce (fn [system [k ref]] 71 | (try 72 | (let [{::keys [value impl]} (deref ref)] 73 | (-> (assoc system k impl) 74 | (vary-meta assoc-in [::ig/build k] value))) 75 | (catch Exception e 76 | (vary-meta system assoc-in [::build-errors k] (ex-cause e))))) 77 | (empty system) 78 | system)] 79 | (when-let [errors (-> system meta ::build-errors)] 80 | (let [k (some (set (keys errors)) (#'ig/dependent-keys config ks))] 81 | (throw (#'ig/build-exception system f k nil (errors k))))) 82 | system))) 83 | 84 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 85 | 86 | (defn init 87 | "Turn a config map into an system map asynchronously. Keys are traversed in 88 | dependency order, initiated via the init-key multimethod, then the refs 89 | associated with the key are expanded. Every init-key is invoked in separate 90 | thread, first exception is raised." 91 | ([config] 92 | (init config (keys config))) 93 | ([config ks] 94 | {:pre [(map? config)]} 95 | (build config ks ig/init-key #'ig/assert-pre-init-spec ig/resolve-key))) 96 | 97 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 98 | 99 | (defn halt! 100 | "Halts a system map by applying halt-key! asynchronously in reverse dependency 101 | order. Every halt-key! is invoked in separate thread, exceptions are ignored." 102 | ([system] 103 | (halt! system (keys system))) 104 | ([system ks] 105 | {:pre [(map? system) (some-> system meta ::ig/origin)]} 106 | (reverse-run! system ks ig/halt-key!))) 107 | 108 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 109 | 110 | (defn resume 111 | "Turn a config map into a system map asynchronously, reusing resources from an 112 | existing system when it's possible to do so. Keys are traversed in dependency 113 | order, resumed with the resume-key multimethod, then the refs associated with 114 | the key are expanded. Every init-key is invoked in separate thread, first 115 | exception is raised. The halt-missing-keys! is invoked synchronously same like 116 | in the integrant.core/resume." 117 | ([config system] 118 | (resume config system (keys config))) 119 | ([config system ks] 120 | {:pre [(map? config) (map? system) (some-> system meta ::ig/origin)]} 121 | (#'ig/halt-missing-keys! config system ks) 122 | (build config ks (fn [k v] 123 | (if (contains? system k) 124 | (ig/resume-key k v (-> system meta ::ig/build (get k)) (system k)) 125 | (ig/init-key k v))) 126 | #'ig/assert-pre-init-spec 127 | ig/resolve-key))) 128 | 129 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 130 | 131 | (defn suspend! 132 | "Suspends a system map by applying halt-key! asynchronously in reverse 133 | dependency order. Every suspend-key! is invoked in separate thread, exceptions 134 | are ignored." 135 | ([system] 136 | (suspend! system (keys system))) 137 | ([system ks] 138 | {:pre [(map? system) (some-> system meta ::ig/origin)]} 139 | (reverse-run! system ks ig/suspend-key!))) 140 | 141 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 142 | -------------------------------------------------------------------------------- /src/app/system/core.clj: -------------------------------------------------------------------------------- 1 | (ns app.system.core 2 | (:require [app.system.integrant :as ig'] 3 | [app.system.integrant-config :as config] 4 | [integrant.core :as ig] 5 | [lib.clojure-tools-logging.logger :as logger] 6 | [lib.clojure.core :as c] 7 | [lib.clojure.ns :as ns])) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (ns/require-dir 'app.system.integrant-config._) 14 | (ns/require-dir 'app.system.service._) 15 | (ns/require-dir 'app.system.task._) 16 | 17 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 18 | 19 | (derive ::dev-mode,,,,,,,,,,,,,,,,,,,,,,,,,,, :lib.integrant.system/identity) 20 | (derive :dev.env.system/db-changelog-mod-time :lib.integrant.system/identity) 21 | 22 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 23 | 24 | (defn- config-template 25 | [] 26 | {::dev-mode false 27 | 28 | :app.system.service/app-config #::config{:setup ::app-config-setup 29 | :mounts [:app.config.core/app-config] 30 | :config {:conform-rules {#"System\.Switch\..+" :edn 31 | #".+\.Password" :secret 32 | #".+\.Secret" :secret 33 | #"Webapp\.Hosts\(.+\)" :set 34 | "Feature.DatabaseSchemaUpdate" :edn} 35 | :prop-defaults {"HttpServer.Port" 8080}}} 36 | 37 | ::data-source-read-write #::config{:mixins [::hikari-data-source-mixin] 38 | :mounts [:app.database.core/data-source-read-write 39 | :app.database.hugsql/data-source-read-write]} 40 | 41 | ::data-source-read-only #::config{:mixins [::hikari-data-source-mixin] 42 | :mounts [:app.database.core/data-source-read-only 43 | :app.database.hugsql/data-source-read-only] 44 | :config {:read-only true}} 45 | 46 | :dev.env.system/db-changelog-mod-time nil 47 | 48 | :app.system.task/update-database-schema #::config{:config {:data-source (ig/ref ::data-source-read-write) 49 | :changelog-path "app/database/schema/changelog.xml" 50 | :dev/changelog-mod-time (ig/ref :dev.env.system/db-changelog-mod-time) 51 | :system-is-enabled true} 52 | :import {:system-is-enabled "Feature.DatabaseSchemaUpdate"}} 53 | 54 | :app.system.service/immutant-web #::config{:setup ::http-server-setup 55 | :webapps {:app.system.service/homepage-http-handler #::config{:config {:name "example"} 56 | :import {:hosts "Webapp.Hosts(example)"}}} 57 | :config {:options {:host "0.0.0.0"}} 58 | :import {:options {:host "HttpServer.Host" 59 | :port "HttpServer.Port"}} 60 | :awaits [:app.system.task/update-database-schema 61 | :app.system.service/mount]}}) 62 | 63 | (defn- system-config 64 | "Returns app system configuration." 65 | [] 66 | (config/build-config (config-template))) 67 | 68 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 69 | 70 | (defonce ^{:doc "Global reference to the running system" 71 | :private true} 72 | system! (atom nil)) 73 | 74 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 75 | 76 | (defn stop 77 | "Stop global system." 78 | [] 79 | (when-some [system @system!] 80 | (reset! system! nil) 81 | (ig'/halt! system) 82 | (logger/info (logger/get-logger *ns*) "[DONE] Application system stop"))) 83 | 84 | (defn suspend 85 | "Suspend global system." 86 | [] 87 | (some-> @system! (ig'/suspend!))) 88 | 89 | (defn start 90 | "Start global system." 91 | {:arglists '([] [{:keys [:system-keys :prepare-config]}])} 92 | ([] 93 | (start {})) 94 | ([options] 95 | (stop) 96 | (let [config ((:prepare-config options identity) (system-config))] 97 | (reset! system! (ig'/init config, (or (:system-keys options) (keys config))))) 98 | (logger/info (logger/get-logger *ns*) "[DONE] Application system start"))) 99 | 100 | (defn resume 101 | "Resume global system." 102 | {:arglists '([] [{:keys [:system-keys :prepare-config]}])} 103 | ([] 104 | (resume {})) 105 | ([options] 106 | (if-some [system @system!] 107 | (do 108 | (reset! system! nil) 109 | (let [config ((:prepare-config options identity) (system-config))] 110 | (reset! system! (ig'/resume config, system, (or (:system-keys options) (keys system)))))) 111 | (start options)))) 112 | 113 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 114 | 115 | (defn- log-running-webapps 116 | "Log info about running webapps (URLs with host/port)." 117 | [system] 118 | (let [webapps (some-> system :app.system.service/immutant-web meta :running-webapps)] 119 | (doseq [[webapp-name {:keys [host port ssl-port virtual-host]}] webapps 120 | webapp-host (cond (sequential? virtual-host) virtual-host 121 | (string? virtual-host) [virtual-host] 122 | :else [(or host "localhost")])] 123 | (logger/info (logger/get-logger *ns*) 124 | (print-str "Running webapp" (pr-str webapp-name) 125 | (str (when port (str "- http://" webapp-host ":" port "/"))) 126 | (str (when ssl-port (str "- https://" webapp-host ":" ssl-port "/")))))))) 127 | 128 | (defn- log-prop-files 129 | "Log info about loaded configuration files." 130 | [system] 131 | (let [prop-files (some-> system :app.system.service/app-config meta :prop-files)] 132 | (logger/info (logger/get-logger *ns*) (c/pr-str* "Running config from" prop-files)))) 133 | 134 | (add-watch system! :log-system-status 135 | (fn [_ _ _ system] 136 | (some-> system (doto (log-prop-files) 137 | (log-running-webapps))))) 138 | 139 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 140 | -------------------------------------------------------------------------------- /src/lib/clojure/assert.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure.assert 2 | "Helper macros for runtime assertion with min overhead and max clarity." 3 | (:refer-clojure :exclude [assert]) 4 | (:require [lib.clojure.lang :as lang])) 5 | 6 | (set! *warn-on-reflection* true) 7 | 8 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 9 | 10 | (defmulti ex-data-fn 11 | "Returns ex-data function by `id`." 12 | {:arglists '([id & args])} 13 | lang/first-arg) 14 | 15 | (defmethod ex-data-fn ::test 16 | [_ test] 17 | (fn [_throwable] {::test test})) 18 | 19 | (defmethod ex-data-fn ::value 20 | [_ value] 21 | (fn [_throwable] 22 | (cond-> {::value value} 23 | (and (some? value) 24 | (not (identical? value ::invalid))) (assoc ::type (type value))))) 25 | 26 | (defn exception 27 | "Returns assertion exception with message: 28 | `{message} - Assert failed: {form}` and ex-data from `(edf throwable)`. 29 | Arguments `message`, `edf` and `throwable` can be `nil`." 30 | [form message edf throwable] 31 | (-> (ex-info (str (some-> message (str " - ")) 32 | "Assert failed: " (cond-> form (nil? form) pr-str)) 33 | (-> (when edf (edf throwable)) 34 | (assoc ::failure :assertion-failed)) 35 | throwable) 36 | (#'clojure.core/elide-top-frames "lib.clojure.assert$exception"))) 37 | 38 | (def ^:const x* 39 | "The symbol representing evaluated `~x` in the [[assert-impl]] macro." 40 | 'x) 41 | 42 | (defmacro assert-impl 43 | "Evaluates `x` and `test`, catches exception and throws an exception if `test` 44 | does not evaluate to logical true or other exceptions were thrown. Evaluated 45 | `x` is available in implementing macros as `x*`, which is `::invalid` if 46 | evaluation failed. Returns `true` if assertion passed." 47 | [x test form message edf] 48 | `(if-let [{e# :throwable, ~x* :x, :or {~x* ::invalid}} 49 | (try (let [~x* ~x] (try (when-not ~test {:x ~x*}) 50 | (catch Throwable e# {:x ~x* :throwable e#}))) 51 | (catch Throwable e# {:throwable e#}))] 52 | (throw (exception ~form ~message ~edf e#)) 53 | true)) 54 | 55 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 56 | 57 | (defmacro assert 58 | "Evaluates expr and throws an exception if it does not evaluate to logical 59 | true. Similar to `clojure.core/assert` but with improved exception message and 60 | ex-data. Returns `true`. Attaches failed `::test` (`false` or `nil`) in 61 | ex-data." 62 | ([x] `(assert ~x nil)) 63 | ([x message] 64 | `(assert-impl ~x ~x* '(~'assert ~x) ~message (ex-data-fn ::test ~x*)))) 65 | 66 | (comment 67 | (macroexpand '(assert "1")) 68 | (macroexpand '(assert "1" "Message")) 69 | 70 | (assert (= 1 (inc 0))) 71 | #_true 72 | 73 | (assert (= 1 2)) 74 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert (= 1 2)) 75 | ;; #:lib.clojure.assert{:test false, :failure :assertion-failed} 76 | 77 | (assert (or false nil)) 78 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert (or false nil)) 79 | ;; #:lib.clojure.assert{:test nil, :failure :assertion-failed} 80 | 81 | (assert (or nil false)) 82 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert (or nil false)) 83 | ;; #:lib.clojure.assert{:test false, :failure :assertion-failed} 84 | 85 | (assert (= 1 2) "Require 1=2") 86 | ;;clojure.lang.ExceptionInfo: Require 1=2 - Assert failed: (assert (= 1 2)) 87 | ;; #:lib.clojure.assert{:test false, :failure :assertion-failed} 88 | 89 | (assert (/ 1 0)) 90 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert (/ 1 0)) 91 | ;; #:lib.clojure.assert{:test :lib.clojure.assert/invalid, :failure :assertion-failed} 92 | ;;java.lang.ArithmeticException: Divide by zero 93 | 94 | (try (assert (/ 1 0)) 95 | (catch Throwable e 96 | (lib.clojure-tools-logging.logger/log-throwable e nil))) 97 | ;;Assert failed: (assert (/ 1 0)) > Divide by zero $ #:lib.clojure.assert{:test :lib.clojure.assert/invalid, :failure :assertion-failed} 98 | ) 99 | 100 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 101 | 102 | (defmacro assert-pred 103 | "Evaluates `(pred x)` and throws an exception if it does not evaluate to 104 | logical true. Returns `true`. Attaches failed `::value` in ex-data." 105 | ([x pred] `(assert-pred ~x ~pred nil)) 106 | ([x pred message] 107 | `(assert-impl ~x (~pred ~x*) '(~'assert-pred ~x ~pred) ~message (ex-data-fn ::value ~x*)))) 108 | 109 | (comment 110 | (macroexpand '(assert-pred "1" string?)) 111 | (macroexpand '(assert-pred "1" string? "Message")) 112 | 113 | (assert-pred "1" string?) 114 | #_true 115 | 116 | (assert-pred (inc 0) string?) 117 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert-pred (inc 0) string?) 118 | ;; #:lib.clojure.assert{:value 1, :type java.lang.Long, :failure :assertion-failed} 119 | 120 | (assert-pred nil string?) 121 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert-pred nil string?) 122 | ;; #:lib.clojure.assert{:value nil, :failure :assertion-failed} 123 | 124 | (assert-pred "" number?) 125 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert-pred "" number?) 126 | ;; #:lib.clojure.assert{:value "", :type java.lang.String, :failure :assertion-failed} 127 | 128 | (assert-pred (inc 0) string? "Require string") 129 | ;;clojure.lang.ExceptionInfo: Require string - Assert failed: (assert-pred (inc 0) string?) 130 | ;; #:lib.clojure.assert{:value 1, :type java.lang.Long, :failure :assertion-failed} 131 | 132 | (assert-pred (inc 0) string? ["Require string"]) 133 | ;;clojure.lang.ExceptionInfo: ["Require string"] - Assert failed: (assert-pred (inc 0) string?) 134 | ;; #:lib.clojure.assert{:value 1, :type java.lang.Long, :failure :assertion-failed} 135 | 136 | (assert-pred 1 first) 137 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert-pred 1 first) 138 | ;; #:lib.clojure.assert{:value 1, :type java.lang.Long, :failure :assertion-failed} 139 | ;;java.lang.IllegalArgumentException: Don't know how to create ISeq from: java.lang.Long 140 | 141 | (try (assert-pred 1 first) 142 | (catch Throwable e 143 | (lib.clojure-tools-logging.logger/log-throwable e nil))) 144 | ;;Assert failed: (assert-pred 1 first) > Don't know how to create ISeq from: java.lang.Long $ #:lib.clojure.assert{:value 1, :type java.lang.Long, :failure :assertion-failed} 145 | 146 | (assert-pred (/ 1 0) double?) 147 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert-pred (/ 1 0) double?) 148 | ;; #:lib.clojure.assert{:value :lib.clojure.assert/invalid, :failure :assertion-failed} 149 | ;;java.lang.ArithmeticException: Divide by zero 150 | ) 151 | 152 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 153 | 154 | (defmacro assert-try 155 | "Evaluates `(f x)` and fails assertion if `(f x)` throws exception. Returns 156 | `true`. Attaches failed `::value` in ex-data." 157 | ([x f] `(assert-try ~x ~f nil)) 158 | ([x f message] 159 | `(assert-impl ~x (do (~f ~x*) true) '(~'assert-try ~x ~f) ~message (ex-data-fn ::value ~x*)))) 160 | 161 | (comment 162 | (macroexpand '(assert-try 10 test-fn)) 163 | 164 | (assert-try 10 identity) 165 | #_true 166 | 167 | (defn test-fn [x] (throw (ex-info "Oops" {:test/x x}))) 168 | 169 | (assert-try 10 test-fn) 170 | ;;clojure.lang.ExceptionInfo: Assert failed: (assert-try 10 test-fn) 171 | ;; #:lib.clojure.assert{:value 10, :type java.lang.Long, :failure :assertion-failed} 172 | ;;clojure.lang.ExceptionInfo: Oops 173 | ;; #:test{:x 10} 174 | 175 | (assert-try 10 test-fn "Message") 176 | ;;clojure.lang.ExceptionInfo: Message - Assert failed: (assert-try 10 test-fn) 177 | ;; #:lib.clojure.assert{:value 10, :type java.lang.Long, :failure :assertion-failed} 178 | ;;clojure.lang.ExceptionInfo: Oops 179 | ;; #:test{:x 10} 180 | 181 | (try (assert-try 10 test-fn "Message") 182 | (catch Throwable e 183 | (lib.clojure-tools-logging.logger/log-throwable e nil) 184 | (throw e))) 185 | ;;Message - Assert failed: (assert-try 10 test-fn) > Oops $ #:lib.clojure.assert{:value 10, :type java.lang.Long, :failure :assertion-failed} $ #:test{:x 10} 186 | 187 | (try (assert-try (/ 1 0) test-fn "Message") 188 | (catch Throwable e 189 | (lib.clojure-tools-logging.logger/log-throwable e nil) 190 | (throw e))) 191 | ;;Message - Assert failed: (assert-try (/ 1 0) test-fn) > Divide by zero $ #:lib.clojure.assert{:value :lib.clojure.assert/invalid, :failure :assertion-failed} 192 | ) 193 | 194 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 195 | -------------------------------------------------------------------------------- /src/lib/clojure_string/core.clj: -------------------------------------------------------------------------------- 1 | (ns lib.clojure-string.core 2 | "Extension of `clojure.string`. Similar to cuerdas, superstring etc." 3 | (:refer-clojure :exclude [concat empty? not-empty replace]) 4 | (:require [clojure.string :as string] 5 | [clojure.test :as test]) 6 | (:import (org.apache.commons.lang3 StringUtils))) 7 | 8 | (set! *warn-on-reflection* true) 9 | (set! *unchecked-math* :warn-on-boxed) 10 | 11 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 12 | 13 | (test/with-test 14 | 15 | (defn empty? 16 | "True if string `s` is nil or has zero length." 17 | [s] 18 | (StringUtils/isEmpty s)) 19 | 20 | (test/are [expr result] (= result expr) 21 | (empty? nil) #_=> true 22 | (empty? ""), #_=> true 23 | (empty? "-") #_=> false)) 24 | 25 | (test/with-test 26 | 27 | (defn not-empty 28 | "If `s` is empty, returns nil, else `s`." 29 | [s] 30 | (when-not (empty? s) s)) 31 | 32 | (test/are [expr result] (= result expr) 33 | (not-empty nil) #_=> nil 34 | (not-empty ""), #_=> nil 35 | (not-empty "-") #_=> "-")) 36 | 37 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 38 | 39 | (test/with-test 40 | 41 | (defn concat 42 | "Concatenates strings using native `.concat`. 43 | Works with strings only." 44 | {:tag String} 45 | ([a b] (if a (if b (.concat ^String a b), a) 46 | (or b nil))) 47 | ([a b c] (-> a (concat b) (concat c))) 48 | ([a b c d] (-> a (concat b) (concat c) (concat d))) 49 | ([a b c d e] (-> a (concat b) (concat c) (concat d) (concat e)))) 50 | 51 | (test/are [expr result] (= result expr) 52 | (concat "0123456789", "ABCDE"),,,,,,,, #_=> "0123456789ABCDE" 53 | (concat "0123456789", nil),,,,,,,,,,,, #_=> "0123456789" 54 | (concat nil,,,,,,,,,, "ABCDE"),,,,,,,, #_=> "ABCDE" 55 | (concat "A",,,,,,,,,, "B" "C" "D" "E") #_=> "ABCDE" 56 | (concat nil,,,,,,,,,, nil),,,,,,,,,,,, #_=> nil)) 57 | 58 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 59 | 60 | (defn join-not-empty 61 | "Similar to `clojure.core/join` but skipping elements which produce empty output." 62 | [sep coll] 63 | (string/join sep (keep (comp not-empty str) coll))) 64 | 65 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 66 | 67 | (defn char-digit? 68 | "True if char `c` is digit." 69 | [c] 70 | (Character/isDigit ^Character c)) 71 | 72 | (defn char-whitespace? 73 | "True if `c` is whitespace character." 74 | [c] 75 | (Character/isWhitespace ^Character c)) 76 | 77 | (defn char-not= 78 | "Builds predicate for char non-equality." 79 | [c] 80 | #(if (.equals ^Character c %) false true)) 81 | 82 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 83 | 84 | (test/with-test 85 | 86 | (defn only-chars? 87 | "True if `s` contains only chars satisfying `pred`. False when `s` is empty." 88 | [^CharSequence s, pred] 89 | (if (empty? s) 90 | false 91 | (let [len (.length s)] 92 | (loop [index 0] 93 | (if (= len index) 94 | true 95 | (if (pred (.charAt s (unchecked-int index))) 96 | (recur (unchecked-inc index)) 97 | false)))))) 98 | 99 | (test/are [expr result] (= result expr) 100 | (only-chars? nil,,, char-digit?) #_=> false 101 | (only-chars? "",,,, char-digit?) #_=> false 102 | (only-chars? "---", char-digit?) #_=> false 103 | (only-chars? "123", char-digit?) #_=> true)) 104 | 105 | (test/with-test 106 | 107 | (defn numeric? 108 | "True if `s` contains only digits." 109 | [s] 110 | (StringUtils/isNumeric s)) 111 | 112 | (test/are [expr result] (= result expr) 113 | (numeric? "1234567890"), #_=> true 114 | (numeric? "1234567890x") #_=> false 115 | (numeric? nil),,,,,,,,,, #_=> false 116 | (numeric? ""),,,,,,,,,,, #_=> false)) 117 | 118 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 119 | 120 | (test/with-test 121 | 122 | (defn strip-start 123 | "Strips any of a set of characters from the start of a String. 124 | A `nil` input String returns `nil`. 125 | An empty string (\"\") input returns the empty string. 126 | Strips whitespaces if the string `strip-chars` is not specified." 127 | {:tag String} 128 | ([s] (StringUtils/stripStart s nil)) 129 | ([s, strip-chars] (StringUtils/stripStart s strip-chars))) 130 | 131 | (test/are [expr result] (= result expr) 132 | (strip-start "test",,,, " "),, #_=> "test" 133 | (strip-start " test", " "),, #_=> "test" 134 | (strip-start " te ", " "),, #_=> "te " 135 | (strip-start " test"),,,,,,, #_=> "test" 136 | (strip-start "///test", "/"),, #_=> "test" 137 | (strip-start "☺☺☺test", "☺"),, #_=> "test" 138 | (strip-start "/?☺test", "/?☺") #_=> "test" 139 | (strip-start nil "/"),,,,,,,,, #_=> nil)) 140 | 141 | (test/with-test 142 | 143 | (defn strip-end 144 | "Strips any of a set of characters from the end of a String. 145 | A `nil` input String returns `nil`. 146 | An empty string (\"\") input returns the empty string. 147 | Strips whitespaces if the string `strip-chars` is not specified." 148 | {:tag String} 149 | ([s] (StringUtils/stripEnd s nil)) 150 | ([s, strip-chars] (StringUtils/stripEnd s strip-chars))) 151 | 152 | (test/are [expr result] (= result expr) 153 | (strip-end "test",,,, " "),, #_=> "test" 154 | (strip-end "test ", " "),, #_=> "test" 155 | (strip-end " st ", " "),, #_=> " st" 156 | (strip-end "test "),,,,,,, #_=> "test" 157 | (strip-end "test///", "/"),, #_=> "test" 158 | (strip-end "test☺☺☺", "☺"),, #_=> "test" 159 | (strip-end "test/?☺", "/?☺") #_=> "test" 160 | (strip-end nil "/"),,,,,,,,, #_=> nil)) 161 | 162 | (test/with-test 163 | 164 | (defn drop-start 165 | "Removes chars from the left side of string by `pred`. 166 | The `pred` is a predicate function for chars to be removed." 167 | {:tag String} 168 | [^CharSequence s, pred] 169 | (when s 170 | (let [len (.length s)] 171 | (loop [index 0] 172 | (if (= len index) 173 | "" 174 | (if (pred (.charAt s (unchecked-int index))) 175 | (recur (unchecked-inc index)) 176 | (.toString (.subSequence s (unchecked-int index) len)))))))) 177 | 178 | (test/are [expr result] (= result expr) 179 | (drop-start "test",,,, char-whitespace?) #_=> "test" #_" 7 ns" 180 | (drop-start " test", char-whitespace?) #_=> "test" #_"30 ns" 181 | (drop-start " test", (char-not= \t)),, #_=> "test" 182 | (drop-start nil,,,,,,, char-whitespace?) #_=> nil)) 183 | 184 | (test/with-test 185 | 186 | (defn drop-end 187 | "Removes chars from the right side of string by `pred`. 188 | The `pred` is a predicate function for chars to be removed." 189 | {:tag String} 190 | [^CharSequence s, pred] 191 | (when s 192 | (loop [index (.length s)] 193 | (if (zero? index) 194 | "" 195 | (if (pred (.charAt s (unchecked-int (unchecked-dec index)))) 196 | (recur (unchecked-dec index)) 197 | (.toString (.subSequence s (unchecked-int 0) (unchecked-int index)))))))) 198 | 199 | (test/are [expr result] (= result expr) 200 | (drop-end "test",,,, char-whitespace?) #_=> "test" 201 | (drop-end "test ", char-whitespace?) #_=> "test" 202 | (drop-end "test ", (char-not= \t)),, #_=> "test" 203 | (drop-end nil,,,,,,, char-whitespace?) #_=> nil)) 204 | 205 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 206 | 207 | (test/with-test 208 | 209 | (defn take-before 210 | "Gets the substring before the first occurrence of a separator." 211 | {:tag String} 212 | [s separator] 213 | (StringUtils/substringBefore ^String s ^String separator)) 214 | 215 | (test/are [expr result] (= result expr) 216 | (take-before "test,string",,,,,,,,,, ","),,, #_=> "test" 217 | (take-before "test::string::string", "::"),, #_=> "test" 218 | (take-before "test",,,,,,,,,,,,,,,,, "::"),, #_=> "test" 219 | (take-before "test",,,,,,,,,,,,,,,,, nil),,, #_=> "test" 220 | (take-before "test",,,,,,,,,,,,,,,,, ""),,,, #_=> "" 221 | (take-before "test",,,,,,,,,,,,,,,,, "test") #_=> "" 222 | (take-before "test",,,,,,,,,,,,,,,,, "t"),,, #_=> "" 223 | (take-before nil,,,,,,,,,,,,,,,,,,,, nil),,, #_=> nil)) 224 | 225 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 226 | 227 | (test/with-test 228 | 229 | (defn surround 230 | "Surrounds string `s` with `x` or `left`/`right`." 231 | {:tag String} 232 | ([s x] (.concat (.concat ^String x (str s)) x)) 233 | ([s left right] (.concat (.concat ^String left (str s)) right))) 234 | 235 | (test/are [expr result] (= result expr) 236 | (surround nil, "'"),,,,, #_=> "''" 237 | (surround "",, "'"),,,,, #_=> "''" 238 | (surround "s", "'"),,,,, #_=> "'s'" 239 | (surround 0,,, "'"),,,,, #_=> "'0'" 240 | (surround nil, "(", ")") #_=> "()" 241 | (surround "",, "(", ")") #_=> "()" 242 | (surround "s", "(", ")") #_=> "(s)" 243 | (surround 0,,, "(", ")") #_=> "(0)")) 244 | 245 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 246 | 247 | (test/with-test 248 | 249 | (defn truncate 250 | "Truncates string `s` to the length `len`. 251 | Appends `suffix` at the end if specified." 252 | {:tag String} 253 | ([^Object s, ^long len] 254 | (when-some [^String s (some-> s .toString)] 255 | (if (< len (.length s)) 256 | (.substring s (unchecked-int 0) (unchecked-int len)) 257 | s))) 258 | ([^Object s, ^long len, suffix] 259 | (when-some [^String s (some-> s .toString)] 260 | (if (< len (.length s)) 261 | (.concat (.substring s (unchecked-int 0) (unchecked-int len)) suffix) 262 | s)))) 263 | 264 | (test/are [expr result] (= result expr) 265 | (truncate "1234567890", 5),,,,,,, #_=> "12345",,, #_"12 ns" 266 | (truncate "1234567890", 5, "...") #_=> "12345..." #_"24 ns" 267 | (truncate "12345",,,,,, 5),,,,,,, #_=> "12345" 268 | (truncate "12345",,,,,, 5, "...") #_=> "12345" 269 | (truncate "",,,,,,,,,,, 5),,,,,,, #_=> "" 270 | (truncate "",,,,,,,,,,, 5, "...") #_=> "" 271 | (truncate nil,,,,,,,,,, 5),,,,,,, #_=> nil 272 | (truncate "12345",,,,,, 0),,,,,,, #_=> "" 273 | (truncate '(1 2 3 4 5), 5, "...") #_=> "(1 2 ...")) 274 | 275 | ;;•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• 276 | --------------------------------------------------------------------------------