├── .clj-kondo └── imports │ ├── com.github.seancorfield │ └── next.jdbc │ │ ├── config.edn │ │ └── hooks │ │ └── com │ │ └── github │ │ └── seancorfield │ │ └── next_jdbc.clj_kondo │ ├── hiccup │ └── hiccup │ │ ├── config.edn │ │ └── hiccup │ │ └── hooks.clj │ ├── http-kit │ └── http-kit │ │ ├── config.edn │ │ └── httpkit │ │ └── with_channel.clj │ ├── metosin │ └── malli │ │ └── config.edn │ └── rewrite-clj │ └── rewrite-clj │ └── config.edn ├── .gitignore ├── .lsp └── config.edn ├── LICENSE ├── README.md ├── bin └── run_cmd.sh ├── build └── build.clj ├── cljfmt.edn ├── deps.edn ├── dev └── user.clj ├── doc └── multiproject-multiple-repl-contexts.png ├── parts ├── .clj-kondo │ └── imports │ │ ├── com.github.seancorfield │ │ └── next.jdbc │ │ │ ├── config.edn │ │ │ └── hooks │ │ │ └── com │ │ │ └── github │ │ │ └── seancorfield │ │ │ └── next_jdbc.clj_kondo │ │ ├── hiccup │ │ └── hiccup │ │ │ ├── config.edn │ │ │ └── hiccup │ │ │ └── hooks.clj │ │ └── metosin │ │ └── malli │ │ └── config.edn ├── .gitignore ├── deps.edn ├── dev │ └── com │ │ └── adityaathalye │ │ └── grugstack │ │ └── utilities │ │ └── integrant_repl.clj ├── resources │ └── sqlite-extensions │ │ ├── csv │ │ └── csv.c ├── src │ └── com │ │ └── adityaathalye │ │ └── grugstack │ │ ├── settings │ │ ├── core.clj │ │ └── defaults.edn │ │ ├── system │ │ ├── application.clj │ │ ├── core.clj │ │ ├── db │ │ │ ├── primary │ │ │ │ └── sqlite.clj │ │ │ ├── sessions │ │ │ │ └── sqlite.clj │ │ │ └── sqlite.clj │ │ ├── runtime.clj │ │ ├── server.clj │ │ └── server_simple.clj │ │ └── utilities │ │ ├── databases │ │ └── core.clj │ │ └── layouts │ │ └── handlers.clj └── test │ └── com │ └── adityaathalye │ └── grugstack │ └── settings │ └── core_test.clj ├── projects ├── acmecorp │ └── snafuapp │ │ ├── .gitignore │ │ ├── deps.edn │ │ ├── resources │ │ └── public │ │ │ ├── css │ │ │ └── style.css │ │ │ └── img │ │ │ └── favicon.ico │ │ ├── src │ │ └── com │ │ │ └── acmecorp │ │ │ └── snafuapp │ │ │ ├── core.clj │ │ │ ├── db │ │ │ ├── migrations.clj │ │ │ ├── model.sql │ │ │ ├── pragmas.sql │ │ │ └── utils.clj │ │ │ ├── handlers │ │ │ ├── common.clj │ │ │ └── core.clj │ │ │ ├── layouts │ │ │ └── default.clj │ │ │ ├── middleware │ │ │ └── core.clj │ │ │ └── settings.edn │ │ └── test │ │ └── com │ │ └── acmecorp │ │ └── snafuapp │ │ └── core_test.clj ├── example_app │ ├── .gitignore │ ├── deps.edn │ ├── src │ │ └── com │ │ │ └── example │ │ │ ├── core.clj │ │ │ ├── db │ │ │ └── core.clj │ │ │ └── settings.edn │ └── test │ │ └── com │ │ └── example │ │ └── core_test.clj ├── fnconf2025 │ ├── catchall │ │ ├── .gitignore │ │ ├── deps.edn │ │ └── src │ │ │ └── org │ │ │ └── evalapply │ │ │ └── catchall_app.clj │ ├── nullproject │ │ ├── .gitignore │ │ ├── deps.edn │ │ └── src │ │ │ └── app.clj │ └── smolwebapp │ │ ├── .gitignore │ │ ├── CHANGELOG.md │ │ ├── LICENSE │ │ ├── README.md │ │ ├── build.clj │ │ ├── deps.edn │ │ ├── doc │ │ └── intro.md │ │ ├── resources │ │ └── .keep │ │ ├── src │ │ └── org │ │ │ └── evalapply │ │ │ ├── router │ │ │ └── core.clj │ │ │ └── smol_web_app.clj │ │ └── test │ │ └── org │ │ └── evalapply │ │ ├── router │ │ └── core_test.clj │ │ └── smol_web_app_test.clj └── usermanager-first-principles │ ├── .clj-kondo │ └── imports │ │ ├── com.github.seancorfield │ │ └── next.jdbc │ │ │ ├── config.edn │ │ │ └── hooks │ │ │ └── com │ │ │ └── github │ │ │ └── seancorfield │ │ │ └── next_jdbc.clj_kondo │ │ └── hiccup │ │ └── hiccup │ │ ├── config.edn │ │ └── hiccup │ │ └── hooks.clj │ ├── .gitignore │ ├── CHANGELOG.md │ ├── LICENSE │ ├── README.md │ ├── build.clj │ ├── deps.edn │ ├── doc │ └── intro.md │ ├── resources │ ├── .keep │ └── public │ │ └── assets │ │ └── css │ │ └── style.css │ ├── src │ └── usermanager │ │ ├── handlers │ │ └── user.clj │ │ ├── http │ │ ├── middleware.clj │ │ └── utils.clj │ │ ├── layouts │ │ └── core.clj │ │ ├── main.clj │ │ ├── model │ │ └── user_manager.clj │ │ ├── router │ │ └── core.clj │ │ ├── settings.edn │ │ └── system │ │ └── core.clj │ └── test │ └── usermanager │ ├── handlers │ └── user_test.clj │ ├── http │ └── middleware_test.clj │ ├── main_grug_test.clj │ ├── main_test.clj │ ├── model │ ├── user_manager_grug_test.clj │ └── user_manager_test.clj │ ├── router │ ├── core_grug_test.clj │ └── core_test.clj │ └── test_utilities.clj ├── resources └── .keep ├── src └── core.clj └── test └── core_test.clj /.clj-kondo/imports/com.github.seancorfield/next.jdbc/config.edn: -------------------------------------------------------------------------------- 1 | {:hooks 2 | {:analyze-call 3 | {next.jdbc/with-transaction 4 | hooks.com.github.seancorfield.next-jdbc/with-transaction 5 | next.jdbc/with-transaction+options 6 | hooks.com.github.seancorfield.next-jdbc/with-transaction+options}} 7 | :lint-as {next.jdbc/on-connection clojure.core/with-open 8 | next.jdbc/on-connection+options clojure.core/with-open}} 9 | -------------------------------------------------------------------------------- /.clj-kondo/imports/com.github.seancorfield/next.jdbc/hooks/com/github/seancorfield/next_jdbc.clj_kondo: -------------------------------------------------------------------------------- 1 | (ns hooks.com.github.seancorfield.next-jdbc 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn with-transaction 5 | "Expands (with-transaction [tx expr opts] body) 6 | to (let [tx expr] opts body) per clj-kondo examples." 7 | [{:keys [:node]}] 8 | (let [[binding-vec & body] (rest (:children node)) 9 | [sym val opts] (:children binding-vec)] 10 | (when-not (and sym val) 11 | (throw (ex-info "No sym and val provided" {}))) 12 | (let [new-node (api/list-node 13 | (list* 14 | (api/token-node 'let) 15 | (api/vector-node [sym val]) 16 | opts 17 | body))] 18 | {:node new-node}))) 19 | 20 | (defn with-transaction+options 21 | "Expands (with-transaction+options [tx expr opts] body) 22 | to (let [tx expr] opts body) per clj-kondo examples." 23 | [{:keys [:node]}] 24 | (let [[binding-vec & body] (rest (:children node)) 25 | [sym val opts] (:children binding-vec)] 26 | (when-not (and sym val) 27 | (throw (ex-info "No sym and val provided" {}))) 28 | (let [new-node (api/list-node 29 | (list* 30 | (api/token-node 'let) 31 | (api/vector-node [sym val]) 32 | opts 33 | body))] 34 | {:node new-node}))) 35 | -------------------------------------------------------------------------------- /.clj-kondo/imports/hiccup/hiccup/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {hiccup.def/defhtml clojure.core/defn} 2 | :hooks {:analyze-call {hiccup.def/defelem hiccup.hooks/defelem}}} 3 | -------------------------------------------------------------------------------- /.clj-kondo/imports/hiccup/hiccup/hiccup/hooks.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.hooks 2 | (:require [clj-kondo.hooks-api :as api] 3 | [clojure.set :as set])) 4 | 5 | ;; See https://github.com/clj-kondo/clj-kondo/blob/master/doc/hooks.md 6 | 7 | (defn- parse-defn [elems] 8 | (let [[fhead fbody] (split-with #(not (or (api/vector-node? %) 9 | (api/list-node? %))) 10 | elems) 11 | arities (if (api/vector-node? (first fbody)) 12 | (list (api/list-node fbody)) 13 | fbody)] 14 | [fhead arities])) 15 | 16 | (defn- count-args [arity] 17 | (let [args (first (api/sexpr arity))] 18 | (if (= '& (fnext (reverse args))) 19 | true ; unbounded args 20 | (count args)))) 21 | 22 | (defn- dummy-arity [arg-count] 23 | (api/list-node 24 | (list 25 | (api/vector-node 26 | (vec (repeat arg-count (api/token-node '_))))))) 27 | 28 | (defn defelem [{:keys [node]}] 29 | (let [[_ & rest] (:children node) 30 | [fhead arities] (parse-defn rest) 31 | arg-counts (set (filter number? (map count-args arities))) 32 | dummy-arg-counts (set/difference (set (map inc arg-counts)) arg-counts) 33 | dummy-arities (for [n dummy-arg-counts] (dummy-arity n))] 34 | {:node 35 | (api/list-node 36 | (list* 37 | (api/token-node 'clojure.core/defn) 38 | (concat fhead arities dummy-arities)))})) 39 | -------------------------------------------------------------------------------- /.clj-kondo/imports/http-kit/http-kit/config.edn: -------------------------------------------------------------------------------- 1 | 2 | {:hooks 3 | {:analyze-call {org.httpkit.server/with-channel httpkit.with-channel/with-channel}}} 4 | -------------------------------------------------------------------------------- /.clj-kondo/imports/http-kit/http-kit/httpkit/with_channel.clj: -------------------------------------------------------------------------------- 1 | (ns httpkit.with-channel 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn with-channel [{node :node}] 5 | (let [[request channel & body] (rest (:children node))] 6 | (when-not (and request channel) (throw (ex-info "No request or channel provided" {}))) 7 | (when-not (api/token-node? channel) (throw (ex-info "Missing channel argument" {}))) 8 | (let [new-node 9 | (api/list-node 10 | (list* 11 | (api/token-node 'let) 12 | (api/vector-node [channel (api/vector-node [])]) 13 | request 14 | body))] 15 | 16 | {:node new-node}))) 17 | -------------------------------------------------------------------------------- /.clj-kondo/imports/metosin/malli/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {malli.experimental/defn schema.core/defn} 2 | :linters {:unresolved-symbol {:exclude [(malli.core/=>)]}}} 3 | -------------------------------------------------------------------------------- /.clj-kondo/imports/rewrite-clj/rewrite-clj/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as 2 | {rewrite-clj.zip/subedit-> clojure.core/-> 3 | rewrite-clj.zip/subedit->> clojure.core/->> 4 | rewrite-clj.zip/edit-> clojure.core/-> 5 | rewrite-clj.zip/edit->> clojure.core/->>}} 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .calva/output-window/ 2 | .calva/repl.calva-repl 3 | .classpath 4 | .clj-kondo/.cache 5 | */.clj-kondo/.cache 6 | */*/.clj-kondo/.cache 7 | .cpcache 8 | .eastwood 9 | .factorypath 10 | .hg/ 11 | .hgignore 12 | .java-version 13 | .lein-* 14 | .lsp/.cache 15 | */.lsp/.cache 16 | */*/.lsp/.cache 17 | .lsp/sqlite.db 18 | .m2-local 19 | .nrepl-history 20 | .nrepl-port 21 | .portal/vs-code.edn 22 | .project 23 | .rebel_readline_history 24 | .settings 25 | .socket-repl-port 26 | .sw* 27 | .vscode 28 | *.class 29 | *.jar 30 | *.swp 31 | *~ 32 | /checkouts 33 | /classes 34 | /target 35 | /target/* 36 | /doc/*.pdf 37 | /doc/*.webm 38 | /data 39 | /db 40 | *.sqlite3 41 | -------------------------------------------------------------------------------- /.lsp/config.edn: -------------------------------------------------------------------------------- 1 | {:project-specs [{:project-path "deps.edn" 2 | :classpath-cmd ["clojure" "-A:root/all:root/dev:root/test:root/build" "-Spath"]}]} 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Version N/A 4 | 5 | SPDX short identifier: MIT 6 | 7 | Retrieved from https://opensource.org/licenses/MIT 8 | 9 | Retrieved on Monday, 06 January 2025, 1522hrs IST. 10 | 11 | Copyright (c) 2005 Aditya Athalye (adityaathalye.com, evalapply.org). 12 | 13 | Permission is hereby granted, free of charge, to any person obtaining 14 | a copy of this software and associated documentation files (the 15 | “Software”), to deal in the Software without restriction, including 16 | without limitation the rights to use, copy, modify, merge, publish, 17 | distribute, sublicense, and/or sell copies of the Software, and to 18 | permit persons to whom the Software is furnished to do so, subject to 19 | the following conditions: 20 | 21 | The above copyright notice and this permission notice shall be 22 | included in all copies or substantial portions of the Software. 23 | 24 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, 25 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 26 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 27 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 28 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 29 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 30 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 31 | -------------------------------------------------------------------------------- /bin/run_cmd.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | this_helper_script_path="$(realpath ${0})" 3 | multiproject_root="$(dirname $(dirname this_helper_script_path))" 4 | 5 | declare -a multiproject_commands=( $(sed -E -ne "s/(^run_+.*)\(\)\s+\{/\1/p" "${this_helper_script_path}" ) ) 6 | 7 | # Copy all project deps to clipboard 8 | # clj -X:deps aliases | 9 | # sed -E -n -e "s/\:([[:alnum:][:punct:]]+)\s+.*project.*/\1/p" | 10 | # xargs -I{} printf "\"%s\" " {} | 11 | # xclip -sel clipboard 12 | declare -a multiproject_all_toplevel_aliases=( 13 | "cider" "grugstack" \ 14 | "com.acmecorp.snafuapp.core" "com.example.core" "usermanager.main" \ 15 | "org.evalapply.smol-web-app" \ 16 | "root/all" "root/build" "root/dev" "root/run-x" "root/test" 17 | ) 18 | 19 | declare -a multiproject_app_aliases=( 20 | "grugstack" "com.acmecorp.snafuapp.core" "com.example.core" \ 21 | "usermanager.main" "org.evalapply.smol-web-app" 22 | ) 23 | 24 | main() { 25 | local command_chosen=${1:-""} 26 | local alias_chosen=${2:-""} 27 | 28 | # Choose command to run 29 | if [ -z $command_chosen ] 30 | then 31 | cat <src-dirs 61 | [{:keys [libs argmap] :as _basis}] 62 | (let [lib-names (-> argmap :extra-deps keys)] 63 | (mapcat #(get-in libs [% :paths]) 64 | lib-names))) 65 | 66 | (defn uber-file-name 67 | [target-dir app-name git-sha timestamp] 68 | (format "%s/%s-%s-%s.jar" 69 | target-dir 70 | app-name 71 | git-sha 72 | timestamp)) 73 | 74 | (comment 75 | (mapv #(get-in (create-app-basis {:app-alias :com.acmecorp.snafuapp.snafuapp}) 76 | %) 77 | [[:argmap] 78 | [:libs 'acmecorp/snafuapp :paths] 79 | [:libs 'parts/grugstack :paths]])) 80 | 81 | (defn make-opts 82 | [{:keys [app-alias ns-compile] 83 | :or {app-alias :com.example.core} 84 | :as opts}] 85 | (let [basis (create-app-basis opts) 86 | app-alias (name app-alias) 87 | target-dir (format "target/%s" app-alias) 88 | class-dir (format "%s/classes" target-dir)] 89 | (assoc opts 90 | :uber-file (uber-file-name target-dir 91 | app-alias 92 | (git-short-hash) 93 | (timestamp)) 94 | :basis basis 95 | :lib (symbol app-alias) 96 | :main (symbol app-alias) 97 | :ns-compile (mapv symbol 98 | (if (empty? ns-compile) 99 | [app-alias] ns-compile)) 100 | :target-dir target-dir 101 | :class-dir class-dir 102 | :src-dirs (basis->src-dirs basis)))) 103 | 104 | (defn test "Run all the tests." 105 | [opts] 106 | (println "TESTING with input opts" opts) 107 | (let [opts (-> opts 108 | (assoc :aliases [:root/all :root/test]) 109 | make-opts) 110 | test-dirs (interleave (repeat "--dir") 111 | (get-in opts [:basis :argmap :exec-args :dirs])) 112 | _ (println "TEST DIRS " test-dirs) 113 | cmds (b/java-command 114 | {:basis (:basis opts) 115 | :main 'clojure.main 116 | :main-args (into ["-m" "cognitect.test-runner"] test-dirs)}) 117 | {:keys [exit]} (b/process cmds)] 118 | (when-not (zero? exit) (throw (ex-info "Tests failed" {}))) 119 | opts)) 120 | 121 | (defn uberjar 122 | [opts] 123 | (let [{:keys [src-dirs target-dir main] 124 | :as opts} (make-opts opts)] 125 | (println "\nBuilding uberjar with opts: " (dissoc opts :basis)) 126 | (println "\nCleaning this build's target directory..." target-dir) 127 | (b/delete {:path target-dir}) 128 | (println "\nCopying source to target..." {:src-dirs src-dirs :target-dir target-dir}) 129 | (b/copy-dir {:src-dirs src-dirs 130 | :target-dir target-dir}) 131 | (println (str "\nCompiling " main "...")) 132 | (b/compile-clj opts) 133 | (let [uber-opts (select-keys opts 134 | [:class-dir :uber-file :basis :main])] 135 | (println "\nBuilding JAR... with uber-opts:" (dissoc uber-opts :basis)) 136 | (b/uber uber-opts)) 137 | opts)) 138 | 139 | (defn ci "Run the CI pipeline of tests (and build the uberjar)." 140 | [opts] 141 | (test opts) 142 | (uberjar opts) 143 | opts) 144 | 145 | (defn debug-echo-opts-map 146 | [{:keys [a b] 147 | :or {a 1 b 2} 148 | :as opts}] 149 | (println (assoc opts)) 150 | opts) 151 | 152 | (comment 153 | 154 | (map (comp sort keys b/create-basis) [{:aliases [:foo]} 155 | {:aliases [:grugstack]} 156 | {:aliases [:grugstack 157 | :root/dev 158 | :root/test 159 | :root/run-x]}]) 160 | (tap> (b/create-basis {:aliases []})) 161 | 162 | (tap> (b/create-basis {:aliases [:root/build]})) 163 | 164 | (tap> (b/create-basis {:aliases [:grugstack :grugalias/foo]})) 165 | 166 | (tap> (b/create-basis {:aliases [:grugstack 167 | :root/dev 168 | :root/test 169 | :root/run-x]}))) 170 | -------------------------------------------------------------------------------- /cljfmt.edn: -------------------------------------------------------------------------------- 1 | {:parallel? true 2 | :paths ["src" "test" "build" "dev" "projects" "parts"]} 3 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojure {:mvn/version "1.12.0"}} 2 | :mvn/local-repo ".m2-local" 3 | :aliases {;; GLOBAL OVERRIDES 4 | :cider {;; clj -M:dev:cider 5 | :extra-deps {cider/cider-nrepl {:mvn/version "0.51.1"} 6 | refactor-nrepl/refactor-nrepl {:mvn/version "3.10.0"}} 7 | :main-opts ["-m" "nrepl.cmdline" 8 | "--middleware" 9 | "[cider.nrepl/cider-middleware,refactor-nrepl.middleware/wrap-refactor]" 10 | "--repl-fn" "user/run-repl" 11 | "--interactive"]} 12 | 13 | ;; ALL SETTINGS CONSOLIDATED AT THE ROOT OF THE MULTIPROJECT 14 | :root/run-x {:exec-fn -main} 15 | :root/extra-paths [:parts/extra-paths 16 | :com.example.core/extra-paths 17 | :com.acmecorp.snafuapp.core/extra-paths 18 | :usermanager.main/extra-paths 19 | :org.evalapply.smol-web-app/extra-paths] 20 | :root/all {:extra-paths ["src" "resources" 21 | :root/extra-paths] 22 | :extra-deps {parts/grugstack 23 | {:local/root "parts"} 24 | clj-http/clj-http {:mvn/version "3.12.3"}}} 25 | :root/dev {:extra-paths ["dev"] 26 | :extra-deps {metosin/reitit-dev {:mvn/version "0.7.2"} 27 | integrant/repl {:mvn/version "0.3.3"} 28 | dev.weavejester/cljfmt {:mvn/version "0.13.0"} 29 | djblue/portal {:mvn/version "0.58.2"} 30 | org.clojure/tools.deps {:mvn/version "0.21.1467"}}} 31 | :root/test {:extra-paths ["test"] 32 | :extra-deps {org.clojure/test.check {:mvn/version "1.1.1"} 33 | io.github.cognitect-labs/test-runner 34 | {:git/tag "v0.5.1" :git/sha "dfb30dd"} 35 | clj-http/clj-http {:mvn/version "3.12.3"}} 36 | :exec-fn cognitect.test-runner.api/test 37 | :exec-args {:patterns [".*-test$"] 38 | :dirs ["test" "parts" "projects"]}} 39 | :root/build {:extra-paths ["build"] 40 | :extra-deps {io.github.clojure/tools.build 41 | {:mvn/version "0.10.5"}} 42 | :ns-default build 43 | :exec-fn ci 44 | :exec-args {:app-alias :com.example.core}} 45 | 46 | ;; GRUGSTACK 47 | :parts/extra-paths ["parts/dev" 48 | "parts/test" 49 | "parts/src" 50 | "parts/resources"] 51 | :grugstack {:extra-deps {parts/grugstack 52 | {:local/root "parts"}} 53 | :exec-args {:dirs ["parts"]}} 54 | 55 | ;; EXAMPLE APP 56 | :com.example.core/extra-paths ["projects/example_app/dev" 57 | "projects/example_app/test" 58 | "projects/example_app/src" 59 | "projects/example_app/resources"] 60 | :com.example.core {:ns-default com.example.core 61 | :main-opts ["-m" "com.example.core"] 62 | :extra-deps {;; does not use parts/grugstack {:local/root "parts"} 63 | projects/example_app {:local/root "projects/example_app"}} 64 | :exec-args {:dirs ["projects/example_app"]}} 65 | 66 | ;; ACME CORP's SNAFUAPP 67 | :com.acmecorp.snafuapp.core/extra-paths ["projects/acmecorp/snafuapp/dev" 68 | "projects/acmecorp/snafuapp/test" 69 | "projects/acmecorp/snafuapp/src" 70 | "projects/acmecorp/snafuapp/resources"] 71 | :com.acmecorp.snafuapp.core {:ns-default com.acmecorp.snafuapp.core 72 | :main-opts ["-m" "com.acmecorp.snafuapp.core"] 73 | :extra-deps {;; explicitly uses grugstack 74 | parts/grugstack {:local/root "parts"} 75 | acmecorp/snafuapp {:local/root "projects/acmecorp/snafuapp"}} 76 | :exec-args {:dirs ["projects/acmecorp/snafuapp"]}} 77 | 78 | ;; SLURPED IN "usermanager-first-principles" from: 79 | ;; https://github.com/adityaathalye/usermanager-first-principles 80 | :usermanager.main/extra-paths ["projects/usermanager-first-principles/dev" 81 | "projects/usermanager-first-principles/test" 82 | "projects/usermanager-first-principles/src" 83 | "projects/usermanager-first-principles/resources"] 84 | :usermanager.main {:ns-default usermanager.main 85 | :main-opts ["-m" "usermanager.main"] 86 | :extra-deps 87 | {parts/grugstack 88 | {:local/root "parts"} 89 | projects/example_app 90 | {:local/root "projects/usermanager-first-principles"}} 91 | :exec-args {:dirs ["projects/usermanager-first-principles"]}} 92 | 93 | ;; FnConf DEMOs 94 | :org.evalapply.smol-web-app/extra-paths ["projects/fnconf2025/smolwebapp/dev" 95 | "projects/fnconf2025/smolwebapp/test" 96 | "projects/fnconf2025/smolwebapp/src" 97 | "projects/fnconf2025/smolwebapp/resources"] 98 | :org.evalapply.smol-web-app {:ns-default org.evalapply.smol-web-app 99 | :main-opts ["-m" "org.evalapply.smol-web-app"] 100 | :extra-deps 101 | {fnconf2025/smolwebapp 102 | {:local/root "projects/fnconf2025/smolwebapp"}} 103 | :exec-args {:dirs ["projects/fnconf2025/smolwebapp"]}}}} 104 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require [integrant.repl :as ig-repl] 3 | [integrant.repl.state :as ig-state] 4 | [clojure.main] 5 | [clojure.tools.deps :as deps] 6 | [clojure.tools.namespace.repl :as repl] 7 | [clojure.repl.deps :as repl-deps :refer [add-lib sync-deps]] 8 | [portal.api :as p] 9 | [com.adityaathalye.grugstack.settings.core :as settings] 10 | [com.adityaathalye.grugstack.system.core :as system] 11 | [nrepl.cmdline])) 12 | 13 | (defn multiproject-repl-prompt 14 | [_] 15 | (let [[socket repl-ailas] (drop-while #(not= % "--socket") 16 | (clojure.main/with-bindings *command-line-args*)) 17 | project-ctx (when socket (str socket " " repl-ailas))] 18 | (printf "\n[This REPL | %s]\n\\_%s=> " 19 | project-ctx 20 | (ns-name *ns*)))) 21 | 22 | (defn run-repl 23 | "TODO: UGLY HACK. Find standard tool alternative to this silly 24 | :prompt injection (hehe :)) into nrepl.cmdline's private `run-repl`. 25 | 26 | I want to be aware at all times, which REPL context I am in, so I am 27 | confident about evaluating (set-prep!) etc. 28 | 29 | Ideally, I want the REPL prompt to be set to the project alias. 30 | 31 | However, `(clojure.main/repl :prompt multiproject-repl-prompt)` starts a 32 | sub-repl, which messes with my preferred method of starting a REPL 33 | at a named unix domain file socket. If user.clj starts a sub-repl, then 34 | it swallows the file socket, and I can no longer locate it anywhere. 35 | 36 | I could not figure out how to set the prompt, from Cider, or nREPL, or 37 | clojure.main." 38 | ([{:keys [server options] :as repl-ctx}] 39 | ;; Since it is a pass-through wrapper over the private function, I 40 | ;; guess it will break only if maintainers add / modify the arity. 41 | (#'nrepl.cmdline/run-repl (assoc-in repl-ctx 42 | [:options :prompt] 43 | multiproject-repl-prompt))) 44 | ([host port] 45 | (run-repl host port nil)) 46 | ([host port options] 47 | (run-repl {:server (cond-> {} 48 | host (assoc :host host) 49 | port (assoc :port port)) 50 | :options options}))) 51 | 52 | (defn whereami? 53 | [] 54 | (drop-while #(not= % "--socket") 55 | (clojure.main/with-bindings 56 | *command-line-args*))) 57 | 58 | (defn set-prep! 59 | [settings-file-grug-style] 60 | (ig-repl/set-prep! 61 | #(system/expand (settings/make-settings 62 | (settings/read-settings! settings-file-grug-style))))) 63 | 64 | (defn go [] (ig-repl/go)) 65 | (defn halt [] (ig-repl/halt)) 66 | (defn reset [] (ig-repl/reset)) 67 | (defn reset-all [] (ig-repl/reset-all)) 68 | 69 | ;; ref: https://ryanmartin.me/articles/clojure-fly/ 70 | (repl/set-refresh-dirs "src" "resources" "parts" "projects") 71 | 72 | (comment 73 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 74 | ;;; SET UP SYSTEM HELPERS 75 | ;;; 76 | ;;; Call set-prep manually, depending on project REPL 77 | ;;; connected to, before using the "SYSTEM helpers" 78 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 79 | 80 | (set-prep! "FIXME/settings.edn") 81 | 82 | (set-prep! "com/example/settings.edn") 83 | 84 | (set-prep! "com/acmecorp/snafuapp/settings.edn") 85 | 86 | (set-prep! "usermanager/settings.edn") 87 | 88 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 89 | ;;; SYSTEM helpers 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 91 | 92 | (go) 93 | (halt) 94 | (reset) 95 | (reset-all) 96 | 97 | ig-state/system 98 | 99 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 100 | ;;; VISUAL tools 101 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 102 | (do ;; open fresh portal 103 | (do ;; clean stop 104 | (p/clear) 105 | (p/close)) 106 | (do ;; reopen and tap 107 | (p/open) 108 | (add-tap #'p/submit))) 109 | 110 | ;; Visualise 111 | (tap> ig-state/system) 112 | 113 | (p/clear) 114 | 115 | #_(p/start) 116 | 117 | (tap> (.getConnection (get-in ig-state/system [:database/primary :reader]))) 118 | 119 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 120 | ;;; DEPS helpers 121 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 122 | 123 | ;; Explore the deps tree 124 | (:project-edn (deps/find-edn-maps "./deps.edn")) 125 | 126 | ;; Try a lib 127 | (add-lib 'sym {:mvn/version "x.y.z"}) 128 | 129 | ;; Update libs from deps.edn 130 | (sync-deps) 131 | 132 | 0) ;; END OF COMMENT BLOCK 133 | -------------------------------------------------------------------------------- /doc/multiproject-multiple-repl-contexts.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/doc/multiproject-multiple-repl-contexts.png -------------------------------------------------------------------------------- /parts/.clj-kondo/imports/com.github.seancorfield/next.jdbc/config.edn: -------------------------------------------------------------------------------- 1 | {:hooks 2 | {:analyze-call 3 | {next.jdbc/with-transaction 4 | hooks.com.github.seancorfield.next-jdbc/with-transaction 5 | next.jdbc/with-transaction+options 6 | hooks.com.github.seancorfield.next-jdbc/with-transaction+options}} 7 | :lint-as {next.jdbc/on-connection clojure.core/with-open 8 | next.jdbc/on-connection+options clojure.core/with-open}} 9 | -------------------------------------------------------------------------------- /parts/.clj-kondo/imports/com.github.seancorfield/next.jdbc/hooks/com/github/seancorfield/next_jdbc.clj_kondo: -------------------------------------------------------------------------------- 1 | (ns hooks.com.github.seancorfield.next-jdbc 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn with-transaction 5 | "Expands (with-transaction [tx expr opts] body) 6 | to (let [tx expr] opts body) per clj-kondo examples." 7 | [{:keys [:node]}] 8 | (let [[binding-vec & body] (rest (:children node)) 9 | [sym val opts] (:children binding-vec)] 10 | (when-not (and sym val) 11 | (throw (ex-info "No sym and val provided" {}))) 12 | (let [new-node (api/list-node 13 | (list* 14 | (api/token-node 'let) 15 | (api/vector-node [sym val]) 16 | opts 17 | body))] 18 | {:node new-node}))) 19 | 20 | (defn with-transaction+options 21 | "Expands (with-transaction+options [tx expr opts] body) 22 | to (let [tx expr] opts body) per clj-kondo examples." 23 | [{:keys [:node]}] 24 | (let [[binding-vec & body] (rest (:children node)) 25 | [sym val opts] (:children binding-vec)] 26 | (when-not (and sym val) 27 | (throw (ex-info "No sym and val provided" {}))) 28 | (let [new-node (api/list-node 29 | (list* 30 | (api/token-node 'let) 31 | (api/vector-node [sym val]) 32 | opts 33 | body))] 34 | {:node new-node}))) 35 | -------------------------------------------------------------------------------- /parts/.clj-kondo/imports/hiccup/hiccup/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {hiccup.def/defhtml clojure.core/defn} 2 | :hooks {:analyze-call {hiccup.def/defelem hiccup.hooks/defelem}}} 3 | -------------------------------------------------------------------------------- /parts/.clj-kondo/imports/hiccup/hiccup/hiccup/hooks.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.hooks 2 | (:require [clj-kondo.hooks-api :as api] 3 | [clojure.set :as set])) 4 | 5 | ;; See https://github.com/clj-kondo/clj-kondo/blob/master/doc/hooks.md 6 | 7 | (defn- parse-defn [elems] 8 | (let [[fhead fbody] (split-with #(not (or (api/vector-node? %) 9 | (api/list-node? %))) 10 | elems) 11 | arities (if (api/vector-node? (first fbody)) 12 | (list (api/list-node fbody)) 13 | fbody)] 14 | [fhead arities])) 15 | 16 | (defn- count-args [arity] 17 | (let [args (first (api/sexpr arity))] 18 | (if (= '& (fnext (reverse args))) 19 | true ; unbounded args 20 | (count args)))) 21 | 22 | (defn- dummy-arity [arg-count] 23 | (api/list-node 24 | (list 25 | (api/vector-node 26 | (vec (repeat arg-count (api/token-node '_))))))) 27 | 28 | (defn defelem [{:keys [node]}] 29 | (let [[_ & rest] (:children node) 30 | [fhead arities] (parse-defn rest) 31 | arg-counts (set (filter number? (map count-args arities))) 32 | dummy-arg-counts (set/difference (set (map inc arg-counts)) arg-counts) 33 | dummy-arities (for [n dummy-arg-counts] (dummy-arity n))] 34 | {:node 35 | (api/list-node 36 | (list* 37 | (api/token-node 'clojure.core/defn) 38 | (concat fhead arities dummy-arities)))})) 39 | -------------------------------------------------------------------------------- /parts/.clj-kondo/imports/metosin/malli/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {malli.experimental/defn schema.core/defn} 2 | :linters {:unresolved-symbol {:exclude [(malli.core/=>)]}}} 3 | -------------------------------------------------------------------------------- /parts/.gitignore: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /parts/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {org.clojure/clojure {:mvn/version "1.12.0"} 3 | 4 | ;; Ring HTTP utilities: https://github.com/ring-clojure/ring 5 | ring/ring-core {:mvn/version "1.12.2"} 6 | ring/ring-jetty-adapter {:mvn/version "1.12.2"} ; embedded Jetty 7 | ring-cors/ring-cors {:mvn/version "0.1.13"} 8 | 9 | ;; System composition and configuration: https://github.com/weavejester/integrant 10 | integrant/integrant {:mvn/version "0.13.0"} ; define/start/stop system 11 | aero/aero {:mvn/version "1.1.6"} ; EDN-file-based configuration, might not need it 12 | 13 | ;; HTTP Routing and coercion: https://github.com/metosin/reitit 14 | metosin/reitit-core {:mvn/version "0.7.2"} ; routing core 15 | metosin/reitit-ring {:mvn/version "0.7.2"} ; ring router 16 | metosin/reitit-middleware {:mvn/version "0.7.2"} ; common middleware 17 | metosin/reitit-malli {:mvn/version "0.7.2"} ; malli coercion 18 | 19 | ;; HTTP API format negotiation, encoding and decoding 20 | ;; TODO: Do we need this for our HTMX app???? 21 | metosin/muuntaja {:mvn/version "0.6.10"} ; core abstractions + Jsonista JSON, EDN and Transit formats 22 | metosin/muuntaja-form {:mvn/version "0.6.10"} ; application/x-www-form-urlencoded formatter using ring-codec 23 | 24 | ;; Data Utilities 25 | metosin/malli {:mvn/version "0.16.4"} ; specify, validate, coerce data 26 | 27 | ;; Database Utilities 28 | com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"} ; JDBC adapter 29 | org.xerial/sqlite-jdbc {:mvn/version "3.46.1.0"} ; SQLite JDBC driver 30 | com.zaxxer/HikariCP {:mvn/version "6.0.0"} ; connection pooling 31 | 32 | ;; Web Frontend 33 | hiccup/hiccup {:mvn/version "2.0.0-RC3"} ; Server-rendered HTML as Clojure data 34 | 35 | ;; Cryptography, Authentication, and Authorization 36 | buddy/buddy-auth {:mvn/version "3.0.1"} ; authenticate, authorize 37 | ;; buddy/buddy-hashers {:mvn/version "2.0.167"} ; hashing utils 38 | ;; buddy/buddy-sign {:mvn/version "3.6.1-359"} ; High level message signing library. 39 | 40 | ;; Time 41 | clojure.java-time/clojure.java-time {:mvn/version "1.4.2"} 42 | 43 | ;; Logging 44 | org.clojure/tools.logging {:mvn/version "1.3.0"} 45 | org.slf4j/slf4j-simple {:mvn/version "2.0.16"}}} 46 | -------------------------------------------------------------------------------- /parts/dev/com/adityaathalye/grugstack/utilities/integrant_repl.clj: -------------------------------------------------------------------------------- 1 | (ns grugstack.utilities.integrant-repl 2 | (:require [integrant.repl :as ig-repl] 3 | [integrant.repl.state :as ig-state] 4 | [clojure.tools.namespace.repl :as repl] 5 | [clojure.repl.deps :as repl-deps :refer [add-lib]] 6 | [portal.api :as p] 7 | [clojure.reflect :as reflect] 8 | [com.adityaathalye.grugstack.settings.core :as settings] 9 | [com.adityaathalye.grugstack.system.core :as system])) 10 | 11 | (defn set-project-integrant! 12 | [namespace-sym] 13 | (ig-repl/set-prep! 14 | #(system/expand (settings/make-settings 15 | (settings/read-settings! "com/acmecorp/snafuapp/settings.edn")))) 16 | 17 | ;; ref: https://ryanmartin.me/articles/clojure-fly/ 18 | (repl/set-refresh-dirs "src" "resources" "parts") 19 | 20 | (def go ig-repl/go) 21 | (def halt ig-repl/halt) 22 | (def reset ig-repl/reset) 23 | (def reset-all ig-repl/reset-all)) 24 | 25 | (comment 26 | (go) 27 | (halt) 28 | (reset) 29 | (reset-all) 30 | 31 | ig-state/system 32 | 33 | (do ;; open fresh portal 34 | (do ;; clean stop 35 | (p/clear) 36 | (p/close)) 37 | (do ;; reopen and tap 38 | (p/open) 39 | (add-tap #'p/submit))) 40 | 41 | (tap> ig-state/system) 42 | 43 | (p/clear) 44 | 45 | #_(p/start) 46 | 47 | (tap> (.getConnection (get-in ig-state/system [:database/primary :reader]))) 48 | 49 | (add-lib 'sym {:mvn/version "x.y.z"})) 50 | -------------------------------------------------------------------------------- /parts/resources/sqlite-extensions/csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/parts/resources/sqlite-extensions/csv -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/settings/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.settings.core 2 | (:require 3 | [clojure.java.io :as io] 4 | [integrant.core :as ig]) 5 | (:gen-class)) 6 | 7 | (def default-settings-edn-file 8 | "TODO: Write a specification for this file. Optionally use aero to manage it." 9 | "com/adityaathalye/grugstack/settings/defaults.edn") 10 | 11 | (defn read-settings! 12 | [settings-file] 13 | (-> settings-file 14 | io/resource 15 | slurp 16 | ig/read-string)) 17 | 18 | (let [default-settings (read-settings! default-settings-edn-file)] 19 | (defn make-settings 20 | ([] (make-settings {})) 21 | ([custom-settings] 22 | (make-settings default-settings 23 | custom-settings)) 24 | ([base-settings custom-settings] 25 | {:post [(let [app-name (get-in % [:com.adityaathalye.grugstack.system.core/settings :app-name])] 26 | (and app-name 27 | (not= app-name "OVERRIDE_ME_PLACEHOLDER")))]} 28 | (merge-with merge 29 | base-settings 30 | custom-settings)))) 31 | 32 | (comment 33 | 34 | ;; default config should force assert to fail 35 | (make-settings) 36 | 37 | ;; suitable override should succeed 38 | (make-settings {:app-name "custom-app-name"})) 39 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/settings/defaults.edn: -------------------------------------------------------------------------------- 1 | {:com.adityaathalye.grugstack.system.core/settings 2 | {:app-name "OVERRIDE_ME_PLACEHOLDER" 3 | :runtime-environment-type "dev" 4 | :system-modules [:com.adityaathalye.grugstack.system.db.sqlite 5 | :com.adityaathalye.grugstack.system.db.primary.sqlite 6 | :com.adityaathalye.grugstack.system.db.sessions.sqlite 7 | :com.adityaathalye.grugstack.system.runtime 8 | :com.adityaathalye.grugstack.system.application 9 | :com.adityaathalye.grugstack.system.server]} 10 | ;; no-op migration 11 | :com.adityaathalye.grugstack.system.db.primary.sqlite/db 12 | {:migrator identity}} 13 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/application.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.application 2 | (:require [integrant.core :as ig] 3 | [com.adityaathalye.grugstack.system.core :as system] 4 | [clojure.tools.logging :as log] 5 | [reitit.coercion.malli] 6 | [reitit.ring] 7 | [reitit.ring.middleware.parameters :as rrm-params] 8 | [ring.middleware.keyword-params :as rmk-params] 9 | [ring.util.response :as res]) 10 | (:gen-class)) 11 | 12 | (def reitit-route-tree-hello-world-app 13 | ["" 14 | ["/" {:get (constantly {:status 200 15 | :headers {"Content-Type" "text/html"} 16 | :body "

Hello World.

"})}] 17 | ["/ping" {:get (constantly {:status 200 :body "Pong"})}]]) 18 | 19 | (defn reitit-ring-default-routes 20 | [] 21 | (reitit.ring/routes 22 | (reitit.ring/redirect-trailing-slash-handler) 23 | ;; static assets nested under "resources/public" 24 | (reitit.ring/create-resource-handler {:path "/"}) 25 | (reitit.ring/create-default-handler 26 | {:not-found (constantly (res/not-found "Not found."))}))) 27 | 28 | (def wrap-system 29 | {:name ::system 30 | :compile (fn [{:keys [system]} _] 31 | (fn [handler] 32 | (fn [req] 33 | (handler (assoc req ::system system)))))}) 34 | 35 | (def wrap-view-ctx 36 | {:name ::view-context 37 | :compile (fn [{ctx ::view} _] 38 | (fn [handler] 39 | (fn [req] 40 | (-> req 41 | (assoc ::view ctx) 42 | handler))))}) 43 | 44 | (defmulti reitit-ring-router 45 | (fn [system _reitit-route-tree] 46 | (get-in system [:environment :type]))) 47 | 48 | (defmethod reitit-ring-router :default 49 | [system reitit-route-tree] 50 | ;; Assume dev environment if no known env specified. 51 | (reitit-ring-router (assoc-in system [:environment :type] :dev) 52 | reitit-route-tree)) 53 | 54 | (defmethod reitit-ring-router :dev 55 | [system reitit-route-tree] 56 | (reitit.ring/router 57 | reitit-route-tree 58 | {:data {:system system 59 | :coercions reitit.coercion.malli/coercion 60 | :middleware [wrap-view-ctx 61 | rrm-params/parameters-middleware 62 | rmk-params/wrap-keyword-params 63 | wrap-system 64 | #_[cors/wrap-cors :access-control-allow-origin #".*" 65 | :access-control-allow-methods [:get :put :post :patch :delete]]]}})) 66 | 67 | (defmulti reitit-ring-handler 68 | "Given a well-formed system definition, create a Ring app for the system's :runtime/env. 69 | 70 | TODO: Consider using Integrant's Profiles to drive this." 71 | :env) 72 | 73 | (defmethod reitit-ring-handler :default 74 | [{:keys [system reitit-route-tree]}] 75 | (reitit.ring/ring-handler 76 | (reitit-ring-router system reitit-route-tree) 77 | (reitit-ring-default-routes))) 78 | 79 | (defmethod reitit-ring-handler :dev 80 | [{:keys [system reitit-route-tree]}] 81 | (reitit.ring/reloading-ring-handler 82 | #(reitit.ring/ring-handler 83 | (reitit-ring-router system reitit-route-tree) 84 | (reitit-ring-default-routes)))) 85 | 86 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.application 87 | [{::keys [router handler reitit-route-tree] 88 | :or {router `reitit-ring-router 89 | handler `reitit-ring-handler 90 | reitit-route-tree `reitit-route-tree-hello-world-app}}] 91 | {::reitit-ring {:data {:system (ig/ref ::system/components) 92 | :coercions reitit.coercion.malli/coercion 93 | :middleware [wrap-view-ctx 94 | rrm-params/parameters-middleware 95 | rmk-params/wrap-keyword-params 96 | wrap-system 97 | #_[cors/wrap-cors :access-control-allow-origin #".*" 98 | :access-control-allow-methods [:get :put :post :patch :delete]]]}} 99 | ::reitit-route-tree reitit-route-tree 100 | ::reitit-router router 101 | ::handler handler}) 102 | 103 | (defmethod ig/init-key ::reitit-ring 104 | [_ router-parts] 105 | (log/info router-parts) 106 | router-parts) 107 | 108 | (defmethod ig/init-key ::reitit-router 109 | [_ router] 110 | (resolve router)) 111 | 112 | (defmethod ig/init-key ::reitit-route-tree 113 | [_ reitit-route-tree] 114 | (deref (resolve reitit-route-tree))) 115 | 116 | (defmethod ig/init-key ::handler 117 | [_ handler] 118 | (resolve handler)) 119 | 120 | (comment 121 | (ig/init 122 | (merge (system/build-config-map {::system/module 123 | ::application}) 124 | {::system/components {:environment {:type :dev}}})) 125 | 126 | (do 127 | (require 'reitit.core) 128 | 129 | (def wrap-application-view 130 | {:name ::app-view 131 | :compile (fn [data _] 132 | (fn [handler] 133 | (fn [req] 134 | (println data) 135 | (handler (merge req 136 | (select-keys data [::view]))))))}) 137 | 138 | (def ring-router 139 | (reitit.ring/router 140 | ["" {} 141 | ["/api/ping" ::ping] 142 | ["/api/orders" {:middleware [wrap-application-view] 143 | :get (fn [request] 144 | {:status 200 145 | :body (::view request "Not Found.")}) 146 | ::view "bar" 147 | :name ::foo}]])) 148 | 149 | (def app-try 150 | (reitit.ring/ring-handler 151 | ring-router))) 152 | 153 | (reitit.core/match-by-path ring-router 154 | "/api/orders") 155 | 156 | (app-try {:request-method :get :uri "/api/orders"}) 157 | 158 | (-> app-try (reitit.ring/get-router) (reitit.core/match-by-name ::foo))) 159 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.core 2 | "OR pull in a library of pre-built Component components under the 3 | 'system' directory. ORrrrr vendor the code for visibility. e.g. If we 4 | add danielsz/system as a git submodule (the only, and the only sane 5 | way to use submodules) under our 'system' directory, then BOOM, we 6 | have all the recipes. https://danielsz.github.io/system/" 7 | (:require 8 | [integrant.core :as ig] 9 | [ring.adapter.jetty] 10 | [com.adityaathalye.grugstack.settings.core :as settings]) 11 | (:gen-class)) 12 | 13 | (def default-system-components 14 | {::components {:db-primary (ig/ref :com.adityaathalye.grugstack.system.db.primary.sqlite/db) 15 | :db-sessions (ig/ref :com.adityaathalye.grugstack.system.db.sessions.sqlite/db) 16 | :environment (ig/ref :com.adityaathalye.grugstack.system.runtime/environment)}}) 17 | 18 | #_(def build-config-map nil) 19 | (defmulti build-config-map 20 | ::module) 21 | 22 | (defmethod ig/init-key ::settings 23 | [_ {:keys [app-name runtime-environment-type] 24 | :as settings}] 25 | (assoc settings 26 | :app-name (name app-name) 27 | :runtime-environment (name runtime-environment-type))) 28 | 29 | (defn expand 30 | "The way init works, the ::settings map never appears in the 31 | config. This is intentional. Settings can contain secrets that we 32 | don't want to have to remember to elide from the final configuration." 33 | [{{:keys [system-modules]} ::settings 34 | components ::components 35 | :or {components default-system-components} 36 | :as settings}] 37 | (apply require (map symbol system-modules)) 38 | (let [cfg (reduce (fn [system-configuration module-name] 39 | (merge system-configuration 40 | (build-config-map (assoc settings 41 | ::module module-name)))) 42 | {} 43 | system-modules)] 44 | (-> cfg 45 | (dissoc ::settings) 46 | (assoc ::components components) 47 | ig/expand))) 48 | 49 | (defmethod ig/init-key ::components 50 | [_ system-map] 51 | system-map) 52 | 53 | (defn init 54 | [settings] 55 | (let [cfg (expand settings)] 56 | (ig/load-namespaces cfg) 57 | (-> cfg ig/init))) 58 | 59 | (comment 60 | 61 | (def test-system 62 | (do (when test-system (ig/halt! test-system)) 63 | (init (settings/make-settings (settings/read-settings! 64 | "com/example/settings.edn"))))) 65 | 66 | (expand 67 | (settings/make-settings (settings/read-settings! 68 | "com/example/settings.edn")))) 69 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/db/primary/sqlite.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.db.primary.sqlite 2 | (:require 3 | [clojure.tools.logging :as log] 4 | [integrant.core :as ig] 5 | [com.adityaathalye.grugstack.system.core :as system] 6 | [com.adityaathalye.grugstack.system.db.sqlite :as sqlite] 7 | [next.jdbc :as jdbc]) 8 | (:gen-class)) 9 | 10 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.db.primary.sqlite 11 | [{{:keys [app-name runtime-environment-type]} 12 | :com.adityaathalye.grugstack.system.core/settings 13 | {:keys [dbname migrator db-spec]} 14 | :com.adityaathalye.grugstack.system.db.primary.sqlite/db}] 15 | ;; (log/info "Configuring module" *ns*) 16 | {::db {:dbname (or dbname 17 | (format "%s_%s_primary.sqlite3" app-name runtime-environment-type)) 18 | :db-spec (or db-spec (ig/ref ::sqlite/db-spec)) 19 | :migrator (when migrator (resolve migrator)) 20 | :runtime-environment (ig/ref :com.adityaathalye.grugstack.system.runtime/environment) 21 | :datasource nil}}) 22 | 23 | (defmethod ig/init-key ::db 24 | [_ {:keys [dbname db-spec migrator]}] 25 | {:pre [(var? migrator)]} 26 | (log/info (str "Setting up DB: " dbname)) 27 | (let [datasource (sqlite/set-up! dbname db-spec)] 28 | (log/info "Migrating DB:" dbname) 29 | (with-open [connection (jdbc/get-connection datasource)] 30 | (migrator connection)) 31 | {:dbname dbname 32 | :migrator migrator 33 | :datasource datasource})) 34 | 35 | (defmethod ig/resolve-key ::db 36 | [_ {:keys [datasource]}] 37 | datasource) 38 | 39 | (defmethod ig/halt-key! ::db 40 | [_ {:keys [datasource]}] 41 | ;; Datasource must be a closeable (e.g. Hikari connection pool) 42 | (when datasource 43 | (.close datasource)) 44 | (log/info "Discarding DB:" datasource) 45 | nil) 46 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/db/sessions/sqlite.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.db.sessions.sqlite 2 | (:require 3 | [clojure.tools.logging :as log] 4 | [integrant.core :as ig] 5 | [com.adityaathalye.grugstack.system.core :as system] 6 | [com.adityaathalye.grugstack.system.db.sqlite :as sqlite] 7 | [next.jdbc :as jdbc]) 8 | (:gen-class)) 9 | 10 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.db.sessions.sqlite 11 | [{{:keys [app-name runtime-environment-type]} 12 | :com.adityaathalye.grugstack.system.core/settings 13 | {:keys [dbname dbpath migrator db-spec] 14 | :or {migrator identity}} 15 | :com.adityaathalye.grugstack.system.db.sessions.sqlite/db}] 16 | ;; (log/info "Configuring module" *ns*) 17 | {::db {:dbname (or dbname 18 | (format "%s_%s_sessions.sqlite3" app-name runtime-environment-type)) 19 | :db-spec (or db-spec 20 | (ig/ref ::sqlite/db-spec)) 21 | :migrator migrator 22 | :datasource nil}}) 23 | 24 | (defmethod ig/init-key ::db 25 | [_ {:keys [dbname db-spec migrator]}] 26 | (log/info (str "Setting up DB: " dbname)) 27 | (let [datasource (sqlite/set-up! dbname db-spec)] 28 | (when migrator 29 | (log/info "Migrating DB:" dbname) 30 | (with-open [connection (jdbc/get-connection datasource)] 31 | (migrator connection))) 32 | {:dbname dbname 33 | :migrator migrator 34 | :datasource datasource})) 35 | 36 | (defmethod ig/resolve-key ::db 37 | [_ {:keys [datasource]}] 38 | datasource) 39 | 40 | (defmethod ig/halt-key! ::db 41 | [_ {:keys [datasource]}] 42 | ;; Datasource must be a closeable (e.g. Hikari connection pool) 43 | (when datasource 44 | (.close datasource)) 45 | (log/info "Discarding DB:" datasource) 46 | nil) 47 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/db/sqlite.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.db.sqlite 2 | "PER-DB PRAGMAS and settings include journal_mode, 3 | auto_vacuum. PER-CONNECTION PRAGMAS must be set fresh for each 4 | connection. To use CONNECTION POOLS, follow next.jdbc's advice. In all 5 | cases, map the underlying xerial driver's ENUM definition to the 6 | actual SQLite PRAGMAs, because naming is hard and names 7 | change. Ref. PRAGMA names: 8 | https://github.com/xerial/sqlite-jdbc/blob/master/src/main/java/org/sqlite/SQLiteConfig.java#L382 9 | 10 | Connection Pool choice is singular. C3P0 is an alternative to HikariCP." 11 | (:require 12 | [clojure.tools.logging :as log] 13 | [integrant.core :as ig] 14 | [com.adityaathalye.grugstack.system.core :as system] 15 | [next.jdbc.connection :as jdbc-conn] 16 | [next.jdbc :as jdbc]) 17 | (:import [com.zaxxer.hikari HikariDataSource]) 18 | (:gen-class)) 19 | 20 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.db.sqlite 21 | [{{:keys [dataSourceProperties] 22 | :or {dataSourceProperties {:limit_worker_threads 4 23 | :busy_timeout 5000 ; ms, set per connection 24 | :foreign_keys "ON" ; ON = boolean 1, set per connection 25 | :cache_size -50000 ; KiB = 50 MiB, set per connection 26 | ;; NORMAL = 1, set per connection 27 | :synchronous "NORMAL"}}} 28 | :com.adityaathalye.grugstack.system.db.sqlite/db-spec 29 | :as ctx}] 30 | {;; Default pragmas 31 | ::db-spec {:dbtype "sqlite" 32 | :journal_mode "WAL" ; supported by xerial JDBC driver 33 | ;; INCREMENTAL = 2. Set manually. Not supported by xerial. 34 | :auto_vacuum "INCREMENTAL" 35 | :connectionTestQuery "PRAGMA journal_mode;" ; used by HikariCP 36 | :preferredTestQuery "PRAGMA journal_mode;" ; used by C3P0 37 | ;; :maximumPoolSize max-concurrency ; not supported by Xerial 38 | :dataSourceProperties dataSourceProperties}}) 39 | 40 | (defmethod ig/init-key ::db-spec 41 | [_ ctx] 42 | ctx) 43 | 44 | (defn get-pragma-settings 45 | ([connection-pool] 46 | (get-pragma-settings connection-pool 47 | ["journal_mode" 48 | "auto_vacuum" 49 | "threads" 50 | "temp_store" 51 | "busy_timeout" 52 | "foreign_keys" 53 | "cache_size" 54 | "synchronous"])) 55 | ([connection-pool pragmas] 56 | (with-open [connection (jdbc/get-connection connection-pool)] 57 | (reduce (fn [db-settings pragma] 58 | (into db-settings 59 | (jdbc/execute-one! connection [(str "PRAGMA " pragma)]))) 60 | {} 61 | pragmas)))) 62 | 63 | (defn set-up! 64 | [dbname {:keys [dbtype] :as db-spec}] 65 | (let [db-spec (assoc db-spec :dbname dbname) 66 | datasource ^HikariDataSource (jdbc-conn/->pool 67 | HikariDataSource 68 | db-spec)] 69 | (log/info "==== Starting DB with db-spec ====" db-spec) 70 | ;; next.jdbc doc says to fetch and then open/close a connection 71 | ;; to initialize a pool and perform validation check. 72 | ;; Using with-open on the read and write paths does it for us. 73 | (with-open [connection (jdbc/get-connection datasource)] 74 | ;; xerial's pragma ENUM properties do not include auto_vacuum, 75 | ;; so we have to do this manually, instead of via config. Sigh. 76 | (jdbc/execute! connection [(format "PRAGMA auto_vacuum = %s" 77 | (:auto_vacuum db-spec))]) 78 | ;; auto_vacuum value gets set only after vacuum 79 | (jdbc/execute! connection ["VACUUM"]) 80 | 81 | ;; Always run optimize at startup, after all 82 | ;; configurations are set and DDLs are executed. 83 | ;; https://www.sqlite.org/pragma.html#pragma_optimize 84 | (jdbc/execute! connection ["PRAGMA optimize"])) 85 | (log/info "Initialized pooled datasource PRAGMAS:" (get-pragma-settings datasource)) 86 | datasource)) 87 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/runtime.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.runtime 2 | (:require 3 | [integrant.core :as ig] 4 | [clojure.tools.logging :as log] 5 | [com.adityaathalye.grugstack.system.core :as system]) 6 | (:gen-class)) 7 | 8 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.runtime 9 | [{{:keys [app-name runtime-environment-type]} ::system/settings}] 10 | (log/info "Configuring module" *ns*) 11 | {::environment {:type runtime-environment-type 12 | :app-name app-name 13 | :total-memory (.totalMemory (Runtime/getRuntime)) 14 | :available-processors (.availableProcessors (Runtime/getRuntime)) 15 | :version (.toString (Runtime/version))}}) 16 | 17 | (defmethod ig/init-key ::environment 18 | [_ runtime-map] 19 | (log/info "Runtime environment is:" runtime-map) 20 | runtime-map) 21 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/server.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.server 2 | (:require 3 | [com.adityaathalye.grugstack.system.core :as system] 4 | [com.adityaathalye.grugstack.system.application :as system-application] 5 | [integrant.core :as ig] 6 | [clojure.tools.logging :as log] 7 | [ring.adapter.jetty]) 8 | (:gen-class)) 9 | 10 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.server 11 | [{{:keys [type port join?] 12 | :or {type :jetty port 13337 join? false} 13 | :as adapter-settings} ::jetty-adapter}] 14 | (log/info (format "Configured adapter %s at port %s with adapter-settings %s" type port adapter-settings)) 15 | {::jetty-adapter (merge {:type type :port port :join? join?} 16 | adapter-settings) 17 | ::server {:adapter-config (ig/ref ::jetty-adapter) 18 | :system (ig/ref ::system/components) 19 | :reitit-route-tree (ig/ref ::system-application/reitit-route-tree) 20 | :handler (ig/ref ::system-application/handler)}}) 21 | 22 | (defmethod ig/init-key ::jetty-adapter 23 | [_ adapter-options] 24 | adapter-options) 25 | 26 | (defmethod ig/init-key ::server 27 | [_ {:keys [adapter-config system reitit-route-tree handler] :as server}] 28 | (assoc server 29 | :object 30 | (case (:type adapter-config) 31 | :jetty (ring.adapter.jetty/run-jetty 32 | (handler {:system system 33 | :reitit-route-tree reitit-route-tree}) 34 | (-> adapter-config 35 | (dissoc :handler) 36 | (assoc :join? false))) 37 | nil))) 38 | 39 | (defmethod ig/resolve-key ::server 40 | [_ {:keys [object]}] 41 | object) 42 | 43 | (defmethod ig/halt-key! ::server 44 | [_ {:keys [object] :as _server}] 45 | (log/info "Stopping Jetty server.") 46 | (when object 47 | (.stop object)) 48 | nil) 49 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/system/server_simple.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.system.server-simple 2 | (:require 3 | [com.adityaathalye.grugstack.system.core :as system] 4 | [integrant.core :as ig] 5 | [clojure.tools.logging :as log] 6 | [ring.adapter.jetty]) 7 | (:gen-class)) 8 | 9 | (defmethod system/build-config-map :com.adityaathalye.grugstack.system.server-simple 10 | [{{:keys [type port join?] 11 | :or {type :jetty port 13337 join? false} 12 | :as adapter-settings} ::jetty-adapter 13 | {:keys [handler-thunk]} ::server}] 14 | (log/info (format "Configured adapter %s at port %s with adapter-settings %s" type port adapter-settings)) 15 | {::jetty-adapter (merge {:type type :port port :join? join?} 16 | adapter-settings) 17 | ::server {:adapter-config (ig/ref ::jetty-adapter) 18 | :components (ig/ref ::system/components) 19 | :handler-thunk handler-thunk}}) 20 | 21 | (defmethod ig/init-key ::jetty-adapter 22 | [_ adapter-options] 23 | adapter-options) 24 | 25 | (defmethod ig/init-key ::server 26 | [_ {:keys [adapter-config components handler-thunk] 27 | :as server}] 28 | (if-let [handler ((resolve handler-thunk) components)] 29 | (assoc server 30 | :object 31 | (case (:type adapter-config) 32 | :jetty (ring.adapter.jetty/run-jetty 33 | handler 34 | (-> adapter-config 35 | (assoc :join? false))) 36 | nil)) 37 | (log/info "NULL HANDLER!!!!!!!! for" 38 | (resolve handler-thunk)))) 39 | 40 | (defmethod ig/resolve-key ::server 41 | [_ {:keys [object]}] 42 | object) 43 | 44 | (defmethod ig/halt-key! ::server 45 | [_ {:keys [object] :as _server}] 46 | (log/info "Stopping Jetty server.") 47 | (when object 48 | (.stop object)) 49 | nil) 50 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/utilities/databases/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.utilities.databases.core 2 | (:require [clojure.java.io :as io]) 3 | (:import [java.util Date TimeZone] 4 | [java.text SimpleDateFormat])) 5 | 6 | (defprotocol IDatabaseConnectionPool 7 | (reader [pool]) 8 | (writer [pool]) 9 | (readwrite [pool])) 10 | 11 | (defmulti connection-pool) 12 | 13 | (defn timestamp! 14 | "Copied from yogthos/migratus." 15 | [] 16 | (let [fmt (doto (SimpleDateFormat. "yyyyMMddHHmmss") 17 | (.setTimeZone (TimeZone/getTimeZone "UTC")))] 18 | (.format fmt (Date.)))) 19 | 20 | (defn init-query-file! 21 | "Initialise a new query file if it does not already exist." 22 | [path query-name] 23 | (let [query-file (format "%s/QUERY_%s_%s.sql" 24 | path 25 | query-name 26 | (timestamp!))] 27 | (when-not (io/resource query-file) 28 | (spit (io/file query-file) "")))) 29 | 30 | (comment 31 | (init-query-file! "src/com/example/db" 32 | "foo")) 33 | 34 | (defn sql-slurp! 35 | [sql-dir sql-query-file] 36 | (->> sql-query-file 37 | (str sql-dir "/") 38 | io/resource 39 | slurp)) 40 | 41 | (defn sql-queries-map-init! 42 | [sql-dir sql-query-map] 43 | (reduce-kv (fn [queries-map query-key query-file] 44 | (assoc queries-map 45 | query-key 46 | [(sql-slurp! sql-dir query-file)])) 47 | {} 48 | sql-query-map)) 49 | -------------------------------------------------------------------------------- /parts/src/com/adityaathalye/grugstack/utilities/layouts/handlers.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.utilities.layouts.handlers 2 | (:require [hiccup.page :as hp] 3 | [hiccup2.core :as hc] 4 | [ring.util.response :as res])) 5 | 6 | #_(def hydrate-view nil) 7 | 8 | (defmulti hydrate-view 9 | "Handle requests based on 10 | `:com.adityaathalye.grugstack.system.application/view` context 11 | information injected into the request map, by middleware. This way, 12 | we can declare context information at the routing table, and 13 | conveniently trace route - view relationship." 14 | (comp :template :com.adityaathalye.grugstack.system.application/view)) 15 | 16 | (defmethod hydrate-view :default 17 | [{{:keys [page-name content page-template]} :com.adityaathalye.grugstack.system.application/view 18 | :as request}] 19 | (page-template 20 | {:page-name (or page-name (:uri request)) 21 | :content (or content [:p [:strong "Sorry, no content available."]])})) 22 | 23 | (defmethod hydrate-view :echo 24 | [request] 25 | (list 26 | [:p "URI: " (:uri request)] 27 | [:p "Message: " "I'm still alive."])) 28 | 29 | (defmethod hydrate-view :foo 30 | [request] 31 | (list 32 | [:p "URI: " (:uri request)] 33 | [:p "Message: " "I'm a FOO echoer"])) 34 | 35 | (defn html-fragment 36 | "Return a fragment of HTML as 200 OK response. Presumably, the 37 | result of an HTMX API request." 38 | [req] 39 | (-> req 40 | (hydrate-view) 41 | (hc/html) 42 | (str) 43 | (res/response) 44 | (res/content-type "text/html"))) 45 | 46 | (defn html5-page 47 | "Return a complete HTML page as 200 OK response. Presumably, the 48 | result of navigating to a new page." 49 | [req] 50 | (-> req 51 | (hydrate-view) 52 | (hp/html5) 53 | (str) 54 | (res/response) 55 | (res/content-type "text/html"))) 56 | 57 | (comment 58 | (html5-page {:request-method :get :uri "/"})) 59 | -------------------------------------------------------------------------------- /parts/test/com/adityaathalye/grugstack/settings/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.adityaathalye.grugstack.settings.core-test 2 | (:require [clojure.test :refer :all] 3 | [com.adityaathalye.grugstack.settings.core :refer :all])) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) 8 | 9 | (deftest b-test 10 | (testing "YAY, I pass." 11 | (is (= 1 1)))) 12 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/.gitignore: -------------------------------------------------------------------------------- 1 | *.pdf 2 | *.webm 3 | /data 4 | /db 5 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {}} 3 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/resources/public/css/style.css: -------------------------------------------------------------------------------- 1 | :root { 2 | font-family: -apple-system, BlinkMacSystemFont, avenir next, 3 | avenir, segoe ui, helvetica neue, helvetica, Cantarell, 4 | Ubuntu, roboto, noto, arial, sans-serif; 5 | line-height: 1.5rem; 6 | font-size: 1rem; 7 | --max-width: 72ch; 8 | } 9 | 10 | * { 11 | max-width: var(--max-width); 12 | } 13 | 14 | html, body, div, header, main { 15 | max-width: none; 16 | } 17 | 18 | body { 19 | overflow-x: hidden; 20 | } 21 | 22 | hr { 23 | margin: 0; 24 | border: none; 25 | height: 0.2em; 26 | background-color: black; 27 | } 28 | 29 | form hr { 30 | height: 0.05em; 31 | background-color: grey; 32 | } 33 | 34 | nav { 35 | display: flex; 36 | list-style-type: none; 37 | gap: 1rem; 38 | } 39 | 40 | table { 41 | overflow-x: auto; 42 | max-width: 72ch; 43 | table-layout: fixed; 44 | border-collapse: collapse; 45 | text-align: left; 46 | border: thin dashed; 47 | } 48 | 49 | th, td { 50 | padding: 0.5rem; 51 | border: thin dashed; 52 | } 53 | 54 | label, input, select, options { 55 | min-width: 18ch; 56 | } 57 | 58 | input { 59 | padding: 0.25em; 60 | width: 30ch; 61 | } 62 | 63 | select, #submit_button { 64 | padding: 0.25em; 65 | width: 31ch; 66 | } 67 | 68 | .stack { 69 | display: flex; 70 | flex-direction: column; 71 | justify-content: flex-start; 72 | } 73 | 74 | .stack > * { 75 | margin-top: 0; 76 | margin-bottom: 0; 77 | } 78 | 79 | .stack > * + * { 80 | margin-top: 1em; 81 | } 82 | 83 | .center { 84 | box-sizing: content-box; 85 | margin-left: auto; 86 | margin-right: auto; 87 | max-width: var(--max-width); 88 | } 89 | 90 | .cluster { 91 | display: flex; 92 | flex-wrap: wrap; 93 | gap: 0.2rem; 94 | justify-content: flex-start; 95 | align-items: center; 96 | } 97 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/resources/public/img/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/acmecorp/snafuapp/resources/public/img/favicon.ico -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.core 2 | (:require [com.adityaathalye.grugstack.system.core :as system] 3 | [clojure.tools.logging :as log] 4 | [com.adityaathalye.grugstack.settings.core :as settings] 5 | [com.acmecorp.snafuapp.handlers.core]) 6 | (:gen-class)) 7 | 8 | (defn -main 9 | [& args] 10 | (let [env (or (first args) :dev) 11 | env (keyword env) 12 | settings (settings/make-settings 13 | (settings/read-settings! "com/acmecorp/snafuapp/settings.edn") 14 | {:com.adityaathalye.grugstack.system.server/reitit-route-tree com.acmecorp.snafuapp.handlers.core/reitit-route-tree})] 15 | (log/info "Invoking -main with environment" env) 16 | (system/init settings))) 17 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/db/migrations.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.db.migrations 2 | (:require [com.acmecorp.snafuapp.db.utils :as db-utils :refer [reader writer]] 3 | [next.jdbc :as jdbc] 4 | [clojure.tools.logging :as log])) 5 | 6 | (def sql-queries 7 | (db-utils/sql-queries-map-init! 8 | "com/acmecorp/snafuapp/db" 9 | {::ddl "model.sql"})) 10 | 11 | (defn migrate! 12 | [ds] 13 | (with-open [ds (writer ds)] 14 | (log/info "MIGRATING DDL" (select-keys sql-queries [::ddl])) 15 | (log/info "DB connection is: " ds) 16 | ds)) 17 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/db/model.sql: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/db/model.sql -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/db/pragmas.sql: -------------------------------------------------------------------------------- 1 | -- WEB BACKEND CONFIGURATION 2 | -- (set one time at DB creation) 3 | -- 4 | -- Set the journal mode to "WAL" for better throughput. Adjust 5 | -- busy timeout, synchronous setting, cache size, temp store, and 6 | -- foreign keys for optimal use based on hardware and workload. 7 | -- 8 | -- CPU RESOURCES 9 | -- 10 | -- Enable Write-Ahead Logging for better throughput. WAL allows 11 | -- Non-blocking readers concurrently with single-threaded writer. 12 | PRAGMA journal_mode=WAL; 13 | -- Disk sync method. NORMAL is okay for web DB. 14 | PRAGMA synchronous=NORMAL; 15 | -- Wait these many milliseconds for locked DB to become available. 16 | PRAGMA busy_timeout=5000; 17 | -- Use up to N threads on multi-core systems. 18 | PRAGMA threads=4; 19 | -- MEMORY RESOURCES 20 | -- Store temporary tables in memory for more performance. 21 | PRAGMA temp_store=MEMORY; 22 | -- Page Size in bytes (4KB is default, make it explicit anyway) 23 | PRAGMA page_size=4096; 24 | -- Pages of cache. Negative number is absolute value in KiB. 25 | -- Positive number is number of pages. Bump high, to say 1GB, 26 | -- to reduce disk access for large datasets. 27 | PRAGMA cache_size=-50000; -- 50 MiB 28 | -- 29 | -- DATA MANAGEMENT 30 | -- 31 | -- Enforce foreign key constraints 32 | PRAGMA foreign_keys=ON; 33 | -- Auto-run index rebuilds and update stats. 34 | PRAGMA optimize; 35 | -- Auto-vacuum incrementally 36 | PRAGMA auto_vacuum=INCREMENTAL; 37 | -- 38 | -- OPTIONAL PRAGMAS for more sensitive performance tweaks 39 | -- 40 | -- Tune WAL write frequency to main DB. 41 | -- PRAGMA wal_autocheckpoint=1000; -- num pages to wait for checkpoint 42 | 43 | -- Control MMAP. Jury is still out whether this improves performance, 44 | -- and if it does, what is the trade-off? 45 | -- PRAGMA map_size=1000000000; -- 1GB mmaped I/O for faster DB access 46 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/db/utils.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.db.utils 2 | (:require [clojure.java.io :as io] 3 | [java-time.api :as jt]) 4 | (:import [java.util Date TimeZone] 5 | [java.text SimpleDateFormat])) 6 | 7 | (defprotocol IDatabaseConnectionPool 8 | (reader [pool]) 9 | (writer [pool]) 10 | (readwrite [pool])) 11 | 12 | (defmulti connection-pool) 13 | 14 | (defn timestamp! 15 | "Copied from yogthos/migratus." 16 | [] 17 | (let [fmt (doto (SimpleDateFormat. "yyyyMMddHHmmss") 18 | (.setTimeZone (TimeZone/getTimeZone "UTC")))] 19 | (.format fmt (Date.)))) 20 | 21 | (defn init-query-file! 22 | "Initialise a new query file if it does not already exist." 23 | [path query-name] 24 | (let [query-file (format "%s/QUERY_%s_%s.sql" 25 | path 26 | query-name 27 | (timestamp!))] 28 | (when-not (io/resource query-file) 29 | (spit (io/file query-file) "")))) 30 | 31 | (comment 32 | (init-query-file! "com/acmecorp/snafuapp/db" 33 | "foo")) 34 | 35 | (defn sql-slurp! 36 | [sql-dir sql-query-file] 37 | (->> sql-query-file 38 | (str sql-dir "/") 39 | io/resource 40 | slurp)) 41 | 42 | (defn sql-queries-map-init! 43 | [sql-dir sql-query-map] 44 | (reduce-kv (fn [queries-map query-key query-file] 45 | (assoc queries-map 46 | query-key 47 | [(sql-slurp! sql-dir query-file)])) 48 | {} 49 | sql-query-map)) 50 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/handlers/common.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.handlers.common 2 | (:require [com.acmecorp.snafuapp.db.migrations :as db-migrate] 3 | [com.acmecorp.snafuapp.layouts.default :as default-layout] 4 | [hiccup.page :as hp] 5 | [hiccup2.core :as hc] 6 | [ring.util.response :as res])) 7 | 8 | #_(def hydrate-view nil) 9 | 10 | (defmulti hydrate-view 11 | "Handle requests based on `:com.adityaathalye.grugstack.system.application/view` context information injected 12 | into the request map, by middleware. This way, we can declare context 13 | information at the routing table, and conveniently trace route - view 14 | relationship." 15 | (comp :template :system.application/view)) 16 | 17 | (defmethod hydrate-view :default 18 | [{{:keys [page-name content]} :system.application/view 19 | :as request}] 20 | (default-layout/page-template 21 | {:page-name (or page-name (:uri request)) 22 | :content (or content [:p [:strong "Sorry, no content available."]])})) 23 | 24 | (defmethod hydrate-view :echo 25 | [request] 26 | (list 27 | [:p "URI: " (:uri request)] 28 | [:p "Message: " "I'm still alive."])) 29 | 30 | (defmethod hydrate-view :foo 31 | [request] 32 | (list 33 | [:p "URI: " (:uri request)] 34 | [:p "Message: " "I'm a FOO echoer"])) 35 | 36 | (defn html-fragment 37 | "Return a fragment of HTML as 200 OK response. Presumably, the 38 | result of an HTMX API request." 39 | [req] 40 | (-> req 41 | (hydrate-view) 42 | (hc/html) 43 | (str) 44 | (res/response) 45 | (res/content-type "text/html"))) 46 | 47 | (defn html5-page 48 | "Return a complete HTML page as 200 OK response. Presumably, the 49 | result of navigating to a new page." 50 | [req] 51 | (-> req 52 | (hydrate-view) 53 | (hp/html5) 54 | (str) 55 | (res/response) 56 | (res/content-type "text/html"))) 57 | 58 | (comment 59 | (html5-page {:request-method :get :uri "/"})) 60 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/handlers/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.handlers.core 2 | (:require 3 | [com.acmecorp.snafuapp.handlers.common 4 | :as handlers-common 5 | :refer [html-fragment html5-page]] 6 | [reitit.ring] 7 | [com.adityaathalye.grugstack.system.core :as system])) 8 | 9 | (def reitit-route-tree 10 | ["" {:handler html-fragment} ; return hypermedia fragment by default 11 | ["/" {:get {:handler ^:replace html5-page 12 | :snafuapp/view {:template :default 13 | :page-name "Home Page"}}}] 14 | ["/echo" {:get {:snafuapp/view {:template :echo}}}] 15 | ["/foo" {:get {:snafuapp/view {:template :foo}}}]]) 16 | 17 | (defmethod system/build-config-map :com.acmecorp.snafuapp.handlers.core 18 | [{:com.adityaathalye.grugstack.system.application/keys [reitit-route-tree] 19 | :or {reitit-route-tree 'com.acmecorp.snafuapp.handlers.core/reitit-route-tree}}] 20 | {:com.adityaathalye.grugstack.system.application/reitit-route-tree reitit-route-tree}) 21 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/layouts/default.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.layouts.default 2 | (:require [hiccup.page :as hp])) 3 | 4 | (defn page-template 5 | "Structure of the default complete HTML5 page." 6 | [{:keys [page-name 7 | content] 8 | :or {page-name "" 9 | content [:p [:strong "Sorry, no content available."]]}}] 10 | (list 11 | [:head 12 | [:meta {:charset "utf-8"}] 13 | [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}] 14 | [:title (format "%s - %s" "SNAFU" page-name)] 15 | ;; static assets should be under 'resources/public' 16 | [:link {:rel "icon" :type "image/x-icon" :href "/img/favicon.ico"}] 17 | (hp/include-css "/css/style.css")] 18 | [:body 19 | [:div {:id "site-top" :class "stack center"} 20 | [:header {:id "site-header"} 21 | [:h2 "Snafuapp / " [:small [:small page-name]]] 22 | [:nav 23 | [:a {:href "/" 24 | :title "ACME Corp. - Planetary SNAFU Sniffer"} 25 | "Home"]]] 26 | [:main {:id "main"} 27 | content] 28 | [:footer {:id "site-footer" :class "stack"} 29 | [:hr] 30 | [:p "An ACME Corp. SNAFU"]]]])) 31 | 32 | (comment 33 | (hp/html5 (page-template {}))) 34 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/middleware/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.middleware.core) 2 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/src/com/acmecorp/snafuapp/settings.edn: -------------------------------------------------------------------------------- 1 | {:com.adityaathalye.grugstack.system.core/settings {:app-name "snafuapp" 2 | :runtime-environment-type "dev", 3 | :system-modules 4 | [:com.adityaathalye.grugstack.system.runtime 5 | :com.adityaathalye.grugstack.system.db.sqlite 6 | :com.adityaathalye.grugstack.system.db.primary.sqlite 7 | :com.adityaathalye.grugstack.system.db.sessions.sqlite 8 | :com.adityaathalye.grugstack.system.application 9 | :com.adityaathalye.grugstack.system.server 10 | :com.acmecorp.snafuapp.handlers.core]} 11 | :com.adityaathalye.grugstack.system.server/jetty-adapter {:port 13338} 12 | 13 | ;; no-op migration 14 | :com.adityaathalye.grugstack.system.db.primary.sqlite/db 15 | {:migrator identity}} 16 | -------------------------------------------------------------------------------- /projects/acmecorp/snafuapp/test/com/acmecorp/snafuapp/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.acmecorp.snafuapp.core-test 2 | (:require [clojure.test :refer :all] 3 | [com.acmecorp.snafuapp.core :refer :all])) 4 | 5 | ;; (deftest a-test 6 | ;; (testing "FIXME, I fail." 7 | ;; (is (= 0 1)))) 8 | 9 | (deftest b-test 10 | (testing "YAY, I pass." 11 | (is (= 1 1)))) 12 | -------------------------------------------------------------------------------- /projects/example_app/.gitignore: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/example_app/.gitignore -------------------------------------------------------------------------------- /projects/example_app/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {}} 3 | -------------------------------------------------------------------------------- /projects/example_app/src/com/example/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.core 2 | (:gen-class)) 3 | 4 | (defn greet 5 | [] 6 | (println "Hello, world.")) 7 | 8 | (defn -main 9 | [& _args] 10 | (greet)) 11 | -------------------------------------------------------------------------------- /projects/example_app/src/com/example/db/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.db.core) 2 | -------------------------------------------------------------------------------- /projects/example_app/src/com/example/settings.edn: -------------------------------------------------------------------------------- 1 | {:com.adityaathalye.grugstack.system.core/settings {:app-name "example_app" 2 | :runtime-environment-type "dev" 3 | :system-modules [:com.adityaathalye.grugstack.system.db.sqlite 4 | :com.adityaathalye.grugstack.system.db.primary.sqlite 5 | :com.adityaathalye.grugstack.system.db.sessions.sqlite 6 | :com.adityaathalye.grugstack.system.runtime 7 | :com.adityaathalye.grugstack.system.application 8 | :com.adityaathalye.grugstack.system.server]} 9 | ;; no-op migration 10 | :com.adityaathalye.grugstack.system.db.primary.sqlite/db 11 | {:migrator identity}} 12 | -------------------------------------------------------------------------------- /projects/example_app/test/com/example/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.example.core-test 2 | (:require [clojure.test :refer :all] 3 | [com.example.core :refer :all])) 4 | 5 | (deftest a-test 6 | (testing "DUMMY test, I pass, so builds work." 7 | (is (= 1 1)))) 8 | -------------------------------------------------------------------------------- /projects/fnconf2025/catchall/.gitignore: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/fnconf2025/catchall/.gitignore -------------------------------------------------------------------------------- /projects/fnconf2025/catchall/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "classes"] 2 | :deps {org.clojure/clojure {:mvn/version "1.12.0"} 3 | ring/ring-jetty-adapter {:mvn/version "1.13.0"}}} 4 | -------------------------------------------------------------------------------- /projects/fnconf2025/catchall/src/org/evalapply/catchall_app.clj: -------------------------------------------------------------------------------- 1 | (ns org.evalapply.catchall-app 2 | (:require [ring.adapter.jetty :as jetty]) 3 | (:gen-class)) 4 | 5 | (defn echo-handler [request] 6 | {:status 200 7 | :headers {"Content-Type" "text/html;charset=utf-8"} 8 | :body (pr-str request)}) 9 | 10 | (defn run-jetty 11 | [port] 12 | (println "Starting Jetty server at port:" port) 13 | (jetty/run-jetty echo-handler 14 | {:port port :join? false})) 15 | 16 | (defn -main [] 17 | (run-jetty 3000)) 18 | 19 | (comment ; "'Rich' comment form" 20 | ;; clojure -M -m org.evalapply.catchall-app 21 | ;; OR: 22 | (def server (run-jetty 3001)) 23 | 24 | ;; Extra: REPL-driven-development techniques. 25 | 26 | ;; Inspect live object 27 | (do (require 'clojure.reflect) 28 | (clojure.reflect/reflect server)) 29 | 30 | ;; Capture values to inspect them at will. 31 | (def responses (atom [])) 32 | 33 | (defn capture-response 34 | [response] 35 | (swap! responses conj response)) 36 | 37 | (add-tap capture-response) 38 | 39 | (tap> {:status 200 :body "hi"}) 40 | 41 | ;; Try Out dependencies 42 | ;; - Add without modifying deps.edn file 43 | ;; - refactor echo-handler to handle json=true query parameter 44 | ;; - copy down and replace body (dynamic REPL-driven dev.) 45 | (require 'clojure.repl.deps) 46 | 47 | (clojure.repl.deps/add-libs 48 | {'org.clojure/data.json {:mvn/version "2.5.1"} 49 | 'clj-http/clj-http {:mvn/version "3.12.3"}}) 50 | 51 | (require '[clojure.data.json :as json]) 52 | (defn TODO-override-echo-handler []) 53 | 54 | (require '[clj-http.client :as http]) 55 | (let [base-uri "http://localhost:3001"] 56 | (http/get (str base-uri "/foobar?json=true")))) 57 | -------------------------------------------------------------------------------- /projects/fnconf2025/nullproject/.gitignore: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/fnconf2025/nullproject/.gitignore -------------------------------------------------------------------------------- /projects/fnconf2025/nullproject/deps.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /projects/fnconf2025/nullproject/src/app.clj: -------------------------------------------------------------------------------- 1 | (ns app 2 | (:gen-class)) 3 | 4 | ;; FIXME, please. Make me do some work! 5 | (defn -main []) 6 | 7 | (comment 8 | ;; clojure -M -m app # does nothing 9 | ) 10 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/.gitignore: -------------------------------------------------------------------------------- 1 | .calva/output-window/ 2 | .calva/repl.calva-repl 3 | .classpath 4 | .clj-kondo/.cache 5 | .cpcache 6 | .eastwood 7 | .factorypath 8 | .hg/ 9 | .hgignore 10 | .java-version 11 | .lein-* 12 | .lsp/.cache 13 | .lsp/sqlite.db 14 | .nrepl-history 15 | .nrepl-port 16 | .portal/vs-code.edn 17 | .project 18 | .rebel_readline_history 19 | .settings 20 | .socket-repl-port 21 | .sw* 22 | .vscode 23 | *.class 24 | *.jar 25 | *.swp 26 | *~ 27 | /checkouts 28 | /classes 29 | /target 30 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). 3 | 4 | ## [Unreleased] 5 | ### Changed 6 | - Add a new arity to `make-widget-async` to provide a different widget shape. 7 | 8 | ## [0.1.1] - 2025-01-24 9 | ### Changed 10 | - Documentation on how to make the widgets. 11 | 12 | ### Removed 13 | - `make-widget-sync` - we're all async, all the time. 14 | 15 | ### Fixed 16 | - Fixed widget maker to keep working when daylight savings switches over. 17 | 18 | ## 0.1.0 - 2025-01-24 19 | ### Added 20 | - Files from the new template. 21 | - Widget maker public API - `make-widget-sync`. 22 | 23 | [Unreleased]: https://github.com/org/evalapply/smol-web-app/compare/0.1.1...HEAD 24 | [0.1.1]: https://github.com/org/evalapply/smol-web-app/compare/0.1.0...0.1.1 25 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/README.md: -------------------------------------------------------------------------------- 1 | # org/evalapply/smol-web-app 2 | 3 | FIXME: my new application. 4 | 5 | ## Installation 6 | 7 | Download from https://github.com/org/evalapply/smol-web-app 8 | 9 | ## Usage 10 | 11 | FIXME: explanation 12 | 13 | Run the project directly, via `:exec-fn`: 14 | 15 | $ clojure -X:run-x 16 | Hello, Clojure! 17 | 18 | Run the project, overriding the name to be greeted: 19 | 20 | $ clojure -X:run-x :name '"Someone"' 21 | Hello, Someone! 22 | 23 | Run the project directly, via `:main-opts` (`-m org.evalapply.smol-web-app`): 24 | 25 | $ clojure -M:run-m 26 | Hello, World! 27 | 28 | Run the project, overriding the name to be greeted: 29 | 30 | $ clojure -M:run-m Via-Main 31 | Hello, Via-Main! 32 | 33 | Run the project's tests (they'll fail until you edit them): 34 | 35 | $ clojure -T:build test 36 | 37 | Run the project's CI pipeline and build an uberjar (this will fail until you edit the tests to pass): 38 | 39 | $ clojure -T:build ci 40 | 41 | This will produce an updated `pom.xml` file with synchronized dependencies inside the `META-INF` 42 | directory inside `target/classes` and the uberjar in `target`. You can update the version (and SCM tag) 43 | information in generated `pom.xml` by updating `build.clj`. 44 | 45 | If you don't want the `pom.xml` file in your project, you can remove it. The `ci` task will 46 | still generate a minimal `pom.xml` as part of the `uber` task, unless you remove `version` 47 | from `build.clj`. 48 | 49 | Run that uberjar: 50 | 51 | $ java -jar target/net.clojars.org/evalapply/smol-web-app-0.1.0-SNAPSHOT.jar 52 | 53 | ## Options 54 | 55 | FIXME: listing of options this app accepts. 56 | 57 | ## Examples 58 | 59 | ... 60 | 61 | ### Bugs 62 | 63 | ... 64 | 65 | ### Any Other Sections 66 | ### That You Think 67 | ### Might be Useful 68 | 69 | ## License 70 | 71 | Copyright © 2025 Adi 72 | 73 | _EPLv1.0 is just the default for projects generated by `deps-new`: you are not_ 74 | _required to open source this project, nor are you required to use EPLv1.0!_ 75 | _Feel free to remove or change the `LICENSE` file and remove or update this_ 76 | _section of the `README.md` file!_ 77 | 78 | Distributed under the Eclipse Public License version 1.0. 79 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:refer-clojure :exclude [test]) 3 | (:require [clojure.tools.build.api :as b])) 4 | 5 | (def lib 'net.clojars.org/evalapply/smol-web-app) 6 | (def version "0.1.0-SNAPSHOT") 7 | (def main 'org.evalapply.smol-web-app) 8 | (def class-dir "target/classes") 9 | 10 | (defn test "Run all the tests." [opts] 11 | (let [basis (b/create-basis {:aliases [:test]}) 12 | cmds (b/java-command 13 | {:basis basis 14 | :main 'clojure.main 15 | :main-args ["-m" "cognitect.test-runner"]}) 16 | {:keys [exit]} (b/process cmds)] 17 | (when-not (zero? exit) (throw (ex-info "Tests failed" {})))) 18 | opts) 19 | 20 | (defn- uber-opts [opts] 21 | (assoc opts 22 | :lib lib :main main 23 | :uber-file (format "target/%s-%s.jar" lib version) 24 | :basis (b/create-basis {}) 25 | :class-dir class-dir 26 | :src-dirs ["src"] 27 | :ns-compile [main])) 28 | 29 | (defn ci "Run the CI pipeline of tests (and build the uberjar)." [opts] 30 | (test opts) 31 | (b/delete {:path "target"}) 32 | (let [opts (uber-opts opts)] 33 | (println "\nCopying source...") 34 | (b/copy-dir {:src-dirs ["resources" "src"] :target-dir class-dir}) 35 | (println (str "\nCompiling " main "...")) 36 | (b/compile-clj opts) 37 | (println "\nBuilding JAR...") 38 | (b/uber opts)) 39 | opts) 40 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {org.clojure/clojure {:mvn/version "1.12.0"} 3 | ring/ring-jetty-adapter {:mvn/version "1.13.0"}} 4 | :aliases 5 | {:run-m {:main-opts ["-m" "org.evalapply.smol-web-app"]} 6 | :run-x {:ns-default org.evalapply.smol-web-app 7 | :exec-fn greet 8 | :exec-args {:name "Clojure"}} 9 | :build {:deps {io.github.clojure/tools.build 10 | {:mvn/version "0.10.5"}} 11 | :ns-default build} 12 | :dev {:extra-deps 13 | {clj-http/clj-http {:mvn/version "3.12.3"}}} 14 | :test {:extra-paths ["test"] ; clj -X:dev:test # at the command line 15 | :extra-deps {org.clojure/test.check {:mvn/version "1.1.1"} 16 | io.github.cognitect-labs/test-runner 17 | {:git/tag "v0.5.1" :git/sha "dfb30dd"}} 18 | :main 'clojure.main 19 | :exec-fn cognitect.test-runner.api/test 20 | :main-args ["-m" "cognitect.test-runner"]}}} 21 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to org/evalapply/smol-web-app 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) 4 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/resources/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/fnconf2025/smolwebapp/resources/.keep -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/src/org/evalapply/router/core.clj: -------------------------------------------------------------------------------- 1 | (ns org.evalapply.router.core 2 | (:require [clojure.string :as s])) 3 | 4 | ;; Routes as of this commit from seancorfield/usermanager-example: 5 | ;; https://github.com/seancorfield/usermanager-example/blob/2a9cf635cf255bf223486bc9e907a02435c7201c/src/usermanager/main.clj#L113 6 | ;; 7 | ;; (GET "/" [] (wrap #'user-ctl/default)) 8 | ;; ;; horrible: application should POST to this URL! 9 | ;; (GET "/user/delete/:id{[0-9]+}" [id :<< as-int] (wrap #'user-ctl/delete-by-id)) 10 | ;; ;; add a new user: 11 | ;; (GET "/user/form" [] (wrap #'user-ctl/edit)) 12 | ;; ;; edit an existing user: 13 | ;; (GET "/user/form/:id{[0-9]+}" [id :<< as-int] (wrap #'user-ctl/edit)) 14 | ;; (GET "/user/list" [] (wrap #'user-ctl/get-users)) 15 | ;; (POST "/user/save" [] (wrap #'user-ctl/save)) 16 | ;; ;; this just resets the change tracker but really should be a POST :) 17 | ;; (GET "/reset" [] (wrap #'user-ctl/reset-changes)) 18 | ;; (route/resources "/") 19 | ;; (route/not-found "Not Found") 20 | 21 | 22 | #_(def router nil) ; evaluate to reset defmulti after modifying dispatch function 23 | (defmulti router 24 | (fn [_handler {:keys [request-method uri] :as _request}] 25 | [request-method (s/replace uri #"\d+" ":id")])) 26 | 27 | (defmethod router :default 28 | [_handler _request] 29 | {:status 404 30 | :headers {} 31 | :body "Not Found."}) 32 | 33 | (defmethod router [:get "/"] 34 | [handler request] 35 | (handler request)) 36 | 37 | (defmethod router [:delete "/user/delete/:id"] 38 | [handler request] 39 | (handler request)) 40 | 41 | (defmethod router [:get "/user/form"] 42 | [handler request] 43 | (handler request)) 44 | 45 | (defmethod router [:get "/user/form/:id"] 46 | [handler request] 47 | (handler request)) 48 | 49 | (defmethod router [:get "/user/list"] 50 | [handler request] 51 | (handler request)) 52 | 53 | (defmethod router [:post "/user/save"] 54 | [handler request] 55 | (handler request)) 56 | 57 | (defmethod router [:get "/reset"] 58 | [handler request] 59 | (handler request)) 60 | 61 | (comment 62 | 63 | (require '[org.evalapply.smol-web-app :as swa]) 64 | 65 | (router swa/echo-handler 66 | {:request-method :get :uri "/"}) 67 | 68 | (router swa/echo-handler 69 | {:request-method :delete :uri "/user/delete/42"}) 70 | 71 | (router swa/echo-handler 72 | {:request-method :post :uri "/"}) 73 | ) 74 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/src/org/evalapply/smol_web_app.clj: -------------------------------------------------------------------------------- 1 | (ns org.evalapply.smol-web-app 2 | (:require [ring.adapter.jetty :as adapter] 3 | [org.evalapply.router.core :as router]) 4 | (:gen-class)) 5 | 6 | (defn echo-handler 7 | [request] 8 | {:status 200 9 | :headers {"Content-Type" "text/plain;charset=utf-8"} 10 | :body (format "echoing METHOD %s for PATH %s" 11 | (:request-method request) 12 | (:uri request))}) 13 | 14 | (defn wrap-router 15 | [handler] 16 | (fn [request] 17 | (router/router handler request))) 18 | 19 | (defn -main 20 | [& _args] 21 | (adapter/run-jetty (wrap-router echo-handler) 22 | {:port 3000 :join? false})) 23 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/test/org/evalapply/router/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns org.evalapply.router.core-test 2 | (:require [clojure.test :refer [deftest is are testing]] 3 | [org.evalapply.router.core :as erc] 4 | [org.evalapply.smol-web-app :as swa])) 5 | 6 | (defn- echo-response 7 | [method path] 8 | {:status 200 9 | :headers {"Content-Type" "text/plain;charset=utf-8"} 10 | :body (format "echoing METHOD %s for PATH %s" 11 | method path)}) 12 | 13 | (def not-found-response 14 | {:status 404 15 | :headers {} 16 | :body "Not Found."}) 17 | 18 | (deftest route-matching-test 19 | (testing "Only allowed route path patterns match." 20 | (are [route-call response] (= route-call response) 21 | 22 | (erc/router swa/echo-handler {:request-method :get :uri "/"}) 23 | (echo-response :get "/") 24 | 25 | (erc/router swa/echo-handler {:request-method :post :uri "/"}) 26 | not-found-response 27 | 28 | (erc/router swa/echo-handler {:request-method :post :uri "/does/not/exist"}) 29 | not-found-response 30 | 31 | (erc/router swa/echo-handler {:request-method :delete :uri "/user/delete/42"}) 32 | (echo-response :delete "/user/delete/42") 33 | 34 | (erc/router swa/echo-handler {:request-method :post :uri "/user/delete/42"}) 35 | not-found-response 36 | 37 | (erc/router swa/echo-handler {:request-method :delete :uri "/user/delete/NAN"}) 38 | not-found-response 39 | 40 | (erc/router swa/echo-handler {:request-method :get :uri "/user/form/42"}) 41 | (echo-response :get "/user/form/42") 42 | 43 | (erc/router swa/echo-handler {:request-method :post :uri "/user/form/42"}) 44 | not-found-response 45 | 46 | (erc/router swa/echo-handler {:request-method :form :uri "/user/form/NAN"}) 47 | not-found-response))) 48 | -------------------------------------------------------------------------------- /projects/fnconf2025/smolwebapp/test/org/evalapply/smol_web_app_test.clj: -------------------------------------------------------------------------------- 1 | (ns org.evalapply.smol-web-app-test 2 | (:require [clojure.test :refer :all] 3 | [clj-http.client :as http] 4 | [org.evalapply.smol-web-app :as swa])) 5 | 6 | (deftest a-simple-server-test 7 | (testing "A simple server test." 8 | (let [server (swa/-main) 9 | base-uri (.toString (.getURI server))] 10 | (is (= {:status 200 11 | :headers {"Content-Type" "text/plain;charset=utf-8"} 12 | :body "echoing METHOD :get for PATH /"} 13 | (-> (http/get base-uri) 14 | (select-keys [:status :body :headers]) 15 | (update :headers (fn [{:strs [Content-Type]}] 16 | {"Content-Type" Content-Type})))) 17 | "Server echoes back request information in body.") 18 | (is (= {:status 404 19 | :body "Not Found."} 20 | (-> (http/post base-uri {:throw-exceptions false}) 21 | (select-keys [:status :body]))) 22 | "Server rejects unsupported route pattern.") 23 | (.stop server)))) 24 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/.clj-kondo/imports/com.github.seancorfield/next.jdbc/config.edn: -------------------------------------------------------------------------------- 1 | {:hooks 2 | {:analyze-call 3 | {next.jdbc/with-transaction 4 | hooks.com.github.seancorfield.next-jdbc/with-transaction 5 | next.jdbc/with-transaction+options 6 | hooks.com.github.seancorfield.next-jdbc/with-transaction+options}} 7 | :lint-as {next.jdbc/on-connection clojure.core/with-open 8 | next.jdbc/on-connection+options clojure.core/with-open}} 9 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/.clj-kondo/imports/com.github.seancorfield/next.jdbc/hooks/com/github/seancorfield/next_jdbc.clj_kondo: -------------------------------------------------------------------------------- 1 | (ns hooks.com.github.seancorfield.next-jdbc 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn with-transaction 5 | "Expands (with-transaction [tx expr opts] body) 6 | to (let [tx expr] opts body) per clj-kondo examples." 7 | [{:keys [:node]}] 8 | (let [[binding-vec & body] (rest (:children node)) 9 | [sym val opts] (:children binding-vec)] 10 | (when-not (and sym val) 11 | (throw (ex-info "No sym and val provided" {}))) 12 | (let [new-node (api/list-node 13 | (list* 14 | (api/token-node 'let) 15 | (api/vector-node [sym val]) 16 | opts 17 | body))] 18 | {:node new-node}))) 19 | 20 | (defn with-transaction+options 21 | "Expands (with-transaction+options [tx expr opts] body) 22 | to (let [tx expr] opts body) per clj-kondo examples." 23 | [{:keys [:node]}] 24 | (let [[binding-vec & body] (rest (:children node)) 25 | [sym val opts] (:children binding-vec)] 26 | (when-not (and sym val) 27 | (throw (ex-info "No sym and val provided" {}))) 28 | (let [new-node (api/list-node 29 | (list* 30 | (api/token-node 'let) 31 | (api/vector-node [sym val]) 32 | opts 33 | body))] 34 | {:node new-node}))) 35 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/.clj-kondo/imports/hiccup/hiccup/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {hiccup.def/defhtml clojure.core/defn} 2 | :hooks {:analyze-call {hiccup.def/defelem hiccup.hooks/defelem}}} 3 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/.clj-kondo/imports/hiccup/hiccup/hiccup/hooks.clj: -------------------------------------------------------------------------------- 1 | (ns hiccup.hooks 2 | (:require [clj-kondo.hooks-api :as api] 3 | [clojure.set :as set])) 4 | 5 | ;; See https://github.com/clj-kondo/clj-kondo/blob/master/doc/hooks.md 6 | 7 | (defn- parse-defn [elems] 8 | (let [[fhead fbody] (split-with #(not (or (api/vector-node? %) 9 | (api/list-node? %))) 10 | elems) 11 | arities (if (api/vector-node? (first fbody)) 12 | (list (api/list-node fbody)) 13 | fbody)] 14 | [fhead arities])) 15 | 16 | (defn- count-args [arity] 17 | (let [args (first (api/sexpr arity))] 18 | (if (= '& (fnext (reverse args))) 19 | true ; unbounded args 20 | (count args)))) 21 | 22 | (defn- dummy-arity [arg-count] 23 | (api/list-node 24 | (list 25 | (api/vector-node 26 | (vec (repeat arg-count (api/token-node '_))))))) 27 | 28 | (defn defelem [{:keys [node]}] 29 | (let [[_ & rest] (:children node) 30 | [fhead arities] (parse-defn rest) 31 | arg-counts (set (filter number? (map count-args arities))) 32 | dummy-arg-counts (set/difference (set (map inc arg-counts)) arg-counts) 33 | dummy-arities (for [n dummy-arg-counts] (dummy-arity n))] 34 | {:node 35 | (api/list-node 36 | (list* 37 | (api/token-node 'clojure.core/defn) 38 | (concat fhead arities dummy-arities)))})) 39 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/.gitignore: -------------------------------------------------------------------------------- 1 | .calva/output-window/ 2 | .calva/repl.calva-repl 3 | .classpath 4 | .clj-kondo/.cache 5 | .cpcache 6 | .eastwood 7 | .factorypath 8 | .hg/ 9 | .hgignore 10 | .java-version 11 | .lein-* 12 | .lsp/.cache 13 | .lsp/sqlite.db 14 | .nrepl-history 15 | .nrepl-port 16 | .portal/vs-code.edn 17 | .project 18 | .rebel_readline_history 19 | .settings 20 | .socket-repl-port 21 | .sw* 22 | .vscode 23 | *.class 24 | *.jar 25 | *.swp 26 | *~ 27 | /checkouts 28 | /classes 29 | /target 30 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). 3 | 4 | ## [Unreleased] 5 | ### Changed 6 | - Add a new arity to `make-widget-async` to provide a different widget shape. 7 | 8 | ## [0.1.1] - 2025-01-07 9 | ### Changed 10 | - Documentation on how to make the widgets. 11 | 12 | ### Removed 13 | - `make-widget-sync` - we're all async, all the time. 14 | 15 | ### Fixed 16 | - Fixed widget maker to keep working when daylight savings switches over. 17 | 18 | ## 0.1.0 - 2025-01-07 19 | ### Added 20 | - Files from the new template. 21 | - Widget maker public API - `make-widget-sync`. 22 | 23 | [Unreleased]: https://github.com/usermanager/main/compare/0.1.1...HEAD 24 | [0.1.1]: https://github.com/usermanager/main/compare/0.1.0...0.1.1 25 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/README.md: -------------------------------------------------------------------------------- 1 | # usermanager/main 2 | 3 | FIXME: my new application. 4 | 5 | ## Installation 6 | 7 | Download from https://github.com/usermanager/main 8 | 9 | ## Usage 10 | 11 | FIXME: explanation 12 | 13 | Run the project directly, via `:exec-fn`: 14 | 15 | $ clojure -X:run-x 16 | Hello, Clojure! 17 | 18 | Run the project, overriding the name to be greeted: 19 | 20 | $ clojure -X:run-x :name '"Someone"' 21 | Hello, Someone! 22 | 23 | Run the project directly, via `:main-opts` (`-m usermanager.main`): 24 | 25 | $ clojure -M:run-m 26 | Hello, World! 27 | 28 | Run the project, overriding the name to be greeted: 29 | 30 | $ clojure -M:run-m Via-Main 31 | Hello, Via-Main! 32 | 33 | Run the project's tests (they'll fail until you edit them): 34 | 35 | $ clojure -T:build test 36 | 37 | Run the project's CI pipeline and build an uberjar (this will fail until you edit the tests to pass): 38 | 39 | $ clojure -T:build ci 40 | 41 | This will produce an updated `pom.xml` file with synchronized dependencies inside the `META-INF` 42 | directory inside `target/classes` and the uberjar in `target`. You can update the version (and SCM tag) 43 | information in generated `pom.xml` by updating `build.clj`. 44 | 45 | If you don't want the `pom.xml` file in your project, you can remove it. The `ci` task will 46 | still generate a minimal `pom.xml` as part of the `uber` task, unless you remove `version` 47 | from `build.clj`. 48 | 49 | Run that uberjar: 50 | 51 | $ java -jar target/net.clojars.usermanager/main-0.1.0-SNAPSHOT.jar 52 | 53 | ## Options 54 | 55 | FIXME: listing of options this app accepts. 56 | 57 | ## Examples 58 | 59 | ... 60 | 61 | ### Bugs 62 | 63 | ... 64 | 65 | ### Any Other Sections 66 | ### That You Think 67 | ### Might be Useful 68 | 69 | ## License 70 | 71 | Copyright © 2025 Adi 72 | 73 | _EPLv1.0 is just the default for projects generated by `deps-new`: you are not_ 74 | _required to open source this project, nor are you required to use EPLv1.0!_ 75 | _Feel free to remove or change the `LICENSE` file and remove or update this_ 76 | _section of the `README.md` file!_ 77 | 78 | Distributed under the Eclipse Public License version 1.0. 79 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:refer-clojure :exclude [test]) 3 | (:require [clojure.tools.build.api :as b])) 4 | 5 | (def lib 'net.clojars.usermanager/main) 6 | (def version "0.1.0-SNAPSHOT") 7 | (def main 'usermanager.main) 8 | (def class-dir "target/classes") 9 | 10 | (defn test "Run all the tests." [opts] 11 | (let [basis (b/create-basis {:aliases [:test]}) 12 | cmds (b/java-command 13 | {:basis basis 14 | :main 'clojure.main 15 | :main-args ["-m" "cognitect.test-runner"]}) 16 | {:keys [exit]} (b/process cmds)] 17 | (when-not (zero? exit) (throw (ex-info "Tests failed" {})))) 18 | opts) 19 | 20 | (defn- uber-opts [opts] 21 | (assoc opts 22 | :lib lib :main main 23 | :uber-file (format "target/%s-%s.jar" lib version) 24 | :basis (b/create-basis {}) 25 | :class-dir class-dir 26 | :src-dirs ["src"] 27 | :ns-compile [main])) 28 | 29 | (defn ci "Run the CI pipeline of tests (and build the uberjar)." [opts] 30 | (test opts) 31 | (b/delete {:path "target"}) 32 | (let [opts (uber-opts opts)] 33 | (println "\nCopying source...") 34 | (b/copy-dir {:src-dirs ["resources" "src"] :target-dir class-dir}) 35 | (println (str "\nCompiling " main "...")) 36 | (b/compile-clj opts) 37 | (println "\nBuilding JAR...") 38 | (b/uber opts)) 39 | opts) 40 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "classes" "resources"] 2 | :deps 3 | {org.clojure/clojure {:mvn/version "1.11.3"} 4 | ;; Embedded Jetty server and HTTP adapter 5 | ring/ring-jetty-adapter {:mvn/version "1.12.1"} 6 | ;; HTTP utilities 7 | ring/ring {:mvn/version "1.12.1"} 8 | ring/ring-defaults {:mvn/version "0.5.0"} 9 | ;; JDBC database adapter 10 | com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"} 11 | ;; SQLite JDBC driver 12 | org.xerial/sqlite-jdbc {:mvn/version "3.46.1.0"} 13 | 14 | ;; Hiccup for HTML as Clojure data, server-rendered 15 | hiccup/hiccup {:mvn/version "2.0.0-RC3"}} 16 | :aliases 17 | {:dev {:extra-deps 18 | {clj-http/clj-http {:mvn/version "3.12.3"}}} 19 | :test {;; clj -X:dev:test # at the command line 20 | :extra-paths ["test"] 21 | :extra-deps 22 | {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" 23 | :git/sha "dfb30dd"}} 24 | :main-opts ["-m" "cognitect.test-runner"] 25 | :exec-fn cognitect.test-runner.api/test} 26 | :build {:replace-deps {io.github.clojure/tools.build 27 | {:mvn/version "0.9.6"}} 28 | :ns-default build}}} 29 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to usermanager/main 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) 4 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/resources/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/projects/usermanager-first-principles/resources/.keep -------------------------------------------------------------------------------- /projects/usermanager-first-principles/resources/public/assets/css/style.css: -------------------------------------------------------------------------------- 1 | :root { 2 | font-family: -apple-system, BlinkMacSystemFont, avenir next, 3 | avenir, segoe ui, helvetica neue, helvetica, Cantarell, 4 | Ubuntu, roboto, noto, arial, sans-serif; 5 | line-height: 1.5rem; 6 | font-size: 1rem; 7 | --max-width: 72ch; 8 | } 9 | 10 | * { 11 | max-width: var(--max-width); 12 | } 13 | 14 | html, body, div, header, main { 15 | max-width: none; 16 | } 17 | 18 | body { 19 | overflow-x: hidden; 20 | } 21 | 22 | hr { 23 | margin: 0; 24 | border: none; 25 | height: 0.2em; 26 | background-color: black; 27 | } 28 | 29 | form hr { 30 | height: 0.05em; 31 | background-color: grey; 32 | } 33 | 34 | nav { 35 | display: flex; 36 | list-style-type: none; 37 | gap: 1rem; 38 | } 39 | 40 | table { 41 | overflow-x: auto; 42 | max-width: 72ch; 43 | table-layout: fixed; 44 | border-collapse: collapse; 45 | text-align: left; 46 | border: thin dashed; 47 | } 48 | 49 | th, td { 50 | padding: 0.5rem; 51 | border: thin dashed; 52 | } 53 | 54 | label, input, select, options { 55 | min-width: 18ch; 56 | } 57 | 58 | input { 59 | padding: 0.25em; 60 | width: 30ch; 61 | } 62 | 63 | select, #submit_button { 64 | padding: 0.25em; 65 | width: 31ch; 66 | } 67 | 68 | .stack { 69 | display: flex; 70 | flex-direction: column; 71 | justify-content: flex-start; 72 | } 73 | 74 | .stack > * { 75 | margin-top: 0; 76 | margin-bottom: 0; 77 | } 78 | 79 | .stack > * + * { 80 | margin-top: 1em; 81 | } 82 | 83 | .center { 84 | box-sizing: content-box; 85 | margin-left: auto; 86 | margin-right: auto; 87 | max-width: var(--max-width); 88 | } 89 | 90 | .cluster { 91 | display: flex; 92 | flex-wrap: wrap; 93 | gap: 0.2rem; 94 | justify-content: flex-start; 95 | align-items: center; 96 | } 97 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/handlers/user.clj: -------------------------------------------------------------------------------- 1 | ;; copyright (c) 2019-2023 Sean Corfield, all rights reserved 2 | 3 | (ns usermanager.handlers.user 4 | "Compare with \"controllers\" from seancorfield/usermanager-example 5 | 6 | Ref: https://github.com/seancorfield/usermanager-example/blob/develop/src/usermanager/controllers/user.clj 7 | " 8 | (:require [usermanager.model.user-manager :as model] 9 | [usermanager.http.utils :as resp] 10 | [usermanager.layouts.core :as ulc] 11 | [hiccup.page :as hp])) 12 | 13 | (defn echo 14 | [request] 15 | (-> (format "echoing METHOD %s for PATH %s" 16 | (:request-method request) 17 | (:uri request)) 18 | (resp/response (:headers request)) 19 | (resp/content-type "text/plain;charset=utf-8"))) 20 | 21 | (defn not-found 22 | [_request] 23 | (resp/not-found "Not Found.")) 24 | 25 | (def ^:private changes 26 | "Count the number of changes (since the last reload)." 27 | (atom 0)) 28 | 29 | (defn render-page 30 | "Each handler function here adds :application/view to the request 31 | data to indicate which view file they want displayed. This allows 32 | us to put the rendering logic in one place instead of repeating it 33 | for every handler." 34 | [req] 35 | (let [req (assoc-in req [:params :changes] @changes)] 36 | (-> req 37 | (ulc/hydrate-view) 38 | (hp/html5) 39 | (str) 40 | (resp/response) 41 | (resp/content-type "text/html")))) 42 | 43 | (comment 44 | (render-page {:request-method :get :uri "/"})) 45 | 46 | (defn reset-changes 47 | [req] 48 | (reset! changes 0) 49 | (assoc-in req [:params :message] (format "The change tracker has been reset to %s." 50 | @changes))) 51 | 52 | (defn default 53 | [req] 54 | (assoc-in req [:params :message] 55 | (str "Welcome to the User Manager application demo! " 56 | "This is a first principles version of searncorfield/usermanager-example."))) 57 | 58 | (defn delete-by-id 59 | "Compojure has already coerced the :id parameter to an int." 60 | [req] 61 | (swap! changes inc) 62 | (model/delete-user-by-id (-> req :application/component :database) 63 | (get-in req [:params :id])) 64 | (resp/redirect "/user/list")) 65 | 66 | (defn edit 67 | "Display the add/edit form. 68 | 69 | If the :id parameter is present, Compojure will have coerced it to an 70 | int and we can use it to populate the edit form by loading that user's 71 | data from the addressbook." 72 | [req] 73 | (let [db (-> req :application/component :database) 74 | user (when-let [id (get-in req [:params :id])] 75 | (model/get-user-by-id db id))] 76 | (-> req 77 | (update :params assoc 78 | :user user 79 | :departments (model/get-departments db)) 80 | (assoc :application/view "form")))) 81 | 82 | (defn get-users 83 | "Render the list view with all the users in the addressbook." 84 | [req] 85 | (let [users (model/get-users (-> req :application/component :database))] 86 | (-> req 87 | (assoc-in [:params :users] users) 88 | (assoc :application/view "list")))) 89 | 90 | (defn save 91 | "This works for saving new users as well as updating existing users, by 92 | delegatin to the model, and either passing nil for :addressbook/id or 93 | the numeric value that was passed to the edit form." 94 | [req] 95 | (swap! changes inc) 96 | (-> req 97 | :params 98 | ;; get just the form fields we care about: 99 | (select-keys [:id :first_name :last_name :email :department_id]) 100 | ;; convert form fields to numeric: 101 | (update :id #(some-> % not-empty Long/parseLong)) 102 | (update :department_id #(some-> % not-empty Long/parseLong)) 103 | ;; qualify their names for domain model: 104 | (->> (reduce-kv (fn [m k v] (assoc! m (keyword "addressbook" (name k)) v)) 105 | (transient {})) 106 | (persistent!) 107 | (model/save-user (-> req :application/component :database)))) 108 | (resp/redirect "/user/list")) 109 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/http/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.http.middleware 2 | (:require 3 | [usermanager.http.utils :as resp] 4 | [usermanager.handlers.user :as handlers] 5 | [usermanager.system.core :as system])) 6 | 7 | (defn wrap-message-param-in-response-header 8 | [handler] 9 | (fn [request] 10 | (let [context (handler request) 11 | message (get-in context [:params :message])] 12 | (if message 13 | (-> context 14 | (resp/header "UM-Message" message)) 15 | context)))) 16 | 17 | (defn wrap-echo 18 | [handler] 19 | (fn [request] 20 | (let [context (handler request)] 21 | (if (resp/response? context) 22 | context 23 | (handlers/echo context))))) 24 | 25 | (defn wrap-db 26 | ([handler] 27 | (wrap-db handler ::system/db)) 28 | ([handler db-key] 29 | (fn [request] 30 | (let [request (assoc-in request 31 | [:application/component :database] 32 | (system/get-db db-key))] 33 | (handler request))))) 34 | 35 | (defn wrap-grug-db 36 | [handler {{:keys [database]} :application/component 37 | :as system-components}] 38 | (fn [request] 39 | (let [system-components (assoc-in system-components 40 | [:application/component :database] 41 | ;; Database must be a callable object, for compatibility 42 | ;; with Sean's impl. that we ported over into 43 | ;; usermanager-first-principles 44 | (constantly database)) 45 | request (merge request system-components)] 46 | (handler request)))) 47 | 48 | (defn wrap-route-id-params 49 | [handler uri-static-prefix-with-slash] 50 | (fn [request] 51 | (let [uri (:uri request) 52 | pattern (re-pattern (str uri-static-prefix-with-slash "(\\d+)")) 53 | [_uri id] (re-find pattern uri)] 54 | (if id 55 | (-> request 56 | (assoc-in [:params :id] (Integer/parseInt id)) 57 | (handler)) 58 | (handler request))))) 59 | 60 | (defn wrap-render-page 61 | [handler] 62 | (fn [request] 63 | (let [context (handler request)] 64 | (if (resp/response? context) 65 | context 66 | (handlers/render-page context))))) 67 | 68 | (comment 69 | (let [pattern (re-pattern (str "/user/delete" "/(\\d+)"))] 70 | (re-find pattern "/user/delete/1"))) 71 | 72 | (comment 73 | ((wrap-route-id-params 74 | identity 75 | "/some/prefix/path/") 76 | {:uri "/some/prefix/path/1337"}) 77 | 78 | ((wrap-message-param-in-response-header 79 | identity) {:params {:message :hello}}) 80 | 81 | ((wrap-message-param-in-response-header 82 | (fn [request] 83 | (assoc request :params {:message "foo"}))) 84 | {:request-method :get :uri "/"}) 85 | 86 | ((wrap-echo 87 | (wrap-message-param-in-response-header 88 | (fn [request] 89 | (assoc request :params {:message "foo"})))) 90 | {:request-method :get :uri "/"}) 91 | 92 | (let [composed-middleware (apply comp [wrap-message-param-in-response-header wrap-echo]) 93 | handler (fn [request] 94 | (assoc request :params {:message "foo"}))] 95 | ((composed-middleware handler) 96 | {:request-method :get :uri "/"}))) 97 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/http/utils.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.http.utils) 2 | 3 | (defn status 4 | "Set or override status of response." 5 | [response status-code] 6 | (assoc response :status status-code)) 7 | 8 | (defn header 9 | [response header-name header-value] 10 | (assoc-in response [:headers header-name] header-value)) 11 | 12 | (defn content-type 13 | [response content-type] 14 | (header response "Content-Type" content-type)) 15 | 16 | (defn response 17 | "Skeleton response with status 200 OK." 18 | ([body] 19 | (response body {})) 20 | ([body headers] 21 | {:status 200 22 | :headers headers 23 | :body body})) 24 | 25 | (defn response? 26 | "Pinched from Ring utilities. True if the supplied value 27 | is a valid response map." 28 | [resp] 29 | (and (map? resp) 30 | (integer? (:status resp)) 31 | (map? (:headers resp)))) 32 | 33 | (defn not-found 34 | [body] 35 | {:status 404 36 | :headers {} 37 | :body body}) 38 | 39 | (defn redirect 40 | [uri] 41 | {:status 303 42 | :headers {"Location" uri} 43 | :body ""}) 44 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/layouts/core.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.layouts.core 2 | (:require [hiccup.page :as hp] 3 | [hiccup.form :as form])) 4 | 5 | (defn css 6 | [] 7 | (slurp "projects/usermanager-first-principles/resources/public/assets/css/style.css")) 8 | 9 | (defn page-head 10 | [page-name] 11 | [:head 12 | [:meta {:charset "utf-8"}] 13 | [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}] 14 | [:title (format "%s / %s" "User Manager" page-name)] 15 | [:style (css)]]) 16 | 17 | (defn page-header 18 | [page-name] 19 | [:header {:id "site-header"} 20 | [:h2 "User Manager / " [:small [:small page-name]]] 21 | [:nav #_{:class "cluster"} 22 | [:a {:href "/"} "Home"] 23 | [:a {:href "/user/list" 24 | :title "View the list of users"} 25 | "List users"] 26 | [:a {:href "/user/form" 27 | :title "Fill out form to add new user"} 28 | "Add user"] 29 | [:a {:href "/reset" 30 | :title "Reset change tracking"} 31 | "Reset"]]]) 32 | 33 | (defn page-footer 34 | [changes] 35 | [:footer {:id "site-footer" :class "stack"} 36 | [:hr] 37 | (when changes 38 | [:p (format "You have made %s change(s) since the last reset!" 39 | changes)])]) 40 | 41 | (defn page-layout 42 | [{:keys [page-name 43 | content 44 | footer] 45 | :or {page-name "" 46 | content [:p [:strong "Sorry, no content available."]] 47 | footer (page-footer nil)}}] 48 | (list 49 | (page-head page-name) 50 | [:body 51 | [:div {:id "site-top" :class "stack center"} 52 | (page-header page-name) 53 | [:main {:id "main"} 54 | (if (string? content) 55 | [:p content] 56 | content)] 57 | footer]])) 58 | 59 | (defn users-table 60 | [users] 61 | (let [table-headers ["ID" "Name" "Email" "Department" "Manage"]] 62 | [:table 63 | [:thead 64 | [:tr (for [field table-headers] 65 | [:th field])]] 66 | [:tbody 67 | (if (not-empty users) 68 | (map (fn user-table-row 69 | [{:addressbook/keys [id first_name last_name email] 70 | department :department/name}] 71 | (let [name [:a {:href (str "/user/form/" id)} 72 | (format "%s %s" first_name last_name)] 73 | action [:a {:href (str "/user/delete/" id)} "DELETE"]] 74 | [:tr (for [field [id name email department action]] 75 | [:td field])])) 76 | users) 77 | (list [:tr [:td {:colspan (count table-headers)} 78 | "No users exist but " 79 | [:a {:href "/user/form"} "new ones can be added"] "."]]))]])) 80 | 81 | (defn user-info-form 82 | [{:addressbook/keys [id first_name last_name email department_id] 83 | :as _user} 84 | departments] 85 | (form/form-to 86 | {:class "stack"} [:post "/user/save"] 87 | 88 | (form/hidden-field {:id id} "id" id) 89 | 90 | [:div {:class "cluster"} 91 | (form/label "first_name" "First Name:") 92 | (form/text-field {:id "first_name" :value first_name} 93 | "first_name" first_name)] 94 | 95 | [:div {:class "cluster"} 96 | (form/label "last_name" "Last Name:") 97 | (form/text-field {:id "last_name" :value last_name} 98 | "last_name" last_name)] 99 | 100 | [:div {:class "cluster"} 101 | (form/label "email" "Email:") 102 | (form/text-field {:id "email" :value email} 103 | "email" email)] 104 | 105 | [:div {:class "cluster"} 106 | (form/label "department_id" "Department Id:") 107 | [:select {:name "department_id" :id "department_id"} 108 | (form/select-options 109 | (for [{:department/keys [name id]} departments] 110 | [name id]) 111 | department_id)]] 112 | 113 | [:hr] 114 | [:div {:class "cluster"} 115 | (form/label "submit_button" "Add or Update user:") 116 | (form/submit-button {:id "submit_button"} "Submit")])) 117 | 118 | (def uri->page-name 119 | {"/" "Home" 120 | "/user/list" "List users" 121 | "/user/form" "Add or Update user" 122 | "/reset" "Reset change tracker"}) 123 | 124 | (defmulti hydrate-view 125 | :application/view) 126 | 127 | (defmethod hydrate-view :default 128 | [{:keys [params] :as request}] 129 | (let [content (or (:content params) 130 | (:message params)) 131 | page-matter (merge {:footer (page-footer (:changes params))} 132 | (when content {:content content}) 133 | {:page-name (uri->page-name (:uri request) "")})] 134 | (page-layout page-matter))) 135 | 136 | (defmethod hydrate-view "list" 137 | [{:keys [params] :as request}] 138 | (-> request 139 | (assoc-in [:params :content] (users-table (:users params))) 140 | (assoc :application/view :default) 141 | (hydrate-view))) 142 | 143 | (defmethod hydrate-view "form" 144 | [{:keys [params] :as request}] 145 | (-> request 146 | (assoc-in [:params :content] 147 | (user-info-form (:user params) 148 | (:departments params))) 149 | (assoc :application/view :default) 150 | (hydrate-view))) 151 | 152 | (comment 153 | (users-table 154 | [{:addressbook/id 1, 155 | :addressbook/first_name "Sean", 156 | :addressbook/last_name "Corfield", 157 | :addressbook/email "sean@worldsingles.com", 158 | :addressbook/department_id 4, 159 | :department/name "Development"}]) 160 | 161 | (user-info-form {:id 1, 162 | :first_name "Sean", 163 | :last_name "Corfield", 164 | :email "sean@worldsingles.com", 165 | :department_id 4, 166 | :department/name "Development"} 167 | [{:department/id 1 :department/name "foo"} 168 | {:department/id 2 :department/name "bar"} 169 | {:department/id 3 :department/name "baz"}]) 170 | 171 | (hp/html5 (page-layout {:footer (page-footer 42)}))) 172 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/main.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.main 2 | "Compare with seancorfield/usermanager-example 3 | https://github.com/seancorfield/usermanager-example/blob/develop/src/usermanager/main.clj 4 | 5 | This project is a \"from first principles\" variant of Sean's project 6 | (synced as of commit SHA 2a9cf63). 7 | 8 | It follows up the explanation laid out in Clojuring the web 9 | application stack: Meditation One: 10 | https://www.evalapply.org/posts/clojure-web-app-from-scratch/index.html. 11 | 12 | If nothing else, it exists to scratch one's own itch. 13 | 14 | Sean's repo references variants of the same basic \"User Manager\" web 15 | application. All of these are built with libraries used by Clojure 16 | professionals in production web apps. 17 | 18 | This variant uses only a small fraction of those dependencies; bare 19 | essentials like adapters for Jetty, SQLite, and HTML rendering. Also 20 | some ring middleware that handles HTML form data. Everything else is 21 | hand-rolled Clojure. 22 | 23 | The resulting app is not fit for production deployment. Expose it to 24 | the Public Internet only on a throway server instance." 25 | (:gen-class) 26 | (:require 27 | [ring.middleware.params :as params-middleware] 28 | [ring.middleware.keyword-params :as keyword-params-middleware] 29 | [usermanager.router.core :as router] 30 | [usermanager.system.core :as system] 31 | [usermanager.http.middleware :as middleware] 32 | [usermanager.model.user-manager :as model] 33 | [com.adityaathalye.grugstack.settings.core :as grug-settings] 34 | [com.adityaathalye.grugstack.system.core :as grug-system])) 35 | 36 | (defonce dev-system nil) 37 | 38 | (def middleware-stack 39 | [keyword-params-middleware/wrap-keyword-params 40 | params-middleware/wrap-params 41 | middleware/wrap-db 42 | middleware/wrap-render-page]) 43 | 44 | (defn wrap-grug-middleware 45 | [handler system-components] 46 | (-> handler 47 | middleware/wrap-render-page 48 | keyword-params-middleware/wrap-keyword-params 49 | params-middleware/wrap-params 50 | (middleware/wrap-grug-db system-components))) 51 | 52 | (defn wrap-router 53 | ([router] 54 | (wrap-router router ::system/middleware)) 55 | ([router middleware-key] 56 | (system/set-config! middleware-key {:stack middleware-stack}) 57 | (system/start-middleware-stack! middleware-key) 58 | (fn [request] 59 | (let [request-handler (router request) 60 | app-handler (system/wrap-middleware 61 | request-handler 62 | middleware-key)] 63 | (app-handler request))))) 64 | 65 | (defn ->grug-app-handler 66 | ([system-components] 67 | (->grug-app-handler system-components router/router wrap-grug-middleware)) 68 | ([system-components router] 69 | (->grug-app-handler system-components router wrap-grug-middleware)) 70 | ([system-components router wrap-middleware] 71 | (fn [request] 72 | (let [handler (router request) 73 | app-handler (wrap-middleware handler system-components)] 74 | (app-handler request))))) 75 | 76 | (defn -main-legacy 77 | [& [port]] 78 | (let [server-config (system/get-config ::system/server) 79 | port (or port 80 | (get (System/getenv) "PORT") 81 | (get (system/get-config ::system/server) 82 | (:port server-config) 83 | 3000)) 84 | port (if (string? port) 85 | (Integer/parseInt port) 86 | port)] 87 | (println "Setting up DB having dbname: " 88 | (:dbname (system/get-config ::system/db))) 89 | (system/start-db! model/populate) 90 | (println "Starting up Server on port: " port) 91 | (system/set-config! ::system/server 92 | (assoc server-config :port port)) 93 | (system/start-server! (wrap-router router/router)))) 94 | 95 | (defn -main 96 | [& args] 97 | (let [settings-file (or (first args) 98 | "usermanager/settings.edn") 99 | settings (grug-settings/make-settings 100 | (grug-settings/read-settings! settings-file) 101 | {}) 102 | system (grug-system/init settings)] 103 | (alter-var-root #'dev-system (constantly system)) 104 | (-> system 105 | :com.adityaathalye.grugstack.system.server-simple/server 106 | :object))) 107 | 108 | (comment 109 | 110 | (grug-system/expand 111 | (grug-settings/make-settings 112 | (grug-settings/read-settings! "usermanager/settings.edn") 113 | {})) 114 | 115 | (-main) 116 | 117 | (.stop (-> dev-system 118 | :com.adityaathalye.grugstack.system.server-simple/server 119 | :object)) 120 | 121 | (let [dev-db-file "dev/usermanager_dev_db.sqlite3"] 122 | (require 'clojure.java.io) 123 | (system/stop-server!) 124 | (system/stop-db!) 125 | (clojure.java.io/delete-file dev-db-file) 126 | (system/evict-component! ::system/middleware) 127 | (system/set-config! ::system/db {:dbtype "sqlite" :dbname dev-db-file}) 128 | (system/start-db! model/populate) 129 | (system/start-server! (wrap-router router/router))) 130 | 131 | system/global-system 132 | (require 'clojure.reflect) 133 | (clojure.reflect/reflect (::system/server @system/global-system))) 134 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/model/user_manager.clj: -------------------------------------------------------------------------------- 1 | ;; copyright (c) 2019-2023 Sean Corfield, all rights reserved 2 | 3 | (ns usermanager.model.user-manager 4 | "The model for the application. This is where the persistence happens, 5 | although in a larger application, this would probably contain just the 6 | business logic and the persistence would be in a separate namespace. 7 | 8 | Compare with seancorfield/usermanager-example 9 | https://github.com/seancorfield/usermanager-example/blob/develop/src/usermanager/model/user_manager.clj" 10 | (:require [next.jdbc :as jdbc] 11 | [next.jdbc.sql :as sql] 12 | [next.jdbc.connection :as connection])) 13 | 14 | (def ^:private departments 15 | "List of departments." 16 | ["Accounting" "Sales" "Support" "Development"]) 17 | 18 | (def ^:private initial-user-data 19 | "Seed the database with this data." 20 | [{:first_name "Sean" :last_name "Corfield" 21 | :email "sean@worldsingles.com" :department_id 4}]) 22 | 23 | ;; database initialization 24 | 25 | (defn populate 26 | "Called at application startup. Attempts to create the 27 | database table and populate it. Takes no action if the 28 | database table already exists." 29 | [db] 30 | (let [auto-key "primary key autoincrement"] 31 | (try 32 | (jdbc/execute-one! (db) 33 | [(str " 34 | create table department ( 35 | id integer " auto-key ", 36 | name varchar(32) 37 | )")]) 38 | (jdbc/execute-one! (db) 39 | [(str " 40 | create table addressbook ( 41 | id integer " auto-key ", 42 | first_name varchar(32), 43 | last_name varchar(32), 44 | email varchar(64), 45 | department_id integer not null 46 | )")]) 47 | (println "Created database and addressbook table!") 48 | ;; if table creation was successful, it didn't exist before 49 | ;; so populate it... 50 | (try 51 | (doseq [d departments] 52 | (sql/insert! (db) :department {:name d})) 53 | (doseq [row initial-user-data] 54 | (sql/insert! (db) :addressbook row)) 55 | (println "Populated database with initial data!") 56 | (catch Exception e 57 | (println "Exception:" (ex-message e)) 58 | (println "Unable to populate the initial data -- proceed with caution!"))) 59 | (catch Exception e 60 | (println "Exception:" (ex-message e)) 61 | (println "Looks like the database is already setup?"))))) 62 | 63 | (defn populate-grug 64 | "Grug-brained wrapper for the O.G. 'populate' migrator." 65 | [connection] 66 | (populate (constantly connection))) 67 | 68 | ;; data model access functions 69 | 70 | (defn get-department-by-id 71 | "Given a department ID, return the department record." 72 | [db id] 73 | (sql/get-by-id (db) :department id)) 74 | 75 | (defn get-departments 76 | "Return all available department records (in order)." 77 | [db] 78 | (sql/query (db) ["select * from department order by name"])) 79 | 80 | (defn get-user-by-id 81 | "Given a user ID, return the user record." 82 | [db id] 83 | (sql/get-by-id (db) :addressbook id)) 84 | 85 | (defn get-users 86 | "Return all available users, sorted by name. 87 | 88 | Since this is a join, the keys in the hash maps returned will 89 | be namespace-qualified by the table from which they are drawn: 90 | 91 | addressbook/id, addressbook/first_name, etc, department/name" 92 | [db] 93 | (sql/query (db) 94 | [" 95 | select a.*, d.name 96 | from addressbook a 97 | join department d on a.department_id = d.id 98 | order by a.last_name, a.first_name 99 | "])) 100 | 101 | (defn save-user 102 | "Save a user record. If ID is present and not zero, then 103 | this is an update operation, otherwise it's an insert." 104 | [db user] 105 | (let [id (:addressbook/id user)] 106 | (if (and id (not (zero? id))) 107 | ;; update 108 | (sql/update! (db) :addressbook 109 | (dissoc user :addressbook/id) 110 | {:id id}) 111 | ;; insert 112 | (sql/insert! (db) :addressbook 113 | (dissoc user :addressbook/id))))) 114 | 115 | (defn delete-user-by-id 116 | "Given a user ID, delete that user." 117 | [db id] 118 | (sql/delete! (db) :addressbook {:id id})) 119 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/router/core.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.router.core 2 | (:require [clojure.string :as s] 3 | [usermanager.handlers.user :as handlers] 4 | [usermanager.http.middleware :as middleware])) 5 | 6 | ;; Routes as of this commit from seancorfield/usermanager-example: 7 | ;; https://github.com/seancorfield/usermanager-example/blob/2a9cf635cf255bf223486bc9e907a02435c7201c/src/usermanager/main.clj#L113 8 | ;; 9 | ;; (GET "/" [] (wrap #'user-ctl/default)) 10 | ;; ;; horrible: application should POST to this URL! 11 | ;; (GET "/user/delete/:id{[0-9]+}" [id :<< as-int] (wrap #'user-ctl/delete-by-id)) 12 | ;; ;; add a new user: 13 | ;; (GET "/user/form" [] (wrap #'user-ctl/edit)) 14 | ;; ;; edit an existing user: 15 | ;; (GET "/user/form/:id{[0-9]+}" [id :<< as-int] (wrap #'user-ctl/edit)) 16 | ;; (GET "/user/list" [] (wrap #'user-ctl/get-users)) 17 | ;; (POST "/user/save" [] (wrap #'user-ctl/save)) 18 | ;; ;; this just resets the change tracker but really should be a POST :) 19 | ;; (GET "/reset" [] (wrap #'user-ctl/reset-changes)) 20 | ;; (route/resources "/") 21 | ;; (route/not-found "Not Found") 22 | 23 | #_(def router nil) ; evaluate to reset defmulti after modifying dispatch function 24 | (defmulti router 25 | (fn [{:keys [request-method uri] :as _request}] 26 | [request-method (s/replace uri #"\d+" ":id")])) 27 | 28 | (defmethod router :default 29 | [_request] 30 | handlers/not-found) 31 | 32 | (defmethod router [:get "/"] 33 | [_] 34 | handlers/default) 35 | 36 | ;; NOTE: This is an ugly hack. GET is not 37 | ;; meant to issue delete requests. If this 38 | ;; annoys you, please review the reading 39 | ;; guide in the README. 40 | (defmethod router [:get "/user/delete/:id"] 41 | [_] 42 | (middleware/wrap-route-id-params 43 | handlers/delete-by-id 44 | "/user/delete/")) 45 | 46 | (defmethod router [:get "/user/form"] 47 | [_] 48 | handlers/edit) 49 | 50 | (defmethod router [:get "/user/form/:id"] 51 | [_] 52 | (middleware/wrap-route-id-params 53 | handlers/edit 54 | "/user/form/")) 55 | 56 | (defmethod router [:get "/user/list"] 57 | [_] 58 | handlers/get-users) 59 | 60 | (defmethod router [:post "/user/save"] 61 | [_] 62 | handlers/save) 63 | 64 | (defmethod router [:get "/reset"] 65 | [_] 66 | handlers/reset-changes) 67 | 68 | (comment 69 | 70 | (defn handle 71 | [request] 72 | (let [handler (router request)] 73 | (handler request))) 74 | 75 | (handle {:request-method :get :uri "/"}) 76 | 77 | (do 78 | #_(deref usermanager.system.core/global-system) 79 | 80 | (usermanager.system.core/start-db! 81 | usermanager.model.user-manager/populate) 82 | 83 | (handle {:request-method :delete 84 | :uri "/user/delete/42" 85 | :application/component {:database (usermanager.system.core/get-db)}})) 86 | 87 | (handle {:request-method :post :uri "/"})) 88 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/settings.edn: -------------------------------------------------------------------------------- 1 | {:com.adityaathalye.grugstack.system.core/settings 2 | {:app-name "usermanager" 3 | :runtime-environment-type "dev" 4 | :system-modules [:com.adityaathalye.grugstack.system.db.sqlite 5 | :com.adityaathalye.grugstack.system.db.primary.sqlite 6 | :com.adityaathalye.grugstack.system.runtime 7 | :com.adityaathalye.grugstack.system.server-simple 8 | ]} 9 | 10 | :com.adityaathalye.grugstack.system.db.primary.sqlite/db 11 | {:migrator usermanager.model.user-manager/populate-grug} 12 | 13 | :com.adityaathalye.grugstack.system.core/components 14 | {:application/component 15 | {:database #ig/ref :com.adityaathalye.grugstack.system.db.primary.sqlite/db}} 16 | 17 | :com.adityaathalye.grugstack.system.server-simple/server 18 | {:handler-thunk usermanager.main/->grug-app-handler}} 19 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/src/usermanager/system/core.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.system.core 2 | (:require 3 | [ring.adapter.jetty :as adapter] 4 | [next.jdbc :as jdbc])) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;; Abstract system utilities 8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9 | (defonce global-system 10 | (atom {::server {:config {:port 3000 11 | :join? false} 12 | :state nil} 13 | ::db {:config {:dbtype "sqlite" :dbname "dev/usermanager_dev_db.sqlite3"} 14 | :state nil} 15 | ::middleware {:config {:stack []} 16 | :state nil}})) 17 | 18 | (defn- update-system! 19 | [key-path v] 20 | (swap! global-system (fn [s] (update-in s key-path (constantly v))))) 21 | 22 | (defn set-state! 23 | [component-key v] 24 | (update-system! [component-key :state] v)) 25 | 26 | (defn set-config! 27 | [component-key v] 28 | (update-system! [component-key :config] v)) 29 | 30 | (defn get-config 31 | [component-key] 32 | (get-in @global-system [component-key :config])) 33 | 34 | (defn get-state 35 | [component-key] 36 | (get-in @global-system [component-key :state])) 37 | 38 | (defn evict-component! 39 | [component-key] 40 | (swap! global-system dissoc component-key)) 41 | 42 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 | ;; Server start/stop utilities 44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 | 46 | (defn start-server! 47 | ([handler] 48 | (start-server! handler ::server)) 49 | ([handler server-key] 50 | (when-not (get-state server-key) 51 | (->> (get-config server-key) 52 | (adapter/run-jetty handler) 53 | (set-state! server-key))) 54 | (get-state server-key))) 55 | 56 | (defn stop-server! 57 | ([] 58 | (stop-server! ::server)) 59 | ([server-key] 60 | (when-let [server (get-state server-key)] 61 | (.stop server) 62 | (set-state! server-key nil)))) 63 | 64 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 65 | ;; Database start/stop utilities 66 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 67 | 68 | (defn get-db 69 | ([] 70 | (get-db ::db)) 71 | ([db-key] 72 | (fn [] 73 | (get-state db-key)))) 74 | 75 | (defn start-db! 76 | ([migrator] (start-db! migrator ::db)) 77 | ([migrator db-key] 78 | (when-not (get-state db-key) 79 | (let [datasource (jdbc/get-datasource (get-config db-key))] 80 | (set-state! db-key datasource) 81 | (migrator (get-db db-key)) 82 | datasource)))) 83 | 84 | (defn stop-db! 85 | ([] 86 | (stop-db! ::db)) 87 | ([db-key] 88 | (set-state! db-key nil))) 89 | 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 91 | ;; Middleware configuration utilities 92 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 93 | 94 | (defn wrap-middleware 95 | ([handler] 96 | (wrap-middleware handler ::middleware)) 97 | ([handler middleware-key] 98 | (let [composed-middleware (get-state middleware-key)] 99 | (composed-middleware handler)))) 100 | 101 | (defn start-middleware-stack! 102 | ([] 103 | (start-middleware-stack! ::middleware)) 104 | ([middleware-key] 105 | (when-not (get-state middleware-key) 106 | (let [middleware-stack (:stack (get-config middleware-key))] 107 | (set-state! middleware-key 108 | (apply comp (reverse middleware-stack))))))) 109 | 110 | (comment 111 | 112 | (do 113 | (def dummy-handler identity) 114 | 115 | ;; Middleware must be applied in correct order of dependency 116 | (defn wrap-inc [h] (fn [req] (inc (h req)))) 117 | (defn wrap-str [h] (fn [req] (str (h req)))) 118 | (defn wrap-vec [h] (fn [req] (vec (h req)))) 119 | 120 | (let [composed-middleware 121 | (apply comp 122 | (reverse [wrap-inc ; 0th middleware wrapped first 123 | wrap-str ; 1st middleware wrapped next 124 | wrap-vec])) ; 2nd middleware wrapped last 125 | 126 | wrapped-handler 127 | (composed-middleware dummy-handler)] 128 | (wrapped-handler 42))) 129 | 130 | global-system 131 | 132 | (set-state! ::server :foo) 133 | (get-state ::server) 134 | (set-config! ::server {:port 1337 :join? true}) 135 | (get-config ::server) 136 | (set-config! ::server {:port 3000 :join? false}) 137 | (set-state! ::server nil) 138 | 139 | (start-db! (constantly :foo)) 140 | 141 | (usermanager.model.user-manager/populate (get-db)) 142 | 143 | (require 'clojure.reflect) 144 | (clojure.reflect/reflect (get-db)) 145 | (stop-db!)) 146 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/handlers/user_test.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.handlers.user-test 2 | (:require [clj-http.client :as http] 3 | [clojure.test :as t :refer [deftest is testing]] 4 | [usermanager.system.core :as system] 5 | [usermanager.http.middleware :as middleware] 6 | [usermanager.test-utilities :as tu] 7 | [usermanager.main :as um] 8 | [usermanager.router.core :as router])) 9 | 10 | (def server (atom nil)) 11 | 12 | (def grug-system (atom nil)) 13 | 14 | (defn wrap-grug-test-middleware 15 | [handler system-components] 16 | (-> handler 17 | ;; keyword-params-middleware/wrap-keyword-params 18 | ;; params-middleware/wrap-params 19 | (middleware/wrap-grug-db system-components) 20 | middleware/wrap-message-param-in-response-header 21 | middleware/wrap-echo)) 22 | 23 | (defn ->test-grug-app-handler 24 | [system-components] 25 | (um/->grug-app-handler system-components 26 | router/router 27 | wrap-grug-test-middleware)) 28 | 29 | (defn with-server-object 30 | [->server-obj f] 31 | (reset! server (->server-obj)) 32 | (f) 33 | (reset! server nil)) 34 | 35 | (def fixtures-legacy-system 36 | (t/join-fixtures 37 | [(partial tu/with-test-db ::db) 38 | (partial tu/setup-teardown-server! 39 | {:server-key ::server 40 | :middleware-key ::middleware 41 | :middleware-stack [#(middleware/wrap-db % ::db) 42 | middleware/wrap-message-param-in-response-header 43 | middleware/wrap-echo]}) 44 | (partial with-server-object #(system/get-state ::server))])) 45 | 46 | (def fixtures-grug-system 47 | (t/join-fixtures 48 | [(partial tu/setup-teardown-grug! 49 | {:com.adityaathalye.grugstack.system.server-simple/server 50 | {:handler-thunk `->test-grug-app-handler}} 51 | grug-system) 52 | (partial with-server-object #(get-in @grug-system 53 | [:com.adityaathalye.grugstack.system.server-simple/server 54 | :object]))])) 55 | 56 | (t/use-fixtures :each 57 | (fn [f] 58 | (fixtures-legacy-system f) 59 | (reset! grug-system nil) 60 | (fixtures-grug-system f))) 61 | 62 | #_(ns-unmap *ns* 'default-route-message-test) 63 | (deftest default-route-message-test 64 | (testing "Testing that the default route injects a message in params." 65 | (let [base-uri (.toString (.getURI @server))] 66 | (is (= {:status 200 67 | :headers {"Content-Type" "text/plain;charset=utf-8" 68 | "UM-Message" 69 | (str "Welcome to the User Manager application demo!" 70 | " " 71 | "This is a first principles version of searncorfield/usermanager-example.")} 72 | :body "echoing METHOD :get for PATH /"} 73 | (-> (http/get base-uri) 74 | (select-keys [:status :body :headers]) 75 | (update :headers (fn [{:strs [Content-Type UM-Message]}] 76 | {"Content-Type" Content-Type 77 | "UM-Message" UM-Message})))))))) 78 | 79 | #_(ns-unmap *ns* 'reset-route-message-test) 80 | (deftest reset-route-message-test 81 | (testing "Testing that the reset route injects a message in params." 82 | (let [base-uri (.toString (.getURI @server))] 83 | (is (= {:status 200 84 | :headers {"Content-Type" "text/plain;charset=utf-8" 85 | "UM-Message" "The change tracker has been reset to 0."} 86 | :body "echoing METHOD :get for PATH /reset"} 87 | (-> (http/get (str base-uri "/reset")) 88 | (select-keys [:status :body :headers]) 89 | (update :headers (fn [{:strs [Content-Type UM-Message]}] 90 | {"Content-Type" Content-Type 91 | "UM-Message" UM-Message})))))))) 92 | 93 | #_(ns-unmap *ns* 'delete-route-params-wrapped-test) 94 | (deftest delete-route-params-wrapped-test 95 | (testing "Testing that the delete route properly injects :id in :params." 96 | (let [base-uri (.toString (.getURI @server))] 97 | (is (= {:status 200 98 | :trace-redirects [(str base-uri "user/list")] 99 | :body "echoing METHOD :get for PATH /user/list"} 100 | (-> (http/get (str base-uri "user/delete/42")) 101 | (select-keys [:status :body 102 | :trace-redirects]))))))) 103 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/http/middleware_test.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.http.middleware-test 2 | (:require 3 | [clojure.test :as t :refer [deftest is testing use-fixtures]] 4 | [usermanager.http.middleware :as middleware] 5 | [usermanager.test-utilities :as tu] 6 | [usermanager.system.core :as system])) 7 | 8 | #_(use-fixtures :once (partial tu/with-test-db ::db)) 9 | #_(use-fixtures :once tu/setup-teardown-grug!) 10 | 11 | (use-fixtures :once 12 | (fn [f] 13 | (tu/with-test-db ::db f) 14 | (tu/setup-teardown-grug! f))) 15 | 16 | (deftest middleware-test 17 | (testing "Middleware functionality" 18 | (let [message (str (random-uuid))] 19 | (is (= (let [handler (middleware/wrap-message-param-in-response-header 20 | identity)] 21 | (handler 22 | {:params {:message message}})) 23 | {:params {:message message} 24 | :headers {"UM-Message" message}}) 25 | "Wrap message params middleware injects header in request.") 26 | (is (= (let [handler (middleware/wrap-echo identity)] 27 | (handler 28 | {:request-method :get :uri "/"})) 29 | {:status 200, 30 | :headers {"Content-Type" "text/plain;charset=utf-8"}, 31 | :body "echoing METHOD :get for PATH /"}) 32 | "Echo middleware produces an OK response with request information in body.") 33 | (is (= (let [handler (-> (fn [request] (assoc request :params {:message message})) 34 | middleware/wrap-message-param-in-response-header 35 | middleware/wrap-echo)] 36 | (handler 37 | {:request-method :get :uri "/"})) 38 | {:status 200, 39 | :headers 40 | {"UM-Message" message, "Content-Type" "text/plain;charset=utf-8"}, 41 | :body "echoing METHOD :get for PATH /"}) 42 | "Echo middleware composes with message params middleware.") 43 | (is (= (let [handler (middleware/wrap-db identity ::db) 44 | response (handler {:request-method :get :uri "/"}) 45 | db (get-in response [:application/component :database])] 46 | (db)) 47 | (system/get-state ::db)) 48 | "Wrap db injects the database into the request's component context.") 49 | (is (= (let [uri-prefix "/some/prefix/path/" 50 | test-id 1337 51 | uri (str uri-prefix test-id) 52 | handler (middleware/wrap-route-id-params identity uri-prefix)] 53 | (handler {:uri uri})) 54 | {:uri "/some/prefix/path/1337" :params {:id 1337}}))))) 55 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/main_grug_test.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.main-grug-test 2 | (:require 3 | [clj-http.client :as http] 4 | [clojure.test :as t :refer [deftest is testing]] 5 | [usermanager.test-utilities :as tu])) 6 | 7 | (def grug-system (atom nil)) 8 | 9 | (t/use-fixtures :once (partial tu/setup-teardown-grug! grug-system)) 10 | 11 | (defn server-obj [] 12 | (get-in @grug-system 13 | [:com.adityaathalye.grugstack.system.server-simple/server 14 | :object])) 15 | 16 | (deftest a-simple-server-test 17 | (testing "A simple server test." 18 | (let [base-uri (.toString (.getURI (server-obj)))] 19 | (is (= {:status 200 20 | :headers {"Content-Type" "text/html"}} 21 | (-> (http/get base-uri) 22 | (select-keys [:status :headers]) 23 | (update :headers (fn [{:strs [Content-Type]}] 24 | {"Content-Type" Content-Type})))) 25 | "Server echoes back information about request method and uri.") 26 | (is (= {:status 404 27 | :body "Not Found."} 28 | (-> (http/post base-uri {:throw-exceptions false}) 29 | (select-keys [:status :body]))) 30 | "Server rejects unsupported route pattern.")))) 31 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/main_test.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.main-test 2 | (:require 3 | [clj-http.client :as http] 4 | [clojure.test :as t :refer [deftest is testing]] 5 | [usermanager.system.core :as system] 6 | [usermanager.http.middleware :as middleware] 7 | [usermanager.test-utilities :as tu])) 8 | 9 | (t/use-fixtures :once 10 | (partial tu/setup-teardown-server! 11 | {:server-key ::server 12 | :middleware-key ::middleware 13 | :middleware-stack [middleware/wrap-message-param-in-response-header 14 | middleware/wrap-echo]})) 15 | 16 | (deftest a-simple-server-test 17 | (testing "A simple server test." 18 | (let [base-uri (.toString (.getURI (system/get-state ::server)))] 19 | (is (= {:status 200 20 | :headers {"Content-Type" "text/plain;charset=utf-8"} 21 | :body "echoing METHOD :get for PATH /"} 22 | (-> (http/get base-uri) 23 | (select-keys [:status :body :headers]) 24 | (update :headers (fn [{:strs [Content-Type]}] 25 | {"Content-Type" Content-Type})))) 26 | "Server echoes back information about request method and uri.") 27 | (is (= {:status 404 28 | :body "Not Found."} 29 | (-> (http/post base-uri {:throw-exceptions false}) 30 | (select-keys [:status :body]))) 31 | "Server rejects unsupported route pattern.")))) 32 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/model/user_manager_grug_test.clj: -------------------------------------------------------------------------------- 1 | ;; copyright (c) 2019-2023 Sean Corfield, all rights reserved 2 | 3 | (ns usermanager.model.user-manager-grug-test 4 | "These tests use SQLite in-memory." 5 | (:require [clojure.test :refer [deftest is use-fixtures]] 6 | [usermanager.model.user-manager :as model] 7 | [usermanager.test-utilities :as tu])) 8 | 9 | (def system-atom (atom nil)) 10 | 11 | (use-fixtures :once (partial tu/setup-teardown-grug! system-atom)) 12 | 13 | (def db #(get-in @system-atom 14 | [:com.adityaathalye.grugstack.system.db.primary.sqlite/db 15 | :datasource])) 16 | 17 | (deftest department-test 18 | (is (= #:department{:id 1 :name "Accounting"} 19 | (model/get-department-by-id db 1))) 20 | (is (= 4 (count (model/get-departments db))))) 21 | 22 | (deftest user-test 23 | (is (= 1 (:addressbook/id (model/get-user-by-id db 1)))) 24 | (is (= "Sean" (:addressbook/first_name 25 | (model/get-user-by-id db 1)))) 26 | (is (= 4 (:addressbook/department_id 27 | (model/get-user-by-id db 1)))) 28 | (is (= 1 (count (model/get-users db)))) 29 | (is (= "Development" (:department/name 30 | (first 31 | (model/get-users db)))))) 32 | 33 | (deftest save-test 34 | (is (= "sean@corfield.org" 35 | (:addressbook/email 36 | (do 37 | (model/save-user db {:addressbook/id 1 38 | :addressbook/email "sean@corfield.org"}) 39 | (model/get-user-by-id db 1))))) 40 | (is (= "seancorfield@hotmail.com" 41 | (:addressbook/email 42 | (do 43 | (model/save-user db {:addressbook/first_name "Sean" 44 | :addressbook/last_name "Corfield" 45 | :addressbook/department_id 4 46 | :addressbook/email "seancorfield@hotmail.com"}) 47 | (model/get-user-by-id db 2)))))) 48 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/model/user_manager_test.clj: -------------------------------------------------------------------------------- 1 | ;; copyright (c) 2019-2023 Sean Corfield, all rights reserved 2 | 3 | (ns usermanager.model.user-manager-test 4 | "These tests use SQLite in-memory." 5 | (:require [clojure.test :refer [deftest is use-fixtures]] 6 | [usermanager.model.user-manager :as model] 7 | [usermanager.system.core :as system] 8 | [usermanager.test-utilities :as tu])) 9 | 10 | (use-fixtures :once (partial tu/with-test-db ::db)) 11 | 12 | (def db (system/get-db ::db)) 13 | 14 | (deftest department-test 15 | (is (= #:department{:id 1 :name "Accounting"} 16 | (model/get-department-by-id db 1))) 17 | (is (= 4 (count (model/get-departments db))))) 18 | 19 | (deftest user-test 20 | (is (= 1 (:addressbook/id (model/get-user-by-id db 1)))) 21 | (is (= "Sean" (:addressbook/first_name 22 | (model/get-user-by-id db 1)))) 23 | (is (= 4 (:addressbook/department_id 24 | (model/get-user-by-id db 1)))) 25 | (is (= 1 (count (model/get-users db)))) 26 | (is (= "Development" (:department/name 27 | (first 28 | (model/get-users db)))))) 29 | 30 | (deftest save-test 31 | (is (= "sean@corfield.org" 32 | (:addressbook/email 33 | (do 34 | (model/save-user db {:addressbook/id 1 35 | :addressbook/email "sean@corfield.org"}) 36 | (model/get-user-by-id db 1))))) 37 | (is (= "seancorfield@hotmail.com" 38 | (:addressbook/email 39 | (do 40 | (model/save-user db {:addressbook/first_name "Sean" 41 | :addressbook/last_name "Corfield" 42 | :addressbook/department_id 4 43 | :addressbook/email "seancorfield@hotmail.com"}) 44 | (model/get-user-by-id db 2)))))) 45 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/router/core_grug_test.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.router.core-grug-test 2 | (:require 3 | [clojure.test :refer [are deftest testing use-fixtures]] 4 | [usermanager.router.core :as urc] 5 | [usermanager.test-utilities :as tu])) 6 | 7 | #_(use-fixtures :each (partial tu/with-test-db ::db)) 8 | 9 | (def system-atom (atom nil)) 10 | 11 | (use-fixtures :each (partial tu/setup-teardown-grug! system-atom)) 12 | 13 | (def db #(get-in @system-atom 14 | [:com.adityaathalye.grugstack.system.db.primary.sqlite/db 15 | :datasource])) 16 | 17 | (defn handle 18 | [request] 19 | (let [h (urc/router request)] 20 | (h request))) 21 | 22 | (deftest route-matching-test 23 | (let [db db] 24 | (testing "Only allowed route path patterns match." 25 | (are [route-call response] (= route-call response) 26 | 27 | (handle {:request-method :get :uri "/"}) 28 | {:request-method :get, 29 | :uri "/", 30 | :params {:message 31 | (str "Welcome to the User Manager application demo! " 32 | "This is a first principles version of " 33 | "searncorfield/usermanager-example.")}} 34 | 35 | (handle {:request-method :post :uri "/"}) 36 | tu/not-found-response 37 | 38 | (handle {:request-method :post :uri "/does/not/exist"}) 39 | tu/not-found-response 40 | 41 | (handle {:request-method :post :uri "/user/delete/1"}) 42 | tu/not-found-response 43 | 44 | (handle {:request-method :delete :uri "/user/delete/NAN"}) 45 | tu/not-found-response 46 | 47 | (handle {:request-method :get 48 | :uri "/user/form" 49 | :application/component {:database db}}) 50 | {:request-method :get, 51 | :uri "/user/form", 52 | :application/component 53 | {:database db}, 54 | :params 55 | {:user nil, 56 | :departments 57 | [#:department{:id 1, :name "Accounting"} 58 | #:department{:id 4, :name "Development"} 59 | #:department{:id 2, :name "Sales"} 60 | #:department{:id 3, :name "Support"}]}, 61 | :application/view "form"} 62 | 63 | (handle {:request-method :get 64 | :uri "/user/form/1" 65 | :application/component {:database db}}) 66 | {:request-method :get, 67 | :uri "/user/form/1", 68 | :params 69 | {:id 1, 70 | :user 71 | #:addressbook{:id 1, 72 | :first_name "Sean", 73 | :last_name "Corfield", 74 | :email "sean@worldsingles.com", 75 | :department_id 4}, 76 | :departments 77 | [#:department{:id 1, :name "Accounting"} 78 | #:department{:id 4, :name "Development"} 79 | #:department{:id 2, :name "Sales"} 80 | #:department{:id 3, :name "Support"}]}, 81 | :application/component 82 | {:database db}, 83 | :application/view "form"} 84 | 85 | (handle {:request-method :post 86 | :uri "/user/form/1" 87 | :application/component {:database db}}) 88 | tu/not-found-response 89 | 90 | (handle {:request-method :form :uri "/user/form/NAN"}) 91 | tu/not-found-response 92 | 93 | (handle {:request-method :get :uri "/reset"}) 94 | {:request-method :get, 95 | :uri "/reset", 96 | :params {:message "The change tracker has been reset to 0."}})))) 97 | 98 | (deftest successively-list-save-list-delete-list-test 99 | (let [db db] 100 | (testing "Whether successive save -> list -> delete -> save -> list work as expected.") 101 | (are [route-call response] (= route-call response) 102 | ;; 1. SAVE 103 | (handle {:request-method :post 104 | :uri "/user/save" 105 | :params {:id nil 106 | :first_name "Aditya" :last_name "Athalye" 107 | :email "someone@example.com" 108 | :department_id "2"} 109 | :application/component {:database db}}) 110 | {:status 303, 111 | :headers {"Location" "/user/list"}, 112 | :body ""} 113 | 114 | ;; 2. LIST 115 | (handle {:request-method :get 116 | :uri "/user/list" 117 | :application/component {:database db}}) 118 | {:request-method :get, 119 | :uri "/user/list", 120 | :application/component 121 | {:database db}, 122 | :params 123 | {:users 124 | [{:addressbook/id 2, 125 | :addressbook/first_name "Aditya", 126 | :addressbook/last_name "Athalye", 127 | :addressbook/email "someone@example.com", 128 | :addressbook/department_id 2, 129 | :department/name "Sales"} 130 | {:addressbook/id 1, 131 | :addressbook/first_name "Sean", 132 | :addressbook/last_name "Corfield", 133 | :addressbook/email "sean@worldsingles.com", 134 | :addressbook/department_id 4, 135 | :department/name "Development"}]}, 136 | :application/view "list"} 137 | 138 | ;; 3. DELETE 139 | (handle {:request-method :get 140 | :uri "/user/delete/2" 141 | :application/component {:database db}}) 142 | {:status 303 143 | :headers 144 | {"Location" "/user/list"}, :body ""} 145 | 146 | ;; 4. SAVE 147 | (handle {:request-method :post 148 | :uri "/user/save" 149 | :params {:id "1" 150 | :email "sean@example.com" 151 | :department_id "1"} 152 | :application/component {:database db}}) 153 | {:status 303, 154 | :headers {"Location" "/user/list"}, 155 | :body ""} 156 | 157 | ;; LIST 158 | (handle {:request-method :get 159 | :uri "/user/list" 160 | :application/component {:database db}}) 161 | {:request-method :get, 162 | :uri "/user/list", 163 | :application/component 164 | {:database db}, 165 | :params 166 | {:users 167 | [{:addressbook/id 1, 168 | :addressbook/first_name "Sean", 169 | :addressbook/last_name "Corfield", 170 | :addressbook/email "sean@example.com", 171 | :addressbook/department_id 1, 172 | :department/name "Accounting"}]}, 173 | :application/view "list"}))) 174 | 175 | (deftest successive-list-delete-list-route-calls-test 176 | (let [db db] 177 | (testing "Whether successive list -> delete -> list behaves as expected." 178 | (are [route-call response] (= route-call response) 179 | 180 | ;; LIST fresh DB with only one user 181 | (handle {:request-method :get 182 | :uri "/user/list" 183 | :application/component {:database db}}) 184 | {:request-method :get, 185 | :uri "/user/list", 186 | :application/component 187 | {:database db}, 188 | :params 189 | {:users 190 | [{:addressbook/id 1, 191 | :addressbook/first_name "Sean", 192 | :addressbook/last_name "Corfield", 193 | :addressbook/email "sean@worldsingles.com", 194 | :addressbook/department_id 4, 195 | :department/name "Development"}]}, 196 | :application/view "list"} 197 | 198 | ;; Delete the lone user 199 | (handle {:request-method :get 200 | :uri "/user/delete/1" 201 | :params {:id 1} ; We assume setup creates at least one user 202 | :application/component {:database db}}) 203 | {:status 303 204 | :headers 205 | {"Location" "/user/list"}, :body ""} 206 | 207 | ;; LIST db again to fetch nobody 208 | (handle {:request-method :get 209 | :uri "/user/list" 210 | :application/component {:database db}}) 211 | {:request-method :get, 212 | :uri "/user/list", 213 | :application/component 214 | {:database db}, 215 | :params {:users []}, 216 | :application/view "list"})))) 217 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/router/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.router.core-test 2 | (:require 3 | [clojure.test :refer [are deftest testing use-fixtures]] 4 | [usermanager.router.core :as urc] 5 | [usermanager.test-utilities :as tu] 6 | [usermanager.system.core :as system])) 7 | 8 | (use-fixtures :each (partial tu/with-test-db ::db)) 9 | 10 | (defn handle 11 | [request] 12 | (let [h (urc/router request)] 13 | (h request))) 14 | 15 | (deftest route-matching-test 16 | (let [db (system/get-db ::db)] 17 | (testing "Only allowed route path patterns match." 18 | (are [route-call response] (= route-call response) 19 | 20 | (handle {:request-method :get :uri "/"}) 21 | {:request-method :get, 22 | :uri "/", 23 | :params {:message 24 | (str "Welcome to the User Manager application demo! " 25 | "This is a first principles version of " 26 | "searncorfield/usermanager-example.")}} 27 | 28 | (handle {:request-method :post :uri "/"}) 29 | tu/not-found-response 30 | 31 | (handle {:request-method :post :uri "/does/not/exist"}) 32 | tu/not-found-response 33 | 34 | (handle {:request-method :post :uri "/user/delete/1"}) 35 | tu/not-found-response 36 | 37 | (handle {:request-method :delete :uri "/user/delete/NAN"}) 38 | tu/not-found-response 39 | 40 | (handle {:request-method :get 41 | :uri "/user/form" 42 | :application/component {:database db}}) 43 | {:request-method :get, 44 | :uri "/user/form", 45 | :application/component 46 | {:database db}, 47 | :params 48 | {:user nil, 49 | :departments 50 | [#:department{:id 1, :name "Accounting"} 51 | #:department{:id 4, :name "Development"} 52 | #:department{:id 2, :name "Sales"} 53 | #:department{:id 3, :name "Support"}]}, 54 | :application/view "form"} 55 | 56 | (handle {:request-method :get 57 | :uri "/user/form/1" 58 | :application/component {:database db}}) 59 | {:request-method :get, 60 | :uri "/user/form/1", 61 | :params 62 | {:id 1, 63 | :user 64 | #:addressbook{:id 1, 65 | :first_name "Sean", 66 | :last_name "Corfield", 67 | :email "sean@worldsingles.com", 68 | :department_id 4}, 69 | :departments 70 | [#:department{:id 1, :name "Accounting"} 71 | #:department{:id 4, :name "Development"} 72 | #:department{:id 2, :name "Sales"} 73 | #:department{:id 3, :name "Support"}]}, 74 | :application/component 75 | {:database db}, 76 | :application/view "form"} 77 | 78 | (handle {:request-method :post 79 | :uri "/user/form/1" 80 | :application/component {:database db}}) 81 | tu/not-found-response 82 | 83 | (handle {:request-method :form :uri "/user/form/NAN"}) 84 | tu/not-found-response 85 | 86 | (handle {:request-method :get :uri "/reset"}) 87 | {:request-method :get, 88 | :uri "/reset", 89 | :params {:message "The change tracker has been reset to 0."}})))) 90 | 91 | (deftest successively-list-save-list-delete-list-test 92 | (let [db (system/get-db ::db)] 93 | (testing "Whether successive save -> list -> delete -> save -> list work as expected.") 94 | (are [route-call response] (= route-call response) 95 | ;; 1. SAVE 96 | (handle {:request-method :post 97 | :uri "/user/save" 98 | :params {:id nil 99 | :first_name "Aditya" :last_name "Athalye" 100 | :email "someone@example.com" 101 | :department_id "2"} 102 | :application/component {:database db}}) 103 | {:status 303, 104 | :headers {"Location" "/user/list"}, 105 | :body ""} 106 | 107 | ;; 2. LIST 108 | (handle {:request-method :get 109 | :uri "/user/list" 110 | :application/component {:database db}}) 111 | {:request-method :get, 112 | :uri "/user/list", 113 | :application/component 114 | {:database db}, 115 | :params 116 | {:users 117 | [{:addressbook/id 2, 118 | :addressbook/first_name "Aditya", 119 | :addressbook/last_name "Athalye", 120 | :addressbook/email "someone@example.com", 121 | :addressbook/department_id 2, 122 | :department/name "Sales"} 123 | {:addressbook/id 1, 124 | :addressbook/first_name "Sean", 125 | :addressbook/last_name "Corfield", 126 | :addressbook/email "sean@worldsingles.com", 127 | :addressbook/department_id 4, 128 | :department/name "Development"}]}, 129 | :application/view "list"} 130 | 131 | ;; 3. DELETE 132 | (handle {:request-method :get 133 | :uri "/user/delete/2" 134 | :application/component {:database db}}) 135 | {:status 303 136 | :headers 137 | {"Location" "/user/list"}, :body ""} 138 | 139 | ;; 4. SAVE 140 | (handle {:request-method :post 141 | :uri "/user/save" 142 | :params {:id "1" 143 | :email "sean@example.com" 144 | :department_id "1"} 145 | :application/component {:database db}}) 146 | {:status 303, 147 | :headers {"Location" "/user/list"}, 148 | :body ""} 149 | 150 | ;; LIST 151 | (handle {:request-method :get 152 | :uri "/user/list" 153 | :application/component {:database db}}) 154 | {:request-method :get, 155 | :uri "/user/list", 156 | :application/component 157 | {:database db}, 158 | :params 159 | {:users 160 | [{:addressbook/id 1, 161 | :addressbook/first_name "Sean", 162 | :addressbook/last_name "Corfield", 163 | :addressbook/email "sean@example.com", 164 | :addressbook/department_id 1, 165 | :department/name "Accounting"}]}, 166 | :application/view "list"}))) 167 | 168 | (deftest successive-list-delete-list-route-calls-test 169 | (let [db (system/get-db ::db)] 170 | (testing "Whether successive list -> delete -> list behaves as expected." 171 | (are [route-call response] (= route-call response) 172 | 173 | ;; LIST fresh DB with only one user 174 | (handle {:request-method :get 175 | :uri "/user/list" 176 | :application/component {:database db}}) 177 | {:request-method :get, 178 | :uri "/user/list", 179 | :application/component 180 | {:database db}, 181 | :params 182 | {:users 183 | [{:addressbook/id 1, 184 | :addressbook/first_name "Sean", 185 | :addressbook/last_name "Corfield", 186 | :addressbook/email "sean@worldsingles.com", 187 | :addressbook/department_id 4, 188 | :department/name "Development"}]}, 189 | :application/view "list"} 190 | 191 | ;; Delete the lone user 192 | (handle {:request-method :get 193 | :uri "/user/delete/1" 194 | :params {:id 1} ; We assume setup creates at least one user 195 | :application/component {:database db}}) 196 | {:status 303 197 | :headers 198 | {"Location" "/user/list"}, :body ""} 199 | 200 | ;; LIST db again to fetch nobody 201 | (handle {:request-method :get 202 | :uri "/user/list" 203 | :application/component {:database db}}) 204 | {:request-method :get, 205 | :uri "/user/list", 206 | :application/component 207 | {:database db}, 208 | :params {:users []}, 209 | :application/view "list"})))) 210 | -------------------------------------------------------------------------------- /projects/usermanager-first-principles/test/usermanager/test_utilities.clj: -------------------------------------------------------------------------------- 1 | (ns usermanager.test-utilities 2 | (:require [usermanager.main :as um] 3 | [usermanager.system.core :as system] 4 | [clojure.string :as s] 5 | [usermanager.model.user-manager :as model] 6 | [clojure.java.io :as io] 7 | [usermanager.router.core :as router] 8 | [integrant.core :as ig] 9 | [com.adityaathalye.grugstack.settings.core :as grug-settings] 10 | [com.adityaathalye.grugstack.system.core :as grug-system]) 11 | (:import (java.net ServerSocket))) 12 | 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | ;; Configuration utils 15 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16 | 17 | (defn get-free-port! 18 | [] 19 | (with-open [socket (ServerSocket. 0)] 20 | (.getLocalPort socket))) 21 | 22 | (defn grug-test-settings 23 | ([] 24 | (grug-test-settings {})) 25 | ([ns-settings-overrides] 26 | (let [settings (grug-settings/make-settings 27 | (grug-settings/read-settings! "usermanager/settings.edn") 28 | {}) 29 | common-test-settings {:com.adityaathalye.grugstack.system.core/settings 30 | {:runtime-environment-type "test"} 31 | :com.adityaathalye.grugstack.system.server-simple/jetty-adapter 32 | {:port (get-free-port!)}}] 33 | (merge-with merge 34 | settings 35 | common-test-settings 36 | ns-settings-overrides)))) 37 | 38 | #_(grug-test-settings 39 | {:com.adityaathalye.grugstack.system.server-simple/server 40 | {:handler-thunk `identity}}) 41 | 42 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 | ;; Test fixture utils 44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 | 46 | (defn setup-teardown-server! 47 | [{:keys [server-key config middleware-key middleware-stack] 48 | :or {server-key ::server 49 | middleware-key ::middleware 50 | middleware-stack []} :as settings} 51 | f] 52 | (let [config (merge {:port (get-free-port!) :join? false} 53 | config)] 54 | (println "Setting up component:" server-key) 55 | (println "With settings:" settings) 56 | (system/set-config! server-key config) 57 | (system/set-config! middleware-key {:stack middleware-stack}) 58 | (system/start-middleware-stack! middleware-key) 59 | (system/start-server! 60 | (um/wrap-router router/router middleware-key) server-key) 61 | 62 | (println "Running test with config:" (system/get-config server-key)) 63 | (f) 64 | 65 | (system/stop-server! server-key) 66 | (system/evict-component! server-key) 67 | (system/evict-component! middleware-key) 68 | (println "Stopped and evicted components:" server-key middleware-key))) 69 | 70 | (defn with-test-db 71 | [db-key f] 72 | (let [dbname (format "test/%s.sqlite3" 73 | (-> db-key symbol str 74 | (s/replace #"\.|/" "_")))] 75 | (println "Setting up component:" db-key) 76 | (system/set-config! db-key {:dbtype "sqlite" :dbname dbname}) 77 | (system/start-db! model/populate db-key) 78 | 79 | (println "Running test with config:" (system/get-config db-key)) 80 | (f) 81 | 82 | (system/stop-db! db-key) 83 | (system/evict-component! db-key) 84 | (println "Stopped and evicted component:" db-key) 85 | 86 | (try (io/delete-file dbname) 87 | (catch java.io.IOException e 88 | (println (ex-message e))) 89 | (finally (println "Deleted SQLite test DB:" dbname))))) 90 | 91 | (defn setup-teardown-grug! 92 | ([f] 93 | (setup-teardown-grug! {} (atom nil) f)) 94 | ([test-ns-system-atom f] 95 | (setup-teardown-grug! {} test-ns-system-atom f)) 96 | ([test-ns-settings-overrides test-ns-system-atom f] 97 | (let [settings (grug-test-settings test-ns-settings-overrides) 98 | system (grug-system/init settings) 99 | dbname (get-in system 100 | [:com.adityaathalye.grugstack.system.db.primary.sqlite/db 101 | :dbname])] 102 | (reset! test-ns-system-atom system) 103 | (println "Setting up grug system:") 104 | (println "With settings:" settings) 105 | (f) 106 | (ig/halt! system) 107 | (reset! test-ns-system-atom nil) 108 | (try (io/delete-file dbname) 109 | (catch java.io.IOException e 110 | (println (ex-message e))) 111 | (finally (println "Deleted SQLite test DB:" dbname))) 112 | (println "Stopped grug system.")))) 113 | 114 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 115 | ;; HTTP utils 116 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 117 | 118 | (defn echo-response 119 | [method path] 120 | {:status 200 121 | :headers {"Content-Type" "text/plain;charset=utf-8"} 122 | :body (format "echoing METHOD %s for PATH %s" 123 | method path)}) 124 | 125 | (def not-found-response 126 | {:status 404 127 | :headers {} 128 | :body "Not Found."}) 129 | -------------------------------------------------------------------------------- /resources/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adityaathalye/clojure-multiproject-example/b209e28f7d85a59cadbdf21164a7de6a3e78759e/resources/.keep -------------------------------------------------------------------------------- /src/core.clj: -------------------------------------------------------------------------------- 1 | (ns core) 2 | -------------------------------------------------------------------------------- /test/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns core-test 2 | (:require [clojure.test :refer :all] 3 | [core :refer :all])) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) 8 | 9 | (deftest b-test 10 | (testing "YAY, I pass." 11 | (is (= 1 1)))) 12 | --------------------------------------------------------------------------------