├── .clj-kondo └── config.edn ├── .cljfmt.edn ├── .github ├── actions │ └── cache-clojure-deps │ │ └── action.yaml └── workflows │ ├── checks.yaml │ ├── release.yaml │ └── snapshot.yaml ├── .gitignore ├── .mise.toml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bb.edn ├── deps.edn ├── dev ├── ex │ ├── clj_bench.clj │ ├── cljs_bench.cljs │ ├── examples_high_level_md.clj │ ├── examples_high_level_md.cljc │ ├── examples_high_level_md.cljs │ ├── examples_low_level_md.clj │ ├── readme_md.clj │ ├── readme_md.cljc │ └── readme_md.cljs └── user.clj ├── doc ├── clj-bench.md ├── cljdoc.edn ├── cljs-bench.md ├── examples-high-level.md └── examples.md ├── src └── com │ └── jolygon │ ├── wrap_map.cljc │ └── wrap_map │ ├── api_0.cljc │ └── api_0 │ ├── common.cljc │ ├── impl.clj │ └── impl.cljs └── test └── com └── jolygon └── wrap_map ├── api_0_test.clj └── api_0_test.cljs /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:linters {:single-key-in {:level :warning} 2 | :shadowed-var {:level :warning} 3 | :refer-all {:exclude [clojure.test]}}} 4 | -------------------------------------------------------------------------------- /.cljfmt.edn: -------------------------------------------------------------------------------- 1 | {:parallel? true 2 | :sort-ns-references? true 3 | :remove-multiple-non-indenting-spaces? true 4 | :function-arguments-indentation :cursive} 5 | -------------------------------------------------------------------------------- /.github/actions/cache-clojure-deps/action.yaml: -------------------------------------------------------------------------------- 1 | name: Cache Clojure deps 2 | 3 | inputs: 4 | key-label: 5 | description: 'Additional label for cache key' 6 | default: 'deps' 7 | 8 | runs: 9 | using: composite 10 | steps: 11 | - uses: actions/checkout@v4 12 | - name: Cache Clojure deps 13 | uses: actions/cache@v4 14 | with: 15 | path: | 16 | ~/.m2/repository 17 | ~/.gitlibs 18 | ~/.clojure 19 | ~/.cpcache 20 | key: ${{ runner.os }}-clojure-${{ inputs.key-label }}-${{ hashFiles('**/deps.edn') }} 21 | -------------------------------------------------------------------------------- /.github/workflows/checks.yaml: -------------------------------------------------------------------------------- 1 | name: Checks 2 | 3 | on: 4 | pull_request: 5 | branches: [ master ] 6 | workflow_call: 7 | 8 | jobs: 9 | lint-fmt: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v4 13 | - uses: ./.github/actions/cache-clojure-deps 14 | with: 15 | key-label: 'lint' 16 | - uses: jdx/mise-action@v2 17 | with: 18 | install_args: "babashka cljfmt clj-kondo java clojure" 19 | - name: Lint and format 20 | run: bb fmt-check && bb lint-init && bb lint 21 | 22 | outdated: 23 | runs-on: ubuntu-latest 24 | steps: 25 | - uses: actions/checkout@v4 26 | - uses: ./.github/actions/cache-clojure-deps 27 | with: 28 | key-label: 'outdated' 29 | - uses: jdx/mise-action@v2 30 | with: 31 | install_args: "babashka java clojure" 32 | - name: Check outdated deps 33 | run: bb outdated-check 34 | 35 | tests: 36 | runs-on: ubuntu-latest 37 | steps: 38 | - uses: actions/checkout@v4 39 | - uses: ./.github/actions/cache-clojure-deps 40 | with: 41 | key-label: 'tests' 42 | - uses: jdx/mise-action@v2 43 | with: 44 | install_args: "babashka java clojure" 45 | - name: Run tests 46 | run: bb test 47 | -------------------------------------------------------------------------------- /.github/workflows/release.yaml: -------------------------------------------------------------------------------- 1 | name: Deploy Release 2 | 3 | on: 4 | push: 5 | tags: 6 | - "*" 7 | 8 | jobs: 9 | tests: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v4 13 | - uses: ./.github/actions/cache-clojure-deps 14 | with: 15 | key-label: 'tests' 16 | - uses: jdx/mise-action@v2 17 | with: 18 | install_args: "babashka java clojure" 19 | - name: Run tests 20 | run: bb test 21 | 22 | deploy: 23 | runs-on: ubuntu-latest 24 | needs: [ tests ] 25 | permissions: 26 | contents: write 27 | steps: 28 | - uses: actions/checkout@v4 29 | - uses: ./.github/actions/cache-clojure-deps 30 | with: 31 | key-label: 'deploy' 32 | - uses: jdx/mise-action@v2 33 | with: 34 | install_args: "babashka java clojure" 35 | - name: Set Active Babashka Version using mise 36 | run: mise use -g babashka@1.3.186 37 | - name: Deploy Release 38 | env: 39 | CLOJARS_USERNAME: ${{ secrets.CLOJARS_USERNAME }} 40 | CLOJARS_PASSWORD: ${{ secrets.CLOJARS_PASSWORD }} 41 | run: bb deploy-release 42 | - name: Check if tag exists 43 | id: check_tag 44 | run: | 45 | if gh release view "$TAG" --repo="$GITHUB_REPOSITORY" > /dev/null 2>&1; then 46 | echo "exists=true" >> $GITHUB_ENV 47 | else 48 | echo "exists=false" >> $GITHUB_ENV 49 | fi 50 | - name: Publish GitHub Release 51 | if: env.exists == 'false' && github.ref_name != '' # Ensure it only runs when the tag doesn't exist 52 | env: 53 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 54 | TAG: ${{ github.ref_name }} 55 | run: | 56 | gh release create "$TAG" \ 57 | --repo="$GITHUB_REPOSITORY" \ 58 | --title="${TAG}" \ 59 | --generate-notes 60 | -------------------------------------------------------------------------------- /.github/workflows/snapshot.yaml: -------------------------------------------------------------------------------- 1 | name: Deploy Snapshot 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | 7 | jobs: 8 | checks: 9 | uses: ./.github/workflows/checks.yaml 10 | 11 | deploy: 12 | runs-on: ubuntu-latest 13 | needs: [ checks ] 14 | steps: 15 | - uses: actions/checkout@v4 16 | - uses: ./.github/actions/cache-clojure-deps 17 | with: 18 | key-label: 'deploy' 19 | - uses: jdx/mise-action@v2 20 | with: 21 | install_args: "babashka java clojure" 22 | - name: Deploy Snapshot 23 | env: 24 | CLOJARS_USERNAME: ${{ secrets.CLOJARS_USERNAME }} 25 | CLOJARS_PASSWORD: ${{ secrets.CLOJARS_PASSWORD }} 26 | run: bb deploy-snapshot 27 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *.jar 4 | *.class 5 | /lib/ 6 | /classes/ 7 | /target/ 8 | /checkouts/ 9 | .lein-deps-sum 10 | .lein-repl-history 11 | .lein-plugins/ 12 | .lein-failures 13 | .nrepl-port 14 | .cpcache/ 15 | .calva/ 16 | .clj-kondo/* 17 | !.clj-kondo/config.edn 18 | .lsp/ 19 | /out/ 20 | .portal/ 21 | .shadow-cljs/ 22 | cljs-test-runner-out/ 23 | .cljs_node_repl/ 24 | .cursorignore 25 | .scratch/ -------------------------------------------------------------------------------- /.mise.toml: -------------------------------------------------------------------------------- 1 | [tools] 2 | java = "temurin-21.0.2+13.0.LTS" 3 | clojure = "1.12.0.1517" 4 | babashka = "1.12.196" 5 | clj-kondo = "2025.01.16" 6 | cljfmt = "0.13.0" 7 | 8 | [alias] 9 | cljfmt = "asdf:https://github.com/b-social/asdf-cljfmt" -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | *The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)* 4 | 5 | ## [0.1.8 ] - 2025-04-20 6 | 7 | ### Added 8 | 9 | - New user api namespace. 10 | - Added the ability to "freeze" wraps. 11 | - Persistent constructor now available in environment as `<-` 12 | - _"multi-deftype optimization"_ for hot code paths. 13 | - Constructor optimization. 14 | 15 | ### Fixed 16 | 17 | - Fixed some performance regressions. 18 | 19 | ### Changed 20 | 21 | - Renamed library to _`wrap` map_. 22 | 23 | ### Removed 24 | 25 | Old files and naming conventions. 26 | 27 | ## [0.1.0] - 2025-04-13 28 | 29 | ### Added 30 | 31 | - Initial commit. 32 | - Migrated logic from ti-yong. 33 | 34 | ## 0.1.1 - 2025-04-15 35 | 36 | ### Added 37 | 38 | - Introduced High-Level API: Added wrap/assoc and wrap/dissoc functions using simple keywords (e.g., :get, :assoc) for easier customization of common behaviors. 39 | - Added examples-high-level.md and updated documentation. 40 | 41 | ### Changed 42 | 43 | #### Major Performance Optimizations: 44 | 45 | - Implemented specialized internal types (WrapMap+...) to significantly speed up baseline assoc and get operations by reducing runtime dispatch overhead. 46 | - Optimized wrap map constructor, especially when called via apply, bringing performance close to native hash-map. 47 | - Improved transient batch assoc! performance to be nearly on par with native transients. 48 | - Improved persistent! performance, though it remains an area with overhead compared to native maps. 49 | - Clojure Benchmark changes: 50 | - Read Existing Key 51 | - +2.0% improvement 52 | - Read Missing Key 53 | - +59.6% improvement 54 | - Write (Update Existing Key) 55 | - +5.5% improvement 56 | - Reduce (Sum Val) 57 | - +6.2% 58 | - Construct (into) 59 | - +72.0% improvement 60 | - Construct (apply) 61 | - +683.6% improvement 62 | - Simple assoc (Baseline Wrap) 63 | - +12.9% improvement 64 | - Simple assoc (Logging Wrap) 65 | - +115.9% improvement 66 | - assoc New Key (Baseline Wrap) 67 | - +1518.7% improvement 68 | - assoc New Key (Validated Wrap) 69 | - +1465.1% improvement 70 | - Batch assoc! (Baseline Wrap) 71 | - +180.5% improvement 72 | - Batch assoc! (Logging Wrap) 73 | - +77.4% improvement 74 | - persistent! Cost 75 | - +56.1% improvement 76 | - Contended Update 77 | - +135.4% improvement 78 | - ClojureScript Benchmark changes: 79 | - Read Existing Key (Large Map) 80 | - +25.2% improvement 81 | - Read Missing Key 82 | - +54.9% improvement 83 | - Write (Update Existing Key - Large Map) 84 | - +97.3% improvement 85 | - Reduce (Sum Values - Large Map) 86 | - -2.6% regression (still faster than vanilla `hash-map`s here though) 87 | - Simple assoc (Baseline Wrap - Small) 88 | - +272.4% improvement 89 | - Simple assoc (Logging Wrap - Small) 90 | - +318.7% improvement 91 | - assoc New Key (Baseline Wrap - Large) 92 | - +82.9% improvement 93 | - assoc New Key (Validated Wrap - Large) 94 | - +85.7% improvement 95 | - Batch assoc! (Baseline Wrap) 96 | - +12.0% improvement 97 | - persistent! Cost 98 | - +36.4% improvement 99 | - Using repo/git workflow from https://bogoyavlensky.com/blog/build-and-publish-clojure-lib-with-slim/ 100 | - Will migrate commands to `bb` tasks in a future release. 101 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2025 John Newman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `wrap` map 2 | 3 | _"map type maps"_ 4 | 5 | [![Clojars Project](https://img.shields.io/clojars/v/com.jolygon/wrap-map.svg)](https://clojars.org/com.jolygon/wrap-map) [![Deploy Release](https://github.com/johnmn3/wrap-map/actions/workflows/release.yaml/badge.svg)](https://github.com/johnmn3/wrap-map/actions/workflows/release.yaml) [![cljdoc badge](https://cljdoc.org/badge/com.jolygon/wrap-map)](https://cljdoc.org/d/com.jolygon/wrap-map) 6 | 7 | `wrap` maps provide a flexible way to create specialized map-like data structures in Clojure and ClojureScript. It allows you to intercept and customize standard map operations like `get`, `assoc`, `dissoc`, function invocation, printing, and more. This enables built-in validation, side effects, lazy loading, default values, case-insensitive keys, and other custom behaviors without needing to reimplement all the underlying map interfaces. 8 | 9 | ### Elevator Pitch 10 | 11 | Suppose you want to instrument a map so that you can debug something that is going on deep in some opaque pipeline you're working on: 12 | 13 | ```clojure 14 | (-> {:a 1} 15 | (w/assoc 16 | :assoc #(do (when (= :easter! %3) (prn :egg! :assoc %2)) (assoc %1 %2 %3)) 17 | :assoc! #(do (when (= :easter! %3) (prn :egg! :assoc! %2)) (assoc! %1 %2 %3)) 18 | :get #(let [r (get %1 %2)] (when (= :easter! r) (prn :egg! :get %2)) r)) 19 | (assoc :b 2) 20 | #_... 21 | transient 22 | (assoc! :5ecr3t :easter!) 23 | persistent! 24 | #_... 25 | (assoc :5ecr3t :redacted) 26 | #_... 27 | #_... 28 | w/unwrap 29 | (assoc :done 1)) 30 | ; :egg! :assoc! :5ecr3t 31 | {:a 1, :b 2, :5ecr3t :redacted, :done 1} 32 | ``` 33 | 34 | Now you can! And, notice, after `unwrap`ing the map the instrumentation disappears. It's magic! 35 | 36 | Think of it as adding middleware or aspects directly to your map data structure. It's similar to the proxy or decorator pattern, but more functional. It offers two ways to customize behavior: 37 | 38 | 1. **High-Level API:** The casual and easy way. Uses simple keywords (e.g., `:get`, `:assoc`) to attach handlers for common map operations. Easier to use for most scenarios in applications or application specific data wrangling. 39 | 2. **Low-Level API:** Provides fine-grained control by allowing overrides for specific underlying protocol/interface methods using namespaced keywords (e.g., `:valAt_k_nf`, `:T_assoc_k_v`). Useful for advanced cases or overriding methods not exposed by the high-level API. Prefer the low-level API when building libraries on top of `wrap` maps. Low level API versions are guaranteed remain stable. 40 | 41 | ## Motivation 42 | 43 | Sometimes, you need a map that does *more* than just associate keys with values. You might want to: 44 | 45 | * Validate data against a schema as it's being `assoc`'d. 46 | * Provide computed default values when a key is missing (`get`). 47 | * Trigger side effects (logging, notifications, DB persistence) when the map is modified. 48 | * Log access patterns for debugging or analytics. 49 | * Treat string keys case-insensitively. 50 | * Implement lazy loading for specific keys. 51 | * Make the map itself callable (`IFn`) to perform a specific action based on its content. 52 | * Create read-only views of map data (using the low-level API). 53 | 54 | `wrap` maps provide a structured and composable way to achieve these behaviors by wrapping a standard Clojure(Script) map and delegating operations through customizable handlers. 55 | 56 | ## Features 57 | 58 | * **Behavioral Customization:** Override standard map operations via high-level keywords (`:get`, `:assoc`, `:dissoc`, etc.) or low-level method keys. 59 | * **Function Call Override:** Make map instances callable with custom logic using the `:invoke` high-level keyword or low-level `:invoke`. 60 | * **Custom Printing:** Control how the map is represented as a string using the `:print` high-level keyword or low-level keys. 61 | * **Transient Support:** Efficient batch updates using transients, with support for overriding transient-specific operations via low-level keys. 62 | * **Metadata Preservation:** Correctly handles metadata (`meta`, `with-meta`). 63 | * **Clojure & ClojureScript:** Works consistently across both platforms. 64 | 65 | ## Compatibility 66 | 67 | Developed and tested with Clojure 1.12.x and ClojureScript 1.11.x. 68 | 69 | ## Installation 70 | 71 | Add the following dependency: 72 | 73 | **deps.edn:** 74 | 75 | ```clojure 76 | com.jolygon/wrap-map {:mvn/version "0.1.11"} 77 | ``` 78 | 79 | ## Basic Usage (High-Level API) 80 | 81 | Require the main API namespace, aliased as `w`. 82 | 83 | ```clojure 84 | (require '[com.jolygon.wrap-map :as w :refer [wrap]]) 85 | ``` 86 | 87 | You create a `wrap` map just like a regular map: 88 | 89 | ```clojure 90 | (def m1 (wrap :a 1 :b 2)) 91 | ;=> {:a 1, :b 2} 92 | 93 | ;; It behaves like a standard Clojure(Script) map by default: 94 | (get m1 :a) ;=> 1 95 | (get m1 :c 404) ;=> 404 96 | (:b m1) ;=> 2 97 | (count m1) ;=> 2 98 | (assoc m1 :c 3) ;=> {:a 1, :b 2, :c 3} 99 | (dissoc m1 :a) ;=> {:b 2} 100 | (keys m1) ;=> (:a :b) 101 | (vals m1) ;=> (1 2) 102 | 103 | ;; It's persistent: 104 | (def m2 (assoc m1 :c 3)) 105 | m1 ;=> {:a 1, :b 2} 106 | m2 ;=> {:a 1, :b 2, :c 3} 107 | 108 | ;; Transient support works as expected: 109 | (persistent! (assoc! (transient m1) :d 4)) 110 | ;=> {:a 1, :b 2, :d 4} 111 | ``` 112 | 113 | ### Customizing Behavior (High-Level API): 114 | 115 | Use `w/assoc` to attach behavior handlers using simple keywords. The first argument is a `wrap` map (or just a map), followed by keyword/handler pairs. 116 | 117 | ```clojure 118 | (def default-value-map 119 | (-> (wrap :c 3) 120 | (w/assoc :get (fn [m k & [nf]] 121 | (get m k (or nf :not-available)))))) 122 | 123 | (def m-with-default (assoc default-value-map :a 1)) 124 | 125 | (get m-with-default :a) ;=> 1 126 | (get m-with-default :b) ;=> :not-available 127 | (get m-with-default :b :explicit-nf) ;=> :explicit-nf (uses provided not-found) 128 | (m-with-default :b) ;=> :not-available (:invoke behavior defaults to :get) 129 | 130 | ;; Example 2: Case-Insensitive String Keys 131 | (defn- normalize-key [k] 132 | (if (string? k) (.toLowerCase ^String k) k)) 133 | 134 | (def case-insensitive-map 135 | (-> {:other :keys :in :a :regular :map} 136 | (w/assoc ;<- `w/assoc` and friends auto-`wrap` their map arg when needed 137 | :assoc (fn [m k v] (assoc m (normalize-key k) v)) 138 | :dissoc (fn [m k] (dissoc m (normalize-key k))) 139 | :contains? (fn [m k] (contains? m (normalize-key k))) 140 | :get (fn [m k & [nf]] (get m (normalize-key k) nf))))) 141 | 142 | (def headers (-> case-insensitive-map (assoc "Content-Type" "application/json"))) 143 | 144 | (get headers "content-type") ;=> "application/json" 145 | (contains? headers "CONTENT-TYPE") ;=> true 146 | (dissoc headers "Content-type") ;=> {:other :keys :in :a :regular :map} 147 | 148 | ;; Want to freeze a wrap map to its current implementation? 149 | 150 | (def frozen-headers (w/freeze headers)) 151 | 152 | (w/assoc frozen-headers :get #(get %1 (.toUpperCase %2))) 153 | ; Execution error (ExceptionInfo) at com.jolygon.wrap_map.api_0.impl.WrapMap+assoc_k_v|valAt_k/_assoc_impl (impl.clj:797). 154 | ; Cannot set impls on frozen wrap map 155 | 156 | ``` 157 | 158 | ## Core Concept: High-Level Behaviors 159 | 160 | The high-level `w/assoc` function associates handler functions with specific behavior keywords. These keywords generally correspond to common map operations. 161 | 162 | ### Available Behavior Keywords: 163 | 164 | * `:get`: Overrides key lookup (`get`, keyword invocation, map-as-function arity-1/arity-2). 165 | 166 | * Handler signature: `(fn [m k] ...)` or `(fn [m k nf] ...)` 167 | 168 | * `:assoc`: Overrides key/value association (`clojure.core/assoc`). 169 | 170 | * Handler signature: `(fn [m k v] ...)` 171 | * Must return: The new underlying map after association. 172 | 173 | * `:dissoc`: Overrides key removal (`clojure.core/dissoc`). 174 | 175 | * Handler signature: `(fn [m k] ...)` 176 | * _Must return:_ The new underlying map after dissociation. 177 | 178 | * `:contains?`: Overrides key presence check (contains?). 179 | 180 | * Handler signature: `(fn [m k] ...)` 181 | * _Must return:_ Boolean. 182 | 183 | * `:invoke`: Overrides map-as-function behavior for all arities. 184 | 185 | * Handler signature: `(fn [m & args] ...)` 186 | 187 | * `:print`: Overrides how the map is printed (`print-method`, `str`). 188 | 189 | * Handler signature: `(fn [m] ...)` 190 | * _Must return:_ A string representation. 191 | 192 | When you use `w/assoc`, it translates the behavior keyword (e.g., `:get`) into one or more low-level implementation keys (e.g., `:valAt_k`, `:valAt_k_nf`) and registers your handler function appropriately using the low-level `assoc-impl` mechanism. However, if a high level key is not available, `w/assoc` behaves just like `assoc-impl`, so you can use `w/assoc` for both. 193 | 194 | ## Advanced Usage (Low-Level API) 195 | 196 | For finer control, direct access to underlying protocol/interface methods, or to implement behaviors not covered by the high-level keywords (like complex transient interactions or read-only maps), you can use the low-level API. 197 | 198 | 1. **Structure**: A `WrapMap` internally holds: 199 | - `e`: A persistent map where keys are reserved, specific **unqualified keywords** and values are functions that override default implementation for the method associated with the keyword. 200 | - `m`: The underlying map holding the actual data. 201 | 202 | 2. **Implementation Keys**: Override functions are associated with namespace _unqualified_ keyword keys. 203 | - For persistent map operations in Clojurescript: 204 | > :toString :-conj_v :-empty :-dissoc_k :-assoc_k_v :-contains-key?_k :-find_k :-seq :-meta :withMeta_new-meta :-count :-lookup_k :-lookup_k_nf :kv-reduce_f_init :invoke :invoke-variadic :-pr-writer_writer_opts 205 | - For transient map operations in Clojurescript: 206 | > :T_-conj! :T_-assoc!_k_v :T_-dissoc!_k :T_-lookup_k :T_-lookup_k_nf :T_-count 207 | - For persistent map operations in Clojure: 208 | > :toString :containsKey_k :entryAt_k :assoc_k_v :kvreduce_f_init :valAt_k :valAt_k_nf :keyIterator :valIterator :count :empty :cons_v :assocEx_k_v :without_k :seq :iterator :invoke :invoke-variadic :asTransient :withMeta_meta :meta :coll-reduce_afn :coll-reduce_afn_init :kv-reduce_afn_init :size :isEmpty :containsValue_v :get_k :get_k_nf :entrySet :keySet :values :put :remove :putAll :clear :print-method_writer 209 | - For transient map operations in Clojure: 210 | > :T_conj_v :T_assoc_k_v :T_without_k :T_valAt_k :T_valAt_k_nf :T_count 211 | 212 | 3. **Override Function Signatures**: Low-level override functions receive more arguments. They often need to return a variant of `WrapMap`using the `<-` constructor function - in the form of: `(<- e m)`. `TransientWrapMap`, on the other hand, handle's returning it's own `this` on mutating operations - all you have to do is perform the mutating operations on the transient map (`t_m`) and it will be returned. You cannot make changes to the implementations environment map `e` while in transient mode. You are only provided `e` for informational access to the implementations and metadata, for meta programming purposes. 213 | 214 | 4. **Providing Low-Level Implementations**: Use `w/vary` or `w/assoc`. `w/assoc` can handle both high level and low level keys. 215 | 216 | ```clojure 217 | ;; Example: Read-Only Map (Requires Low-Level API) 218 | (defn read-only-error [& _] 219 | (throw (UnsupportedOperationException. "Map is read-only"))) 220 | 221 | (def read-only-map-impls 222 | {:assoc_k_v read-only-error ;; Override persistent assoc 223 | :without_k read-only-error ;; Override persistent dissoc 224 | :cons_v read-only-error ;; Override persistent conj 225 | :assocEx_k_v read-only-error 226 | ;; Override transient mutations too 227 | :T_assoc_k_v read-only-error 228 | :T_without_k read-only-error 229 | :T_conj_v read-only-error}) 230 | 231 | (def read-only-m 232 | (-> (wrap :a 1) 233 | (w/vary merge read-only-map-impls))) 234 | 235 | ;; Usage 236 | (get read-only-m :a) ;=> 1 237 | (try (assoc read-only-m :b 2) (catch Exception e (.getMessage e))) 238 | ;=> "Map is read-only" 239 | (try (persistent! (assoc! (transient read-only-m) :c 3)) (catch Exception e (.getMessage e))) 240 | ;=> "Map is read-only" 241 | 242 | ;; Example 2 - surgical modifications (here logging) in a functional pipeline 243 | 244 | (-> {:a 1} 245 | (assoc :b 2) 246 | (w/assoc 247 | :T_assoc_k_v (fn [_ t-m k v] 248 | (println "[Transient] assoc! key:" k "val:" v) 249 | (assoc! t-m k v))) 250 | transient 251 | (assoc! :x 100) 252 | (assoc! :y 200) 253 | persistent! 254 | w/unwrap 255 | (dissoc :b) 256 | (w/assoc 257 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 258 | (println "[Persistent] assoc key:" k "val:" v) 259 | (<- e (assoc m k v)))) ;<- persistent ops require `<- constructor 260 | (assoc :z 300) 261 | w/unwrap 262 | (assoc :done 1)) 263 | ; [Transient] assoc! key: :x val: 100 264 | ; [Transient] assoc! key: :y val: 200 265 | ; [Persistent] assoc key: :z val: 300 266 | {:a 1, :x 100, :y 200, :z 300, :done 1} 267 | ``` 268 | 269 | ### Examples 270 | 271 | For more detailed examples covering both APIs, see: 272 | 273 | - [High level examples](./doc/examples-high-level.md) (using `w/assoc` with keywords) 274 | - [Low level examples](./doc/examples.md) (using `w/vary`, etc.) 275 | 276 | ### Performance 277 | 278 | Significant performance optimizations have been implemented, including specializing internal types and optimizing constructors. 279 | 280 | * **Overall**: Based on recent benchmarks (Run 5/6), baseline `wrap` map operations (reads, writes, construction, reduction, batch transient updates) now perform very close to, and sometimes exceed, the speed of standard Clojure/Script hash maps and transients. 281 | * **CLJ**: The geometric mean across baseline operations showed `wrap` maps at ~95% the speed of standard maps. 282 | * **CLJS**: The geometric mean across baseline operations showed `wrap` maps at ~72% the speed of standard maps, heavily influenced by the `persistent!` cost. Many individual CLJS operations (writes, reductions) were faster than standard maps. 283 | * **Bottleneck**: The primary remaining bottleneck relative to standard maps appears to be the cost of transitioning from a transient `wrap` back to a persistent one (`persistent!`), especially in ClojureScript. 284 | * **Overrides**: Adding custom behavior via handlers still incurs some overhead compared to baseline `wrap` map operations, which is expected. However, the baseline is now much faster. 285 | 286 | See [./bench/ex/clj-bench.md](./doc/clj-bench.md) for Clojure benchmark details and [./bench/ex/cljs-bench.md](./doc/cljs-bench.md) for ClojureScript benchmark details. Contributions for further optimization are welcome! 287 | 288 | ### See Also 289 | 290 | * **Potemkin** (`def-map-type`): Potemkin's `def-map-type` is excellent for creating _new, specific map-like types_ that efficiently implement map interfaces, often based on delegating to underlying fields or structures. Choose `def-map-type` when you need a new, static, record-like data type with map semantics. Choose `wrap` maps when you want to add dynamic behaviors (validation, logging, computation, interception) to existing map data or general-purpose map structures without defining a whole new type, or when you want to change behaviors dynamically using `assoc-impl`/`vary`. 291 | * `defrecord` / `deftype`: Suitable for creating fixed-schema, efficient data structures. They can implement protocols for map-like behavior, but you implement the methods directly. Less flexible for dynamic behavior modification compared to `wrap` maps. 292 | * **Protocols**: Clojure's protocols allow defining interfaces that different types can implement. You could define a protocol for custom map behavior, but `wrap` maps provide a ready-made implementation structure focused specifically on wrapping and intercepting standard map operations. 293 | * **Schema Libraries (Malli, Spec)**: Primarily focused on data validation and specification, often used externally to map operations rather than being baked into the map's behavior itself, although they can be integrated using `wrap` handlers (as shown in examples). 294 | * **Proxy**: Allows dynamic implementation of interfaces, but generally comes with a larger performance overhead than `deftype` or `wrap` map's approach. 295 | 296 | ### Development 297 | 298 | Clone the repository and run tests using the Clojure CLI: 299 | 300 | ```bash 301 | # Clojure tests 302 | clj -X:test-clj 303 | 304 | # ClojureScript tests (requires NodeJS) 305 | clj -M:test-cljs 306 | ``` 307 | 308 | To run benchmarks: 309 | 310 | ### Run Clojure benchmarks 311 | ```bash 312 | clj -M:benchmark-clj 313 | ``` 314 | 315 | ### Run ClojureScript benchmarks 316 | ```bash 317 | clj -M:benchmark-cljs-node 318 | ``` 319 | 320 | ### Discussion 321 | 322 | Head on over to zulip chat: [![project chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://clojurians.zulipchat.com/#narrow/channel/499006-wrap-maps) 323 | 324 | Or add some long form discussoin to the forum post up on Clojureverse: https://clojureverse.org/t/wrap-maps/11338 325 | 326 | ### License 327 | 328 | Copyright © 2025 Jolygon 329 | 330 | Distributed under the MIT license. See LICENSE file for details. 331 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:tasks 2 | {:enter (println "Running task:" (:name (current-task))) 3 | 4 | deps {:doc "Install all deps" 5 | :task (clojure "-P -X:dev:test")} 6 | 7 | fmt-check {:doc "Check code formatting" 8 | :task (shell "cljfmt" "check")} 9 | 10 | fmt {:doc "Fix code formatting" 11 | :task (shell "cljfmt" "fix")} 12 | 13 | lint-init {:doc "Import linting configs" 14 | :task (shell "clj-kondo" "--parallel" "--dependencies" "--copy-configs" 15 | "--lint" (with-out-str (clojure "-Spath")))} 16 | 17 | lint {:doc "Linting project's code" 18 | :task (shell "clj-kondo" "--parallel" "--lint" "src" "test")} 19 | 20 | test {:doc "Run tests" 21 | :task (clojure "-X:dev:test")} 22 | 23 | cljs-test {:doc "Run CLJS tests" 24 | :task (clojure "-M:test-cljs")} 25 | 26 | outdated-check {:doc "Check outdated Clojure deps versions" 27 | :task (clojure "-M:outdated")} 28 | 29 | outdated {:doc "Upgrade outdated Clojure deps versions" 30 | :task (clojure "-M:outdated --upgrade --force")} 31 | 32 | check {:doc "Run all code checks and tests" 33 | :depends [fmt lint outdated test cljs-test]} 34 | 35 | install-snapshot {:doc "Install version locally" 36 | :task (clojure "-T:build install :snapshot true")} 37 | 38 | install {:doc "Install version locally" 39 | :task (clojure "-T:build install")} 40 | 41 | deploy-snapshot {:doc "Deploy snapshot version to Clojars" 42 | :task (clojure "-T:build deploy :snapshot true")} 43 | 44 | deploy-release {:doc "Deploy release version to Clojars" 45 | :task (clojure "-T:build deploy")} 46 | 47 | release {:doc "Create and push git tag for release" 48 | :task (clojure "-T:build tag :push true")}}} 49 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {org.clojure/clojure {:mvn/version "1.12.0"} 3 | org.clojure/clojurescript {:mvn/version "1.11.132"}} 4 | :aliases 5 | {:dev {:extra-paths ["dev"]} 6 | :outdated {:extra-deps {com.github.liquidz/antq ^:antq/exclude {:mvn/version "2.11.1276"}} 7 | :main-opts ["-m" "antq.core" "--no-diff"]} 8 | :build {:deps {io.github.abogoyavlensky/slim {:mvn/version "0.3.2"} 9 | slipset/deps-deploy {:mvn/version "0.2.2"}} 10 | :ns-default slim.lib 11 | :exec-args {:version "0.1.11" 12 | :lib com.jolygon/wrap-map 13 | :url "https://github.com/johnmn3/wrap-map" 14 | :description "map type maps" 15 | :developer "John Michael Newman III"}} 16 | :benchmark-clj 17 | {:extra-paths ["bench"] 18 | :extra-deps {net.totakke/libra {:mvn/version "0.1.1"} 19 | criterium/criterium {:mvn/version "0.4.6"} 20 | net.totakke/libra-runner {:git/url "https://github.com/totakke/libra" 21 | :sha "dce129caf930cf502db26331ef1333ce22501a82" 22 | :deps/root "libra-runner"}} 23 | :main-opts ["-m" "libra.runner"]} 24 | :test {:extra-paths ["test"] 25 | :extra-deps {eftest/eftest {:mvn/version "0.6.0"} 26 | cloverage/cloverage {:mvn/version "1.2.4"}} 27 | :exec-fn cloverage.coverage/run-project 28 | :exec-args {:test-ns-path ["test"] 29 | :src-ns-path ["src"] 30 | :runner :eftest 31 | :runner-opts {:multithread? false}}} 32 | :test-cljs 33 | {:extra-paths ["test"] 34 | :extra-deps {olical/cljs-test-runner {:mvn/version "3.8.1"}} 35 | :main-opts ["-m" "cljs-test-runner.main"] 36 | :exec-fn com.jolygon.wrap-map.api-0-test/-main} 37 | 38 | :benchmark-cljs-node 39 | {:extra-paths ["bench"] 40 | :main-opts ["-m" "cljs.main" "-t" "node" "-m" "ex.cljs-bench"]} 41 | 42 | :benchmark-cljs-browser 43 | {:extra-paths ["src" "bench"] 44 | :main-opts ["-m" "cljs.main" "-r" "./bench/ex/cljs_bench.cljs" 45 | "-c" "ex.cljs-bench" "-m" "ex.cljs-bench" "-e" "\"(do (println :starting) (ex.cljs-bench/-main))\""]} 46 | 47 | :test-clj 48 | {:extra-paths ["test"] 49 | :extra-deps {io.github.cognitect-labs/test-runner 50 | {:git/tag "v0.5.1" :git/sha "dfb30dd"}} 51 | :main-opts ["-m" "cognitect.test-runner"] 52 | :exec-fn cognitect.test-runner.api/test}}} 53 | -------------------------------------------------------------------------------- /dev/ex/clj_bench.clj: -------------------------------------------------------------------------------- 1 | (ns ex.clj-bench 2 | (:require 3 | [libra.bench :refer [defbench is dur]] 4 | [libra.criterium :as c] 5 | [com.jolygon.wrap-map :as w :refer [wrap empty-wrap]])) 6 | 7 | (do 8 | 9 | (def small-std-map {:a 1 :b 2 :c 3}) 10 | (def small-wrap-map (wrap :a 1 :b 2 :c 3)) 11 | (def large-map-size 10000) 12 | (def large-std-map (into {} (mapv (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 13 | (def large-wrap-map (wrap large-std-map)) 14 | (def keys-to-access (vec (keys large-std-map))) 15 | (defn rand-key [] (rand-nth keys-to-access)) 16 | 17 | ;; Example Overrides 18 | (def log-atom (atom 0)) 19 | (defn logging-assoc-impl [{:as e :keys [<-]} m k v] 20 | (swap! log-atom inc) 21 | (<- e (assoc m k v))) 22 | 23 | (defn validating-assoc-impl [{:as e :keys [<-]} m k v] 24 | (if (keyword? k) 25 | (<- e (assoc m k v)) 26 | (throw (ex-info "Invalid key" {:key k})))) 27 | 28 | (def logged-wrap-map (w/assoc small-wrap-map :assoc_k_v logging-assoc-impl)) 29 | (def validated-wrap-map (w/assoc large-wrap-map :assoc_k_v validating-assoc-impl)) 30 | 31 | :end) 32 | ;; #_#_#_#_ 33 | (defbench baseline-read-large-standard-map 34 | (println :###########___Bench-1___###########) 35 | (is (dur 10000 (get large-std-map (rand-key))))) 36 | ;; #_ 37 | (defbench baseline-read-large-standard-map-criterium 38 | (is (c/bench (get large-std-map (rand-key))))) 39 | 40 | (defbench baseline-read-large-wrap-map 41 | (is (dur 10000 (get large-wrap-map (rand-key))))) 42 | ;; #_ 43 | (defbench baseline-read-large-wrap-map-criterium 44 | (is (c/bench (get large-wrap-map (rand-key)))) 45 | (println "\n\n")) 46 | 47 | 48 | ;; #_#_#_#_ 49 | (defbench baseline-read-missing-key-standard 50 | (println :###########___Bench-2___###########) 51 | (is (dur 10000 (get large-std-map :not-a-key :default-val)))) 52 | ;; #_ 53 | (defbench baseline-read-missing-key-standard-criterium 54 | (is (c/bench (get large-std-map :not-a-key :default-val)))) 55 | 56 | (defbench baseline-read-missing-key-wrap 57 | (is (dur 10000 (get large-wrap-map :not-a-key :default-val)))) 58 | ;; #_ 59 | (defbench baseline-read-missing-key-wrap-criterium 60 | (is (c/bench (get large-wrap-map :not-a-key :default-val))) 61 | (println "\n\n")) 62 | 63 | 64 | ;; #_#_#_#_ 65 | (defbench baseline-write-large-map-update-standard 66 | (println :###########___Bench-3___###########) 67 | (is (dur 10000 (assoc large-std-map (rand-key) 999)))) 68 | ;; #_ 69 | (defbench baseline-write-large-map-update-standard-criterium 70 | (is (c/bench (assoc large-std-map (rand-key) 999)))) 71 | 72 | (defbench baseline-write-large-map-update-wrap 73 | (is (dur 10000 (assoc large-wrap-map (rand-key) 999)))) 74 | ;; #_ 75 | (defbench baseline-write-large-map-update-wrap-criterium 76 | (is (c/bench (assoc large-wrap-map (rand-key) 999))) 77 | (println "\n\n")) 78 | 79 | #_ 80 | (let [r1 (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-std-map) 81 | r2 (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-std-map)] 82 | (println :same-reducing? (= r1 r2)) 83 | (println :r1 r1) 84 | (println :r2 r2)) 85 | 86 | ;; #_#_#_#_ 87 | (defbench baseline-reduce-large-map-sum-values-standard 88 | (println :###########___Bench-4___###########) 89 | (is (dur 10000 (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-std-map)))) 90 | ;; #_ 91 | (defbench baseline-reduce-large-map-sum-values-standard-criterium 92 | (is (c/bench (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-std-map)))) 93 | 94 | (defbench baseline-reduce-large-map-sum-values-wrap 95 | (is (dur 10000 (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-wrap-map)))) 96 | ;; #_ 97 | (defbench baseline-reduce-large-map-sum-values-wrap-criterium 98 | (is (c/bench (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-wrap-map))) 99 | (println "\n\n")) 100 | 101 | 102 | (def large-map-data (vec (mapcat (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 103 | 104 | ;; #_#_#_#_ 105 | (defbench baseline-construct-large-map-into-standard 106 | (println :###########___Bench-5___###########) 107 | (is (dur 1000 (into {} (mapv vec (partition 2 large-map-data)))))) 108 | ;; #_ 109 | (defbench baseline-construct-large-map-into-standard-criterium 110 | (is (c/bench (into {} (mapv vec (partition 2 large-map-data)))))) 111 | 112 | (defbench baseline-construct-large-map-into-wrap 113 | (is (dur 1000 (into empty-wrap (mapv vec (partition 2 large-map-data)))))) 114 | ;; #_ 115 | (defbench baseline-construct-large-map-into-wrap-criterium 116 | (is (c/bench (into empty-wrap (mapv vec (partition 2 large-map-data))))) 117 | (println "\n\n")) 118 | 119 | 120 | ;; #_#_#_#_ 121 | (defbench baseline-construct-large-map-apply-standard 122 | (println :###########___Bench-6___###########) 123 | (is (dur 1000 (apply hash-map large-map-data)))) 124 | ;; #_ 125 | (defbench baseline-construct-large-map-apply-standard-criterium 126 | (is (c/bench (apply hash-map large-map-data)))) 127 | 128 | (defbench baseline-construct-large-map-apply-wrap 129 | (is (dur 1000 (apply wrap large-map-data)))) 130 | ;; #_ 131 | (defbench baseline-construct-large-map-apply-wrap-criterium 132 | (is (c/bench (apply wrap large-map-data))) 133 | (println "\n\n")) 134 | 135 | 136 | ;; #_#_#_#_#_#_ 137 | (defbench override-impact-simple-assoc-standard 138 | (println :###########___Bench-7___###########) 139 | (is (dur 10000 (assoc small-std-map :d 4)))) 140 | ;; #_ 141 | (defbench override-impact-simple-assoc-standard-criterium 142 | (is (c/bench (assoc small-std-map :d 4)))) 143 | 144 | (defbench override-impact-simple-assoc-wrap 145 | (is (dur 10000 (assoc small-wrap-map :d 4)))) 146 | ;; #_ 147 | (defbench override-impact-simple-assoc-wrap-criterium 148 | (is (c/bench (assoc small-wrap-map :d 4)))) 149 | 150 | (defbench override-impact-simple-logging-assoc-wrap 151 | (is (dur 10000 (assoc logged-wrap-map :d 4)))) 152 | ;; #_ 153 | (defbench override-impact-simple-logging-assoc-wrap-criterium 154 | (is (c/bench (assoc logged-wrap-map :d 4))) 155 | (println "\n\n")) 156 | 157 | 158 | ;; #_#_#_#_#_#_ 159 | (defbench override-impact-large-assoc-new-key-standard 160 | (println :###########___Bench-8___###########) 161 | (is (dur 1000 (assoc large-std-map :d 4)))) 162 | ;; #_ 163 | (defbench override-impact-large-assoc-new-key-standard-criterium 164 | (is (c/bench (assoc large-std-map :d 4)))) 165 | 166 | (defbench override-impact-large-assoc-new-key-wrap 167 | (is (dur 1000 (assoc large-wrap-map :d 4)))) 168 | ;; #_ 169 | (defbench override-impact-large-assoc-new-key-wrap-criterium 170 | (is (c/bench (assoc large-wrap-map :d 4)))) 171 | 172 | (defbench override-impact-large-validated-assoc-new-key-wrap 173 | (is (dur 1000 (assoc validated-wrap-map :d 4)))) 174 | ;; #_ 175 | (defbench override-impact-large-validated-assoc-new-key-wrap-criterium 176 | (is (c/bench (assoc validated-wrap-map :d 4))) 177 | (println "\n\n")) 178 | 179 | 180 | (def items-to-add (vec (range large-map-size))) 181 | 182 | ;; #_#_#_#_ 183 | (defbench transient-batch-assoc!-standard 184 | (println :###########___Bench-9___###########) 185 | (is (dur 1000 (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient {}) items-to-add))))) 186 | ;; #_ 187 | (defbench transient-batch-assoc!-standard-criterium 188 | (is (c/bench (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient {}) items-to-add))))) 189 | 190 | (defbench transient-batch-assoc!-wrap 191 | (is (dur 1000 (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient empty-wrap) items-to-add))))) 192 | ;; #_ 193 | (defbench transient-batch-assoc!-wrap-criterium 194 | (is (c/bench (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient empty-wrap) items-to-add))))) 195 | 196 | (def logged-transient-map 197 | (-> empty-wrap 198 | (w/assoc 199 | :T_assoc_k_v 200 | (fn [_ t-m k v] 201 | (swap! log-atom inc) 202 | (assoc! t-m k v))))) 203 | 204 | ;; #_#_ 205 | (defbench transient-batch-assoc!-logging-wrap 206 | (is (dur 1000 (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient logged-transient-map) items-to-add))))) 207 | ;; #_ 208 | (defbench transient-batch-assoc!-logging-wrap-criterium 209 | (is (c/bench (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient logged-transient-map) items-to-add)))) 210 | (println "\n\n")) 211 | 212 | 213 | ;; #_#_#_#_ 214 | (defbench transient-persistent!-cost-standard 215 | (println :###########___Bench-10___###########) 216 | (is (dur 1000 (persistent! (transient large-std-map))))) 217 | ;; #_ 218 | (defbench transient-persistent!-cost-standard-criterium 219 | (is (c/bench (persistent! (transient large-std-map))))) 220 | 221 | (defbench transient-persistent!-cost-wrap 222 | (is (dur 1000 (persistent! (transient large-wrap-map))))) 223 | ;; #_ 224 | (defbench transient-persistent!-cost-wrap-criterium 225 | (is (c/bench (persistent! (transient large-wrap-map)))) 226 | (println "\n\n")) 227 | 228 | 229 | (def counter (atom 0)) 230 | (def contended-wrap-map 231 | (-> empty-wrap 232 | (w/assoc 233 | :T_assoc_k_v 234 | (fn [_ t-m k v] 235 | (swap! counter inc) 236 | (assoc! t-m k v))))) 237 | 238 | (defn contended-wrap-update [n-updates] 239 | (reset! counter 0) 240 | (let [futures (doall (for [_ (range 10)] ; Simulate 10 threads 241 | (future 242 | (persistent! 243 | (reduce (fn [t i] (assoc! t (keyword (str "k" i)) i)) 244 | (transient contended-wrap-map) 245 | (range n-updates))))))] 246 | (run! deref futures))) ; Wait for all futures 247 | 248 | (def contended-std-map {}) 249 | 250 | (defn contended-std-update [n-updates] 251 | (let [futures (doall (for [_ (range 10)] ; Simulate 10 threads 252 | (future 253 | (persistent! 254 | (reduce (fn [t i] (assoc! t (keyword (str "k" i)) i)) 255 | (transient contended-std-map) 256 | (range n-updates))))))] 257 | (run! deref futures))) ; Wait for all futures 258 | 259 | (defbench transient-contended-standard 260 | (println :###########___Bench-11___###########) 261 | (is (dur 10000 (contended-std-update 100)))) 262 | ;; #_ 263 | (defbench transient-contended-standard-criterium 264 | (is (c/bench (contended-std-update 100)))) 265 | 266 | (defbench transient-contented-wrap 267 | (is (dur 10000 (contended-wrap-update 100)))) 268 | ;; #_ 269 | (defbench transient-contented-wrap-criterium 270 | (is (c/bench (contended-wrap-update 100))) 271 | (println "\n\n")) 272 | -------------------------------------------------------------------------------- /dev/ex/cljs_bench.cljs: -------------------------------------------------------------------------------- 1 | (ns ex.cljs-bench 2 | (:require 3 | [com.jolygon.wrap-map :as w :refer [wrap]])) 4 | 5 | ;; (set-print-fn! println) 6 | 7 | (println :starting :ex.cljs-bench) 8 | 9 | ;; baseline 10 | (def small-std-map {:a 1 :b 2 :c 3}) 11 | (def small-wrap-map (wrap :a 1 :b 2 :c 3)) 12 | (def large-map-size 10000) 13 | (def large-std-map (into {} (mapv (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 14 | (def large-wrap-map (into w/empty-wrap large-std-map)) 15 | (def frozen-large-wrap-map (w/freeze large-wrap-map)) 16 | (def keys-to-access (vec (keys large-std-map))) 17 | (defn rand-key [] (rand-nth keys-to-access)) 18 | ;; Overrides 19 | (def log-atom (atom 0)) 20 | (defn logging-assoc-impl [{:as e :keys [<-]} m k v] 21 | (swap! log-atom inc) 22 | (<- e (assoc m k v))) 23 | (defn validating-assoc-impl [{:as e :keys [<-]} m k v] 24 | (if (keyword? k) 25 | (<- e (assoc m k v)) 26 | (throw (ex-info "Invalid key" {:key k})))) 27 | (def logged-wrap-map (w/assoc small-wrap-map :-assoc_k_v logging-assoc-impl)) 28 | (def frozen-logged-wrap-map (w/freeze logged-wrap-map)) 29 | (def validated-wrap-map (w/assoc large-wrap-map :-assoc_k_v validating-assoc-impl)) 30 | (def frozen-validated-wrap-map (w/freeze validated-wrap-map)) 31 | (def large-map-data (vec (mapcat (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 32 | (def items-to-add (vec (range large-map-size))) 33 | 34 | (defn ascii-bar-chart 35 | "Generates a 25-char wide ASCII bar chart comparing a percentage to 100% 36 | in the specified format. Percentage should be provided as a number (e.g., 91.3)." 37 | [percentage] 38 | (let [width 25 39 | scale 4.0 40 | num-chars (-> (/ (double percentage) scale) 41 | (Math/round) 42 | (long) 43 | (max 0)) 44 | wrap-bar (str "|" 45 | (apply str (repeat (dec num-chars) "-")) 46 | (case percentage 47 | 0 " " 1 " " 2 " " 98 "|" 99 "|" 100 "-|" 101 "-|" "|") 48 | (->> (repeat (- width num-chars) " ") (apply str))) 49 | std-bar "|-------------------------|" 50 | wrap-label (str " Wrap " percentage "%") 51 | std-label "Std (100%)" 52 | scale-str "| 0% | 25% | 50% | 75% | 100%"] 53 | (str std-bar "\n" 54 | wrap-bar (if (< 99 percentage) "" "|") wrap-label "\n" 55 | std-bar " " std-label "\n" 56 | scale-str))) 57 | 58 | (defn parse-out-msecs [report] 59 | (->> report 60 | str 61 | reverse 62 | (drop 6) 63 | (take-while #(-> % (not= ","))) 64 | reverse 65 | rest 66 | (apply str) 67 | js/parseInt)) 68 | 69 | (defn get-average [form & [n]] 70 | (let [runs (take 10 (repeatedly #(parse-out-msecs (simple-benchmark [] (form) (or n 1000) :print-fn identity))))] 71 | (->> runs 72 | (apply +) 73 | (* 0.1) 74 | int))) 75 | 76 | (defn data-bench-compare [title form-fn1 form-fn2 & [n]] 77 | (let [title (or title "Benchmark") 78 | res1 (get-average form-fn1 n) 79 | res2 (get-average form-fn2 n) 80 | av (int (* 100.0 (/ res1 res2))) 81 | chart (ascii-bar-chart av) 82 | description (str "wrap map is " av "% the speed of hash-map") 83 | in-macro? false] 84 | (println "\n### " title "\n") 85 | (when in-macro? 86 | (println "```clojure") 87 | (println form-fn2) 88 | (println "```\n")) 89 | (println "- Standard Map:" res1 "ms") 90 | (println "- Wrap Map:" res2 "ms") 91 | (println "-" description "\n") 92 | (println "```clojure") 93 | (println chart) 94 | (println "```\n") 95 | {:description description 96 | :standard res1 :wrap-map res2 :% av :chart chart})) 97 | 98 | (def frozen-empty-wrap (w/freeze w/empty-wrap)) 99 | 100 | (defn -main [& _args] 101 | 102 | (data-bench-compare 103 | "Baseline Read: Large Map" 104 | #(get large-std-map (rand-key)) 105 | #(get large-wrap-map (rand-key)) 106 | 1000000) 107 | 108 | (data-bench-compare 109 | "Frozen Baseline Read: Large Map" 110 | #(get large-std-map (rand-key)) 111 | #(get frozen-large-wrap-map (rand-key)) 112 | 1000000) 113 | 114 | (data-bench-compare 115 | "Baseline Read: Missing Key" 116 | #(get large-std-map :not-a-key :default-val) 117 | #(get large-wrap-map :not-a-key :default-val) 118 | 1000000) 119 | 120 | (data-bench-compare 121 | "Frozen Baseline Read: Missing Key" 122 | #(get large-std-map :not-a-key :default-val) 123 | #(get frozen-large-wrap-map :not-a-key :default-val) 124 | 1000000) 125 | 126 | (data-bench-compare 127 | "Baseline Write: Large Map Update" 128 | #(assoc large-std-map (rand-key) 999) 129 | #(assoc large-wrap-map (rand-key) 999) 130 | 1000000) 131 | 132 | (data-bench-compare 133 | "Frozen Baseline Write: Large Map Update" 134 | #(assoc large-std-map (rand-key) 999) 135 | #(assoc frozen-large-wrap-map (rand-key) 999) 136 | 1000000) 137 | 138 | (data-bench-compare 139 | "Baseline Reduce: Large Map Sum Values" 140 | #(reduce-kv (fn [acc _ v] (+ acc v)) 0 large-std-map) 141 | #(reduce-kv (fn [acc _ v] (+ acc v)) 0 large-wrap-map) 142 | 1000) 143 | 144 | (data-bench-compare 145 | "Frozen Baseline Reduce: Large Map Sum Values" 146 | #(reduce-kv (fn [acc _ v] (+ acc v)) 0 large-std-map) 147 | #(reduce-kv (fn [acc _ v] (+ acc v)) 0 frozen-large-wrap-map) 148 | 1000) 149 | 150 | (data-bench-compare 151 | "Baseline Into: Large Map Sum Values" 152 | #(into {} (mapv vec (partition 2 large-map-data))) 153 | #(into w/empty-wrap (mapv vec (partition 2 large-map-data))) 154 | 10) 155 | 156 | (let [f-empty-wrap (w/freeze w/empty-wrap)] 157 | (data-bench-compare 158 | "Frozen Baseline Into: Large Map Sum Values" 159 | #(into {} (mapv vec (partition 2 large-map-data))) 160 | #(into f-empty-wrap (mapv vec (partition 2 large-map-data))) 161 | 10)) 162 | 163 | (data-bench-compare 164 | "Baseline Apply: Large Map Sum Values" 165 | #(apply hash-map large-map-data) 166 | #(apply w/wrap large-map-data) 167 | 100) 168 | 169 | ;; direct constructor for frozen 170 | (println "") 171 | (println "No frozen apply constructor") 172 | (println "") 173 | 174 | (data-bench-compare 175 | "Override Impact Baseline: Simple Assoc" 176 | #(assoc small-std-map :d 4) 177 | #(assoc small-wrap-map :d 4) 178 | 1000000) 179 | 180 | (data-bench-compare 181 | "Override Impact: Simple Logging Assoc" 182 | #(assoc small-std-map :d 4) 183 | #(assoc logged-wrap-map :d 4) 184 | 1000000) 185 | 186 | (data-bench-compare 187 | "Frozen Override Impact: Simple Logging Assoc" 188 | #(assoc small-std-map :d 4) 189 | #(assoc frozen-logged-wrap-map :d 4) 190 | 1000000) 191 | 192 | (data-bench-compare 193 | "Override Impact: Validating Assoc - Valid Key" 194 | #(assoc large-std-map :new-key 123) 195 | #(assoc validated-wrap-map :new-key 123) 196 | 1000000) 197 | 198 | (data-bench-compare 199 | "Frozen Override Impact: Validating Assoc - Valid Key" 200 | #(assoc large-std-map :new-key 123) 201 | #(assoc frozen-validated-wrap-map :new-key 123) 202 | 1000000) 203 | 204 | (data-bench-compare 205 | "Compare Baseline Assoc Large" 206 | #(assoc large-std-map :new-key 123) 207 | #(assoc large-wrap-map :new-key 123) 208 | 1000000) 209 | 210 | (data-bench-compare 211 | "Frozen Compare Baseline Assoc Large" 212 | #(assoc large-std-map :new-key 123) 213 | #(assoc frozen-large-wrap-map :new-key 123) 214 | 1000000) 215 | 216 | (data-bench-compare 217 | "Transient: Batch Assoc!" 218 | #(persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient {}) items-to-add)) 219 | #(persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient w/empty-wrap) items-to-add)) 220 | 100) 221 | 222 | (data-bench-compare 223 | "Frozen Transient: Batch Assoc!" 224 | #(persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient {}) items-to-add)) 225 | #(persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient frozen-empty-wrap) items-to-add)) 226 | 100) 227 | 228 | (data-bench-compare 229 | "Transient: persistent! Cost" 230 | #(persistent! (transient large-std-map)) 231 | #(persistent! (transient large-wrap-map)) 232 | 1000000) 233 | 234 | (data-bench-compare 235 | "Frozen Transient: persistent! Cost" 236 | #(persistent! (transient large-std-map)) 237 | #(persistent! (transient frozen-large-wrap-map)) 238 | 1000000) 239 | 240 | true) 241 | 242 | #_(-main) 243 | -------------------------------------------------------------------------------- /dev/ex/examples_high_level_md.clj: -------------------------------------------------------------------------------- 1 | (ns ex.examples-high-level-md 2 | (:require 3 | [com.jolygon.wrap-map :as w :refer [wrap]])) 4 | 5 | ;;;;;;;;;;;;;;;;;;;; 6 | ;; 7 | ;; ## 1. Default Values for Missing Keys 8 | ;; 9 | ;;;;;;;;;;;;;;;;;;;; 10 | 11 | (def default-value-map 12 | (-> {} 13 | (w/assoc :get (fn [m k & [nf]] 14 | (get m k (or nf :not-available)))))) 15 | 16 | (def m1 (assoc default-value-map :a 1)) 17 | 18 | ;; ### Example: 19 | 20 | (get m1 :a) ;=> 1 21 | (m1 :a) ;=> 1 22 | (:a m1) ;=> 1 23 | 24 | (get m1 :b) ;=> :not-available 25 | (m1 :b) ;=> :not-available 26 | (:b m1) ;=> :not-available 27 | 28 | (get m1 :b :soon) ;=> :soon 29 | (m1 :b :soon) ;=> :soon 30 | (:b m1 :soon) ;=> :soon 31 | 32 | ;; ------------------------------------ 33 | 34 | ;;;;;;;;;;;;;;;;;;;; 35 | ;; 36 | ;; ## 2. Case-Insensitive String Keys 37 | ;; 38 | ;;;;;;;;;;;;;;;;;;;; 39 | 40 | (defn- normalize-key [k] 41 | (if (string? k) (.toLowerCase ^String k) k)) 42 | 43 | (def case-insensitive-map 44 | (-> {} 45 | (w/assoc 46 | :assoc (fn [m k v] (assoc m (normalize-key k) v)) 47 | :dissoc (fn [m k] (dissoc m (normalize-key k))) 48 | :contains? (fn [m k] (contains? m (normalize-key k))) 49 | :get (fn [m k & [nf]] (get m (normalize-key k) nf))))) 50 | 51 | (def headers 52 | (-> case-insensitive-map 53 | (assoc "Content-Type" "application/json") 54 | (assoc :other-header 123))) 55 | 56 | ;; ### Example: 57 | 58 | (get headers "content-type") ;=> "application/json" 59 | (get headers "CONTENT-TYPE") ;=> "application/json" 60 | (contains? headers "Content-type") ;=> true 61 | 62 | (get headers :other-header) ;=> 123 (Non-string keys unaffected) 63 | 64 | (dissoc headers "CONTENT-TYPE") ;=> {:other-header 123} 65 | 66 | (def frozen-headers (w/freeze headers)) 67 | 68 | (w/assoc frozen-headers :get #(get %1 (.toUpperCase %2))) 69 | ; Execution error (ExceptionInfo) at com.jolygon.wrap_map.api_0.impl.WrapMap+assoc_k_v|valAt_k/_assoc_impl (impl.clj:797). 70 | ; Cannot set impls on frozen wrap map 71 | 72 | ;; ------------------------------------ 73 | 74 | ;;;;;;;;;;;;;;;;;;;; 75 | ;; 76 | ;; ## 3. Schema Validation on Assoc 77 | ;; 78 | ;;;;;;;;;;;;;;;;;;;; 79 | 80 | (require '[clojure.spec.alpha :as s]) 81 | 82 | (s/def ::name string?) 83 | (s/def ::age pos-int?) 84 | 85 | (def schema-map 86 | (-> {} 87 | (w/assoc 88 | :assoc (fn [m k v] 89 | (let [expected-type (case k :name ::name :age ::age :any)] 90 | (if (or (= expected-type :any) (s/valid? expected-type v)) 91 | (assoc m k v) 92 | (throw (ex-info "Schema validation failed" 93 | {:key k :value v :expected (s/describe expected-type)})))))))) 94 | 95 | ;; ### Example: 96 | 97 | (def user (-> schema-map (assoc :name "Alice") (assoc :age 30))) 98 | ;=> {:name "Alice", :age 30} 99 | 100 | (try 101 | (assoc user :age -5) 102 | (catch Exception e (ex-data e))) 103 | ;=> {:key :age, :value -5, :expected pos-int?} 104 | 105 | (try 106 | (assoc user :name 123) 107 | (catch Exception e (ex-data e))) 108 | ;=> {:key :name, :value 123, :expected string?} 109 | 110 | ;; ------------------------------------ 111 | 112 | ;;;;;;;;;;;;;;;;;;;; 113 | ;; 114 | ;; ## 4. Logging Accesses (Read Logging) 115 | ;; 116 | ;;;;;;;;;;;;;;;;;;;; 117 | 118 | (def access-log (atom [])) 119 | 120 | (def logging-read-map 121 | (-> {} 122 | (w/assoc 123 | :get (fn [m k & [nf]] 124 | (swap! access-log conj (if nf [:get k nf] [:get k])) 125 | (get m k nf))))) 126 | 127 | (def mlog (assoc logging-read-map :a 1)) 128 | 129 | ;; ### Example: 130 | 131 | (reset! access-log []) 132 | (get mlog :a) ;=> 1 133 | (get mlog :b) ;=> nil (Logged as [:get :b]) 134 | (get mlog :c 404) ;=> 404 135 | @access-log 136 | ;=> [[:get :a] [:get :b] [:get :c 404]] 137 | 138 | ;; ------------------------------------ 139 | 140 | ;;;;;;;;;;;;;;;;;;;; 141 | ;; 142 | ;; ## 5. Side Effects on Update 143 | ;; 144 | ;;;;;;;;;;;;;;;;;;;; 145 | 146 | (defn notify-change [change-type k value] 147 | (println "[Notification] Type:" change-type ", Key:" k ", Value:" value)) 148 | 149 | (def notifying-map 150 | (-> {} 151 | (w/assoc 152 | :assoc (fn [m k v] 153 | (notify-change :assoc k v) 154 | (assoc m k v)) 155 | :dissoc (fn [m k] 156 | (notify-change :dissoc k nil) 157 | (dissoc m k))))) 158 | 159 | ;; ### Example: 160 | 161 | (def nmap1 (assoc notifying-map :user "admin")) 162 | ; [Notification] Type: :assoc , Key: :user , Value: admin 163 | (def nmap2 (dissoc nmap1 :user)) 164 | ; [Notification] Type: :dissoc , Key: :user , Value: nil 165 | (def nmap3 (assoc nmap2 :user2 "user")) 166 | ; [Notification] Type: :dissoc , Key: :user2 , Value: nil 167 | 168 | ;; ------------------------------------ 169 | 170 | ;;;;;;;;;;;;;;;;;;;; 171 | ;; 172 | ;; ## 6. Computed / Virtual Properties 173 | ;; 174 | ;;;;;;;;;;;;;;;;;;;; 175 | 176 | (def computed-prop-map 177 | (-> {:first-name "Jane" :last-name "Doe"} 178 | (w/assoc 179 | :get (fn [m k & [nf]] 180 | (if (= k :full-name) 181 | ;; Compute value for :full-name 182 | (str (:first-name m) " " (:last-name m)) 183 | ;; Otherwise, standard lookup 184 | (get m k nf)))))) 185 | 186 | ;; ### Example: 187 | 188 | (get computed-prop-map :first-name) ;=> "Jane" 189 | (get computed-prop-map :full-name) ;=> "Jane Doe" 190 | (get computed-prop-map :age :unknown) ;=> :unknown 191 | (get computed-prop-map :full-name :unknown) ;=> "Jane Doe" 192 | 193 | ;; ------------------------------------ 194 | 195 | ;;;;;;;;;;;;;;;;;;;; 196 | ;; 197 | ;; ## 7. Lazy Loading from External Source 198 | ;; 199 | ;;;;;;;;;;;;;;;;;;;; 200 | 201 | (defn simulate-db-fetch [k] 202 | (println "[DB] Fetching data for key:" k) 203 | (Thread/sleep 50) ; Simulate delay 204 | (if (= k :user-prefs) {:theme "dark" :lang "en"} nil)) 205 | 206 | (def lazy-loading-map 207 | (-> {} 208 | (w/assoc 209 | :get (fn [m k & [nf]] 210 | (let [v (get m k ::nf)] 211 | (if (= v ::nf) 212 | ;; Not found locally, try loading 213 | (if-let [loaded-val (simulate-db-fetch k)] 214 | ;; Found externally: assoc into a new map and return the value 215 | ;; This effectively caches the result. 216 | (do 217 | (println "[Cache] Storing loaded value for key:" k) 218 | loaded-val) ;; Simple version: just return loaded, no cache update 219 | ;; Not found externally either 220 | (or nf ::nf)) 221 | ;; Found locally 222 | v)))))) 223 | 224 | ;; ### Example: 225 | 226 | (def lazy-map (assoc lazy-loading-map :config {:port 80})) 227 | 228 | (get lazy-map :config) ;=> {:port 80} (No fetch) 229 | 230 | (get lazy-map :user-prefs) 231 | ; [DB] Fetching data for key: :user-prefs 232 | ; [Cache] Storing loaded value for key: :user-prefs 233 | ;=> {:theme "dark", :lang "en"} 234 | 235 | (get lazy-map :user-prefs) ; Access again 236 | ; [DB] Fetching data for key: :user-prefs (Fetched again as simple version doesn't cache) 237 | ; [Cache] Storing loaded value for key: :user-prefs 238 | ;=> {:theme "dark", :lang "en"} 239 | 240 | (get lazy-map :other-key :default) 241 | ; [DB] Fetching data for key: :other-key 242 | ;=> :default 243 | 244 | ;; ------------------------------------ 245 | 246 | ;;;;;;;;;;;;;;;;;;;; 247 | ;; 248 | ;; ## 9. Function Call Dispatch 249 | ;; 250 | ;;;;;;;;;;;;;;;;;;;; 251 | 252 | (defn handle-add [x y] (+ x y)) 253 | (defn handle-multiply [x y] (* x y)) 254 | 255 | (def dispatching-map 256 | (-> {} 257 | (assoc :add-fn handle-add :mul-fn handle-multiply) 258 | (w/assoc 259 | :invoke (fn [m operation & args] 260 | (case operation 261 | :add (apply (:add-fn m) args) 262 | :multiply (apply (:mul-fn m) args) 263 | (throw (ex-info "Unknown operation" {:operation operation}))))))) 264 | 265 | ;; ### Example: 266 | 267 | (dispatching-map :add 10 5) ;=> 15 268 | (dispatching-map :multiply 10 5) ;=> 50 269 | 270 | (try (dispatching-map :subtract 10 5) (catch Exception e (ex-data e))) 271 | ;=> {:operation :subtract} 272 | 273 | ;; ------------------------------------ 274 | 275 | ;;;;;;;;;;;;;;;;;;;; 276 | ;; 277 | ;; ## 10. Access Counting 278 | ;; 279 | ;;;;;;;;;;;;;;;;;;;; 280 | 281 | (def access-counts (atom {})) 282 | 283 | (def counting-map 284 | (-> (wrap :a 1 :b 2) 285 | (w/assoc 286 | :get (fn [m k & [nf]] 287 | (swap! access-counts update k (fnil inc 0)) 288 | (get m k nf))))) 289 | 290 | ;; ### Example: 291 | 292 | (reset! access-counts {}) 293 | (get counting-map :a) ;=> 1 294 | (get counting-map :b) ;=> 2 295 | (get counting-map :a) ;=> 1 296 | (get counting-map :c) ;=> nil 297 | @access-counts 298 | ;=> {:a 2, :b 1, :c 1} 299 | 300 | ;; ------------------------------------ 301 | 302 | ;;;;;;;;;;;;;;;;;;;; 303 | ;; 304 | ;; ## 12. Custom String Representation 305 | ;; 306 | ;;;;;;;;;;;;;;;;;;;; 307 | 308 | (def sanitizing-string-map 309 | (-> (wrap :user "secret-user" :id 123 :data [1 2 3]) 310 | (w/assoc :print #(str "")))) 311 | 312 | ;; ### Example: 313 | 314 | (str sanitizing-string-map) 315 | ;=> "" 316 | 317 | (println sanitizing-string-map) 318 | ; 319 | 320 | ;; ------------------------------------ 321 | -------------------------------------------------------------------------------- /dev/ex/examples_high_level_md.cljc: -------------------------------------------------------------------------------- 1 | (ns ex.examples-high-level-md 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [com.jolygon.wrap-map :as w])) 5 | 6 | ;;;;;;;;;;;;;;;;;;;; 7 | ;; 8 | ;; ## 1. Default Values for Missing Keys 9 | ;; 10 | ;;;;;;;;;;;;;;;;;;;; 11 | 12 | (def default-value-map 13 | (-> {} 14 | (w/assoc :get (fn [m k & [nf]] 15 | (get m k (or nf :not-available)))))) 16 | 17 | (def m1 (assoc default-value-map :a 1)) 18 | 19 | ;; ### Example: 20 | 21 | (get m1 :a) ;=> 1 22 | (m1 :a) ;=> 1 23 | (:a m1) ;=> 1 24 | 25 | (get m1 :b) ;=> :not-available 26 | (m1 :b) ;=> :not-available 27 | (:b m1) ;=> :not-available 28 | 29 | (get m1 :b :soon) ;=> :soon 30 | (m1 :b :soon) ;=> :soon 31 | (:b m1 :soon) ;=> :soon 32 | 33 | ;; ------------------------------------ 34 | 35 | ;;;;;;;;;;;;;;;;;;;; 36 | ;; 37 | ;; ## 2. Case-Insensitive String Keys 38 | ;; 39 | ;;;;;;;;;;;;;;;;;;;; 40 | 41 | (defn- normalize-key [k] 42 | (if (string? k) (.toLowerCase ^String k) k)) 43 | 44 | (def case-insensitive-map 45 | (-> {} 46 | (w/assoc 47 | :assoc (fn [m k v] (assoc m (normalize-key k) v)) 48 | :dissoc (fn [m k] (dissoc m (normalize-key k))) 49 | :contains? (fn [m k] (contains? m (normalize-key k))) 50 | :get (fn [m k & [nf]] (get m (normalize-key k) nf))))) 51 | 52 | (def headers 53 | (-> case-insensitive-map 54 | (assoc "Content-Type" "application/json") 55 | (assoc :other-header 123))) 56 | 57 | ;; ### Example: 58 | 59 | (get headers "content-type") ;=> "application/json" 60 | (get headers "CONTENT-TYPE") ;=> "application/json" 61 | (contains? headers "Content-type") ;=> true 62 | 63 | (get headers :other-header) ;=> 123 (Non-string keys unaffected) 64 | 65 | (dissoc headers "CONTENT-TYPE") ;=> {:other-header 123} 66 | 67 | ;; ------------------------------------ 68 | 69 | ;;;;;;;;;;;;;;;;;;;; 70 | ;; 71 | ;; ## 3. Schema Validation on Assoc 72 | ;; 73 | ;;;;;;;;;;;;;;;;;;;; 74 | 75 | (require '[clojure.spec.alpha :as s]) 76 | 77 | (s/def ::name string?) 78 | (s/def ::age pos-int?) 79 | #_(s/def ::user (s/keys :req-un [::name ::age])) 80 | 81 | (def schema-map 82 | (-> {} 83 | (w/assoc 84 | :assoc (fn [m k v] 85 | (let [expected-type (case k :name ::name :age ::age :any)] 86 | (if (or (= expected-type :any) (s/valid? expected-type v)) 87 | (assoc m k v) 88 | (throw (ex-info "Schema validation failed" 89 | {:key k :value v :expected (s/describe expected-type)})))))))) 90 | 91 | ;; ### Example: 92 | 93 | (def user (-> schema-map (assoc :name "Alice") (assoc :age 30))) 94 | ;=> {:name "Alice", :age 30} 95 | 96 | (try 97 | (assoc user :age -5) 98 | (catch #?(:cljs :default :clj Exception) e (ex-data e))) 99 | ;=> {:key :age, :value -5, :expected pos-int?} 100 | 101 | (try 102 | (assoc user :name 123) 103 | (catch #?(:cljs :default :clj Exception) e (ex-data e))) 104 | ;=> {:key :name, :value 123, :expected string?} 105 | 106 | ;; ------------------------------------ 107 | 108 | ;;;;;;;;;;;;;;;;;;;; 109 | ;; 110 | ;; ## 4. Logging Accesses (Read Logging) 111 | ;; 112 | ;;;;;;;;;;;;;;;;;;;; 113 | 114 | (def access-log (atom [])) 115 | 116 | (def logging-read-map 117 | (-> {} 118 | (w/assoc :get (fn [m k & [nf]] 119 | (swap! access-log conj (if nf [:get k nf] [:get k])) 120 | (get m k nf))))) 121 | 122 | (def mlog (assoc logging-read-map :a 1)) 123 | 124 | ;; ### Example: 125 | 126 | (reset! access-log []) 127 | (get mlog :a) ;=> 1 128 | (get mlog :b) ;=> nil (Logged as [:get :b]) 129 | (get mlog :c 404) ;=> 404 130 | @access-log 131 | ;=> [[:get :a] [:get :b] [:get :c 404]] 132 | 133 | ;; ------------------------------------ 134 | 135 | ;;;;;;;;;;;;;;;;;;;; 136 | ;; 137 | ;; ## 5. Side Effects on Update 138 | ;; 139 | ;;;;;;;;;;;;;;;;;;;; 140 | 141 | (defn notify-change [change-type k value] 142 | (println "[Notification] Type:" change-type ", Key:" k ", Value:" value)) 143 | 144 | (def notifying-map 145 | (-> {} 146 | (w/assoc 147 | :assoc (fn [m k v] 148 | (notify-change :assoc k v) 149 | (assoc m k v)) 150 | :dissoc (fn [m k] 151 | (notify-change :dissoc k nil) 152 | (dissoc m k))))) 153 | 154 | ;; ### Example: 155 | 156 | (def nmap1 (assoc notifying-map :user "admin")) 157 | ; [Notification] Type: :assoc , Key: :user , Value: admin 158 | (def nmap2 (dissoc nmap1 :user)) 159 | ; [Notification] Type: :dissoc , Key: :user , Value: nil 160 | (def nmap3 (assoc nmap2 :user2 "user")) 161 | ; [Notification] Type: :dissoc , Key: :user2 , Value: nil 162 | 163 | ;; ------------------------------------ 164 | 165 | ;;;;;;;;;;;;;;;;;;;; 166 | ;; 167 | ;; ## 6. Computed / Virtual Properties 168 | ;; 169 | ;;;;;;;;;;;;;;;;;;;; 170 | 171 | (def computed-prop-map 172 | (-> {:first-name "Jane" :last-name "Doe"} 173 | (w/assoc :get (fn [m k & [nf]] 174 | (if (= k :full-name) 175 | ;; Compute value for :full-name 176 | (str (:first-name m) " " (:last-name m)) 177 | ;; Otherwise, standard lookup 178 | (get m k nf)))))) 179 | 180 | ;; ### Example: 181 | 182 | (get computed-prop-map :first-name) ;=> "Jane" 183 | (get computed-prop-map :full-name) ;=> "Jane Doe" 184 | (get computed-prop-map :age :unknown) ;=> :unknown 185 | (get computed-prop-map :full-name :unknown) ;=> "Jane Doe" 186 | 187 | ;; ------------------------------------ 188 | 189 | ;;;;;;;;;;;;;;;;;;;; 190 | ;; 191 | ;; ## 7. Lazy Loading from External Source 192 | ;; 193 | ;;;;;;;;;;;;;;;;;;;; 194 | 195 | (defn simulate-db-fetch [k] 196 | (println "[DB] Fetching data for key:" k) 197 | ;; (Thread/sleep 50) ; Simulate delay ;; not in CLJS 198 | (if (= k :user-prefs) {:theme "dark" :lang "en"} nil)) 199 | 200 | (def lazy-loading-map 201 | (-> {} 202 | (w/assoc :get (fn [m k & [nf]] 203 | (let [v (get m k ::nf)] 204 | (if (= v ::nf) 205 | ;; Not found locally, try loading 206 | (if-let [loaded-val (simulate-db-fetch k)] 207 | ;; Found externally: assoc into a new map and return the value 208 | ;; This effectively caches the result. 209 | (do 210 | (println "[Cache] Storing loaded value for key:" k) 211 | loaded-val) ;; Simple version: just return loaded, no cache update 212 | ;; Not found externally either 213 | (or nf ::nf)) 214 | ;; Found locally 215 | v)))))) 216 | 217 | ;; ### Example: 218 | 219 | (def lazy-map (assoc lazy-loading-map :config {:port 80})) 220 | 221 | (get lazy-map :config) ;=> {:port 80} (No fetch) 222 | 223 | (get lazy-map :user-prefs) 224 | ; [DB] Fetching data for key: :user-prefs 225 | ; [Cache] Storing loaded value for key: :user-prefs 226 | ;=> {:theme "dark", :lang "en"} 227 | 228 | (get lazy-map :user-prefs) ; Access again 229 | ; [DB] Fetching data for key: :user-prefs (Fetched again as simple version doesn't cache) 230 | ; [Cache] Storing loaded value for key: :user-prefs 231 | ;=> {:theme "dark", :lang "en"} 232 | 233 | (get lazy-map :other-key :default) 234 | ; [DB] Fetching data for key: :other-key 235 | ;=> :default 236 | 237 | ;; ------------------------------------ 238 | 239 | ;;;;;;;;;;;;;;;;;;;; 240 | ;; 241 | ;; ## 9. Function Call Dispatch 242 | ;; 243 | ;;;;;;;;;;;;;;;;;;;; 244 | 245 | (defn handle-add [x y] (+ x y)) 246 | (defn handle-multiply [x y] (* x y)) 247 | 248 | (def dispatching-map 249 | (-> {:add-fn handle-add :mul-fn handle-multiply} 250 | (w/assoc :invoke (fn [m operation & args] 251 | (case operation 252 | :add (apply (:add-fn m) args) 253 | :multiply (apply (:mul-fn m) args) 254 | (throw (ex-info "Unknown operation" {:operation operation}))))))) 255 | 256 | ;; ### Example: 257 | 258 | (dispatching-map :add 10 5) ;=> 15 259 | (dispatching-map :multiply 10 5) ;=> 50 260 | 261 | (try (dispatching-map :subtract 10 5) (catch #?(:cljs :default :clj Exception) e (ex-data e))) 262 | ;=> {:operation :subtract} 263 | 264 | ;; ------------------------------------ 265 | 266 | ;;;;;;;;;;;;;;;;;;;; 267 | ;; 268 | ;; ## 10. Access Counting 269 | ;; 270 | ;;;;;;;;;;;;;;;;;;;; 271 | 272 | (def access-counts (atom {})) 273 | 274 | (def counting-map 275 | (-> {:a 1 :b 2} 276 | (w/assoc :get (fn [m k & [nf]] 277 | (swap! access-counts update k (fnil inc 0)) 278 | (get m k nf))))) 279 | 280 | ;; ### Example: 281 | 282 | (reset! access-counts {}) 283 | (get counting-map :a) ;=> 1 284 | (get counting-map :b) ;=> 2 285 | (get counting-map :a) ;=> 1 286 | (get counting-map :c) ;=> nil 287 | @access-counts 288 | ;=> {:a 2, :b 1, :c 1} 289 | 290 | ;; ------------------------------------ 291 | 292 | ;;;;;;;;;;;;;;;;;;;; 293 | ;; 294 | ;; ## 12. Custom String Representation 295 | ;; 296 | ;;;;;;;;;;;;;;;;;;;; 297 | 298 | (def sanitizing-string-map 299 | (-> {:user "secret-user" :id 123 :data [1 2 3]} 300 | (w/assoc :print #(str "")))) 301 | 302 | ;; ### Example: 303 | 304 | (str sanitizing-string-map) 305 | ;=> "" 306 | 307 | (println sanitizing-string-map) 308 | ; 309 | 310 | ;; ------------------------------------ 311 | -------------------------------------------------------------------------------- /dev/ex/examples_high_level_md.cljs: -------------------------------------------------------------------------------- 1 | (ns ex.examples-high-level-md 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [com.jolygon.wrap-map :as w])) 5 | 6 | ;;;;;;;;;;;;;;;;;;;; 7 | ;; 8 | ;; ## 1. Default Values for Missing Keys 9 | ;; 10 | ;;;;;;;;;;;;;;;;;;;; 11 | 12 | (def default-value-map 13 | (-> {} 14 | (w/assoc :get (fn [m k & [nf]] 15 | (get m k (or nf :not-available)))))) 16 | 17 | (def m1 (assoc default-value-map :a 1)) 18 | 19 | ;; ### Example: 20 | 21 | (get m1 :a) ;=> 1 22 | (m1 :a) ;=> 1 23 | (:a m1) ;=> 1 24 | 25 | (get m1 :b) ;=> :not-available 26 | (m1 :b) ;=> :not-available 27 | (:b m1) ;=> :not-available 28 | 29 | (get m1 :b :soon) ;=> :soon 30 | (m1 :b :soon) ;=> :soon 31 | (:b m1 :soon) ;=> :soon 32 | 33 | ;; ------------------------------------ 34 | 35 | ;;;;;;;;;;;;;;;;;;;; 36 | ;; 37 | ;; ## 2. Case-Insensitive String Keys 38 | ;; 39 | ;;;;;;;;;;;;;;;;;;;; 40 | 41 | (defn- normalize-key [k] 42 | (if (string? k) (.toLowerCase ^String k) k)) 43 | 44 | (def case-insensitive-map 45 | (-> {} 46 | (w/assoc 47 | :assoc (fn [m k v] (assoc m (normalize-key k) v)) 48 | :dissoc (fn [m k] (dissoc m (normalize-key k))) 49 | :contains? (fn [m k] (contains? m (normalize-key k))) 50 | :get (fn [m k & [nf]] (get m (normalize-key k) nf))))) 51 | 52 | (def headers 53 | (-> case-insensitive-map 54 | (assoc "Content-Type" "application/json") 55 | (assoc :other-header 123))) 56 | 57 | ;; ### Example: 58 | 59 | (get headers "content-type") ;=> "application/json" 60 | (get headers "CONTENT-TYPE") ;=> "application/json" 61 | (contains? headers "Content-type") ;=> true 62 | 63 | (get headers :other-header) ;=> 123 (Non-string keys unaffected) 64 | 65 | (dissoc headers "CONTENT-TYPE") ;=> {:other-header 123} 66 | 67 | ;; ------------------------------------ 68 | 69 | ;;;;;;;;;;;;;;;;;;;; 70 | ;; 71 | ;; ## 3. Schema Validation on Assoc 72 | ;; 73 | ;;;;;;;;;;;;;;;;;;;; 74 | 75 | (require '[clojure.spec.alpha :as s]) 76 | 77 | (s/def ::name string?) 78 | (s/def ::age pos-int?) 79 | #_(s/def ::user (s/keys :req-un [::name ::age])) 80 | 81 | (def schema-map 82 | (-> {} 83 | (w/assoc 84 | :assoc (fn [m k v] 85 | (let [expected-type (case k :name ::name :age ::age :any)] 86 | (if (or (= expected-type :any) (s/valid? expected-type v)) 87 | (assoc m k v) 88 | (throw (ex-info "Schema validation failed" 89 | {:key k :value v :expected (s/describe expected-type)})))))))) 90 | 91 | ;; ### Example: 92 | 93 | (def user (-> schema-map (assoc :name "Alice") (assoc :age 30))) 94 | ;=> {:name "Alice", :age 30} 95 | 96 | (try 97 | (assoc user :age -5) 98 | (catch :default e (ex-data e))) 99 | ;=> {:key :age, :value -5, :expected pos-int?} 100 | 101 | (try 102 | (assoc user :name 123) 103 | (catch :default e (ex-data e))) 104 | ;=> {:key :name, :value 123, :expected string?} 105 | 106 | ;; ------------------------------------ 107 | 108 | ;;;;;;;;;;;;;;;;;;;; 109 | ;; 110 | ;; ## 4. Logging Accesses (Read Logging) 111 | ;; 112 | ;;;;;;;;;;;;;;;;;;;; 113 | 114 | (def access-log (atom [])) 115 | 116 | (def logging-read-map 117 | (-> {} 118 | (w/assoc :get (fn [m k & [nf]] 119 | (swap! access-log conj (if nf [:get k nf] [:get k])) 120 | (get m k nf))))) 121 | 122 | (def mlog (assoc logging-read-map :a 1)) 123 | 124 | ;; ### Example: 125 | 126 | (reset! access-log []) 127 | (get mlog :a) ;=> 1 128 | (get mlog :b) ;=> nil (Logged as [:get :b]) 129 | (get mlog :c 404) ;=> 404 130 | @access-log 131 | ;=> [[:get :a] [:get :b] [:get :c 404]] 132 | 133 | ;; ------------------------------------ 134 | 135 | ;;;;;;;;;;;;;;;;;;;; 136 | ;; 137 | ;; ## 5. Side Effects on Update 138 | ;; 139 | ;;;;;;;;;;;;;;;;;;;; 140 | 141 | (defn notify-change [change-type k value] 142 | (println "[Notification] Type:" change-type ", Key:" k ", Value:" value)) 143 | 144 | (def notifying-map 145 | (-> {} 146 | (w/assoc 147 | :assoc (fn [m k v] 148 | (notify-change :assoc k v) 149 | (assoc m k v)) 150 | :dissoc (fn [m k] 151 | (notify-change :dissoc k nil) 152 | (dissoc m k))))) 153 | 154 | ;; ### Example: 155 | 156 | (def nmap1 (assoc notifying-map :user "admin")) 157 | ; [Notification] Type: :assoc , Key: :user , Value: admin 158 | (def nmap2 (dissoc nmap1 :user)) 159 | ; [Notification] Type: :dissoc , Key: :user , Value: nil 160 | (def nmap3 (assoc nmap2 :user2 "user")) 161 | ; [Notification] Type: :dissoc , Key: :user2 , Value: nil 162 | 163 | ;; ------------------------------------ 164 | 165 | ;;;;;;;;;;;;;;;;;;;; 166 | ;; 167 | ;; ## 6. Computed / Virtual Properties 168 | ;; 169 | ;;;;;;;;;;;;;;;;;;;; 170 | 171 | (def computed-prop-map 172 | (-> {:first-name "Jane" :last-name "Doe"} 173 | (w/assoc :get (fn [m k & [nf]] 174 | (if (= k :full-name) 175 | ;; Compute value for :full-name 176 | (str (:first-name m) " " (:last-name m)) 177 | ;; Otherwise, standard lookup 178 | (get m k nf)))))) 179 | 180 | ;; ### Example: 181 | 182 | (get computed-prop-map :first-name) ;=> "Jane" 183 | (get computed-prop-map :full-name) ;=> "Jane Doe" 184 | (get computed-prop-map :age :unknown) ;=> :unknown 185 | (get computed-prop-map :full-name :unknown) ;=> "Jane Doe" 186 | 187 | ;; ------------------------------------ 188 | 189 | ;;;;;;;;;;;;;;;;;;;; 190 | ;; 191 | ;; ## 7. Lazy Loading from External Source 192 | ;; 193 | ;;;;;;;;;;;;;;;;;;;; 194 | 195 | (defn simulate-db-fetch [k] 196 | (println "[DB] Fetching data for key:" k) 197 | ;; (Thread/sleep 50) ; Simulate delay ;; not in CLJS 198 | (if (= k :user-prefs) {:theme "dark" :lang "en"} nil)) 199 | 200 | (def lazy-loading-map 201 | (-> {} 202 | (w/assoc :get (fn [m k & [nf]] 203 | (let [v (get m k ::nf)] 204 | (if (= v ::nf) 205 | ;; Not found locally, try loading 206 | (if-let [loaded-val (simulate-db-fetch k)] 207 | ;; Found externally: assoc into a new map and return the value 208 | ;; This effectively caches the result. 209 | (do 210 | (println "[Cache] Storing loaded value for key:" k) 211 | loaded-val) ;; Simple version: just return loaded, no cache update 212 | ;; Not found externally either 213 | (or nf ::nf)) 214 | ;; Found locally 215 | v)))))) 216 | 217 | ;; ### Example: 218 | 219 | (def lazy-map (assoc lazy-loading-map :config {:port 80})) 220 | 221 | (get lazy-map :config) ;=> {:port 80} (No fetch) 222 | 223 | (get lazy-map :user-prefs) 224 | ; [DB] Fetching data for key: :user-prefs 225 | ; [Cache] Storing loaded value for key: :user-prefs 226 | ;=> {:theme "dark", :lang "en"} 227 | 228 | (get lazy-map :user-prefs) ; Access again 229 | ; [DB] Fetching data for key: :user-prefs (Fetched again as simple version doesn't cache) 230 | ; [Cache] Storing loaded value for key: :user-prefs 231 | ;=> {:theme "dark", :lang "en"} 232 | 233 | (get lazy-map :other-key :default) 234 | ; [DB] Fetching data for key: :other-key 235 | ;=> :default 236 | 237 | ;; ------------------------------------ 238 | 239 | ;;;;;;;;;;;;;;;;;;;; 240 | ;; 241 | ;; ## 9. Function Call Dispatch 242 | ;; 243 | ;;;;;;;;;;;;;;;;;;;; 244 | 245 | (defn handle-add [x y] (+ x y)) 246 | (defn handle-multiply [x y] (* x y)) 247 | 248 | (def dispatching-map 249 | (-> {:add-fn handle-add :mul-fn handle-multiply} 250 | (w/assoc :invoke (fn [m operation & args] 251 | (case operation 252 | :add (apply (:add-fn m) args) 253 | :multiply (apply (:mul-fn m) args) 254 | (throw (ex-info "Unknown operation" {:operation operation}))))))) 255 | 256 | ;; ### Example: 257 | 258 | (dispatching-map :add 10 5) ;=> 15 259 | (dispatching-map :multiply 10 5) ;=> 50 260 | 261 | (try (dispatching-map :subtract 10 5) (catch :default e (ex-data e))) 262 | ;=> {:operation :subtract} 263 | 264 | ;; ------------------------------------ 265 | 266 | ;;;;;;;;;;;;;;;;;;;; 267 | ;; 268 | ;; ## 10. Access Counting 269 | ;; 270 | ;;;;;;;;;;;;;;;;;;;; 271 | 272 | (def access-counts (atom {})) 273 | 274 | (def counting-map 275 | (-> {:a 1 :b 2} 276 | (w/assoc :get (fn [m k & [nf]] 277 | (swap! access-counts update k (fnil inc 0)) 278 | (get m k nf))))) 279 | 280 | ;; ### Example: 281 | 282 | (reset! access-counts {}) 283 | (get counting-map :a) ;=> 1 284 | (get counting-map :b) ;=> 2 285 | (get counting-map :a) ;=> 1 286 | (get counting-map :c) ;=> nil 287 | @access-counts 288 | ;=> {:a 2, :b 1, :c 1} 289 | 290 | ;; ------------------------------------ 291 | 292 | ;;;;;;;;;;;;;;;;;;;; 293 | ;; 294 | ;; ## 12. Custom String Representation 295 | ;; 296 | ;;;;;;;;;;;;;;;;;;;; 297 | 298 | (def sanitizing-string-map 299 | (-> {:user "secret-user" :id 123 :data [1 2 3]} 300 | (w/assoc :print #(str "")))) 301 | 302 | ;; ### Example: 303 | 304 | (str sanitizing-string-map) 305 | ;=> "" 306 | 307 | (println sanitizing-string-map) 308 | ; 309 | 310 | ;; ------------------------------------ 311 | -------------------------------------------------------------------------------- /dev/ex/examples_low_level_md.clj: -------------------------------------------------------------------------------- 1 | (ns ex.examples-low-level-md 2 | (:require 3 | [com.jolygon.wrap-map :as w 4 | :refer [wrap empty-wrap vary]])) 5 | 6 | ;;;;;;;;;;;;;;;;;;;; 7 | ;; 8 | ;; ## 1. Default Values for Missing Keys 9 | ;; 10 | ;;;;;;;;;;;;;;;;;;;; 11 | 12 | (def default-value-map 13 | (-> empty-wrap 14 | (vary assoc 15 | :valAt_k (fn [_ m k] (get m k :not-available)) 16 | :valAt_k_nf (fn [_ m k & [not-available]] (get m k (or not-available :not-available))) 17 | :invoke-variadic (fn [_ m k & [not-available]] 18 | (get m k (or not-available :not-available)))))) 19 | 20 | (def m1 (assoc default-value-map :a 1)) 21 | 22 | ;; ### Example: 23 | 24 | (get m1 :a) ;=> 1 25 | (m1 :a) ;=> 1 (Arity-1 invoke defaults to get override) 26 | (:a m1) ;=> 1 27 | 28 | (get m1 :b) ;=> :not-available 29 | (m1 :b) ;=> :not-available 30 | (:b m1) ;=> :not-available 31 | 32 | (get m1 :b :soon) ;=> :soon 33 | (m1 :b :soon) ;=> :soon 34 | (:b m1 :soon) ;=> :soon 35 | 36 | ;; ------------------------------------ 37 | 38 | ;;;;;;;;;;;;;;;;;;;; 39 | ;; 40 | ;; ## 2. Case-Insensitive String Keys 41 | ;; 42 | ;;;;;;;;;;;;;;;;;;;; 43 | 44 | (defn- normalize-key [k] 45 | (if (string? k) (.toLowerCase ^String k) k)) 46 | 47 | (def case-insensitive-map 48 | (-> {} 49 | (vary merge 50 | {:valAt_k (fn [_ m k] (get m (normalize-key k))) 51 | :valAt_k_nf (fn [_ m k nf] (get m (normalize-key k) nf)) 52 | :containsKey_k (fn [_ m k] (contains? m (normalize-key k))) 53 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 54 | (<- e (assoc m (normalize-key k) v))) 55 | :without_k (fn [{:as e :keys [<-]} m k] 56 | (<- e (dissoc m (normalize-key k))))}))) 57 | 58 | (def headers 59 | (-> case-insensitive-map 60 | (assoc "Content-Type" "application/json") 61 | (assoc :other-header 123))) 62 | 63 | ;; ### Example: 64 | 65 | (get headers "content-type") ;=> "application/json" 66 | (get headers "CONTENT-TYPE") ;=> "application/json" 67 | (contains? headers "Content-type") ;=> true 68 | 69 | (get headers :other-header) ;=> 123 (Non-string keys unaffected) 70 | 71 | (dissoc headers "CONTENT-TYPE") ;=> {:other-header 123} 72 | 73 | ;; ------------------------------------ 74 | 75 | ;;;;;;;;;;;;;;;;;;;; 76 | ;; 77 | ;; ## 3. Schema Validation on Assoc 78 | ;; 79 | ;;;;;;;;;;;;;;;;;;;; 80 | 81 | (require '[clojure.spec.alpha :as s]) 82 | 83 | (s/def ::name string?) 84 | (s/def ::age pos-int?) 85 | 86 | (def schema-map 87 | (-> empty-wrap 88 | (vary assoc 89 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 90 | (let [expected-type (case k :name ::name :age ::age :any)] 91 | (if (or (= expected-type :any) (s/valid? expected-type v)) 92 | (<- e (assoc m k v)) 93 | (throw (ex-info "Schema validation failed" 94 | {:key k :value v :expected (s/describe expected-type)})))))))) 95 | 96 | ;; ### Example: 97 | 98 | (def user (-> schema-map (assoc :name "Alice") (assoc :age 30))) 99 | ;=> {:name "Alice", :age 30} 100 | 101 | (try 102 | (assoc user :age -5) 103 | (catch Exception e (ex-data e))) 104 | ;=> {:key :age, :value -5, :expected pos-int?} 105 | 106 | (try 107 | (assoc user :name 123) 108 | (catch Exception e (ex-data e))) 109 | ;=> {:key :name, :value 123, :expected string?} 110 | 111 | ;; ------------------------------------ 112 | 113 | ;;;;;;;;;;;;;;;;;;;; 114 | ;; 115 | ;; ## 4. Logging Accesses (Read Logging) 116 | ;; 117 | ;;;;;;;;;;;;;;;;;;;; 118 | 119 | (def access-log (atom [])) 120 | 121 | (def logging-read-map 122 | (-> {} 123 | (vary assoc 124 | :valAt_k (fn [_ m k] 125 | (swap! access-log conj [:get k]) 126 | (get m k)) 127 | :valAt_k_nf (fn [_ m k nf] 128 | (swap! access-log conj [:get k nf]) 129 | (get m k nf))))) 130 | 131 | (def mlog (assoc logging-read-map :a 1)) 132 | 133 | ;; ### Example: 134 | 135 | (reset! access-log []) 136 | (get mlog :a) ;=> 1 137 | (get mlog :b) ;=> nil (Logged as [:get :b]) 138 | (get mlog :c 404) ;=> 404 139 | @access-log ;=> [[:get :a] [:get :b] [:get :c 404]] 140 | 141 | ;; ------------------------------------ 142 | 143 | ;;;;;;;;;;;;;;;;;;;; 144 | ;; 145 | ;; ## 5. Side Effects on Update 146 | ;; 147 | ;;;;;;;;;;;;;;;;;;;; 148 | 149 | (defn notify-change [change-type k value] 150 | (println "[Notification] Type:" change-type ", Key:" k ", Value:" value)) 151 | 152 | (def notifying-map 153 | (-> {} 154 | (vary assoc 155 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 156 | (notify-change :assoc k v) 157 | (<- e (assoc m k v))) 158 | :without_k (fn [{:as e :keys [<-]} m k] 159 | (notify-change :dissoc k nil) 160 | (<- e (dissoc m k)))))) 161 | 162 | ;; ### Example: 163 | 164 | (def nmap1 (assoc notifying-map :user "admin")) 165 | ; [Notification] Type: :assoc , Key: :user , Value: admin 166 | (def nmap2 (dissoc nmap1 :user)) 167 | ; [Notification] Type: :dissoc , Key: :user , Value: nil 168 | 169 | ;; ------------------------------------ 170 | 171 | ;;;;;;;;;;;;;;;;;;;; 172 | ;; 173 | ;; ## 6. Computed / Virtual Properties 174 | ;; 175 | ;;;;;;;;;;;;;;;;;;;; 176 | 177 | (def computed-prop-map 178 | (-> (wrap :first-name "Jane" :last-name "Doe") 179 | (vary assoc 180 | :valAt_k (fn [_ m k] 181 | (if (= k :full-name) 182 | (str (:first-name m) " " (:last-name m)) 183 | (get m k))) 184 | :valAt_k_nf (fn [{:as e :keys [valAt_k]} m k nf] 185 | (if (= k :full-name) 186 | (valAt_k e m k) ;; <- Delegate to valAt_k 187 | (get m k nf)))))) 188 | 189 | ;; ### Example: 190 | 191 | (get computed-prop-map :first-name) ;=> "Jane" 192 | (get computed-prop-map :full-name) ;=> "Jane Doe" 193 | (get computed-prop-map :age :unknown) ;=> :unknown 194 | (get computed-prop-map :full-name :unknown) ;=> "Jane Doe" 195 | 196 | ;; ------------------------------------ 197 | 198 | ;;;;;;;;;;;;;;;;;;;; 199 | ;; 200 | ;; ## 7. Lazy Loading from External Source 201 | ;; 202 | ;;;;;;;;;;;;;;;;;;;; 203 | 204 | (defn simulate-db-fetch [k] 205 | (println "[DB] Fetching data for key:" k) 206 | (Thread/sleep 50) 207 | (if (= k :user-prefs) {:theme "dark" :lang "en"} nil)) 208 | 209 | (def lazy-loading-map 210 | (-> {} 211 | (vary assoc 212 | :valAt_k_nf (fn [_ m k nf] 213 | (let [v (get m k ::nf)] 214 | (if (= v ::nf) 215 | (if-let [loaded-val (simulate-db-fetch k)] 216 | (do 217 | (println "[Cache] Storing loaded value for key:" k) 218 | loaded-val) ;; Simple version: just return loaded, no cache update 219 | nf) 220 | v))) 221 | :valAt_k (fn [{:as e :keys [valAt_k_nf]} m k] 222 | (valAt_k_nf e m k ::nf))))) ; Delegate to above 223 | 224 | ;; ### Example: 225 | 226 | (def lazy-map (assoc lazy-loading-map :config {:port 80})) 227 | 228 | (get lazy-map :config) ;=> {:port 80} (No fetch) 229 | 230 | (get lazy-map :user-prefs) 231 | ; [DB] Fetching data for key: :user-prefs 232 | ; [Cache] Storing loaded value for key: :user-prefs 233 | ;=> {:theme "dark", :lang "en"} 234 | 235 | (get lazy-map :user-prefs) ; Access again 236 | ; [DB] Fetching data for key: :user-prefs (Fetched again as simple version doesn't cache) 237 | ; [Cache] Storing loaded value for key: :user-prefs 238 | ;=> {:theme "dark", :lang "en"} 239 | 240 | (get lazy-map :other-key :default) 241 | ; [DB] Fetching data for key: :other-key 242 | ;=> :default 243 | 244 | ;; ------------------------------------ 245 | 246 | ;;;;;;;;;;;;;;;;;;;; 247 | ;; 248 | ;; ## 8. Read-Only Map View 249 | ;; 250 | ;;;;;;;;;;;;;;;;;;;; 251 | 252 | (defn read-only-error [& _] 253 | (throw (UnsupportedOperationException. "Wrap map is read-only"))) 254 | 255 | (def read-only-map-impls 256 | {:assoc_k_v read-only-error 257 | :without_k read-only-error 258 | :assocEx_k_v read-only-error 259 | ;; Override transient mutations too if you want `(transient read-only-map)` to fail 260 | :T_assoc_k_v read-only-error 261 | :T_without_k read-only-error 262 | :T_conj_v read-only-error}) 263 | 264 | (def read-only-m 265 | (-> (wrap :a 1) 266 | (vary merge read-only-map-impls))) 267 | ;; Or, to add to existing impls: 268 | ;; (def read-only-m 269 | ;; (->> read-only-map-impls 270 | ;; (apply w/assoc (wrap :a 1)))) 271 | ;; Or, using vary: 272 | ;; (def read-only-m 273 | ;; (->> read-only-map-impls 274 | ;; (vary merge (wrap :a 1)))) 275 | 276 | ;; ### Example: 277 | 278 | (get read-only-m :a) ;=> 1 279 | (count read-only-m) ;=> 1 280 | 281 | (try (assoc read-only-m :b 2) (catch Exception e (.getMessage e))) 282 | ;=> "Map is read-only" 283 | 284 | (try (dissoc read-only-m :a) (catch Exception e (.getMessage e))) 285 | ;=> "Map is read-only" 286 | 287 | ;; Transient operations also fail if overridden 288 | (try (persistent! (assoc! (transient read-only-m) :c 3)) (catch Exception e (.getMessage e))) 289 | ;=> "Map is read-only" 290 | 291 | ;; ------------------------------------ 292 | 293 | ;;;;;;;;;;;;;;;;;;;; 294 | ;; 295 | ;; ## 9. Function Call Dispatch 296 | ;; 297 | ;;;;;;;;;;;;;;;;;;;; 298 | 299 | (defn handle-add [x y] (+ x y)) 300 | (defn handle-multiply [x y] (* x y)) 301 | 302 | (def dispatching-map 303 | (-> {} 304 | (assoc :add-fn handle-add :mul-fn handle-multiply) 305 | (w/assoc 306 | :invoke-variadic (fn [_ m operation & args] 307 | (case operation 308 | :add (apply (:add-fn m) args) 309 | :multiply (apply (:mul-fn m) args) 310 | (throw (ex-info "Unknown operation" {:operation operation}))))))) 311 | 312 | ;; ### Example: 313 | 314 | (dispatching-map :add 10 5) ;=> 15 315 | (dispatching-map :multiply 10 5) ;=> 50 316 | 317 | (try (dispatching-map :subtract 10 5) (catch Exception e (ex-data e))) 318 | ;=> {:operation :subtract} 319 | 320 | ;; ------------------------------------ 321 | 322 | ;;;;;;;;;;;;;;;;;;;; 323 | ;; 324 | ;; ## 10. Access Counting 325 | ;; 326 | ;;;;;;;;;;;;;;;;;;;; 327 | 328 | (def access-counts (atom {})) 329 | 330 | (def counting-map 331 | (-> (wrap :a 1 :b 2) 332 | (w/assoc 333 | :valAt_k (fn [_ m k] 334 | (swap! access-counts update k (fnil inc 0)) ; Increment count 335 | (get m k)) 336 | :valAt_k_nf (fn [_ m k nf] 337 | (swap! access-counts update k (fnil inc 0)) ; Increment count 338 | (get m k nf))))) 339 | 340 | ;; ### Example: 341 | 342 | (reset! access-counts {}) 343 | (get counting-map :a) ;=> 1 344 | (get counting-map :b) ;=> 2 345 | (get counting-map :a) ;=> 1 346 | (get counting-map :c) ;=> nil 347 | @access-counts 348 | ;=> {:a 2, :b 1, :c 1} 349 | 350 | ;; ------------------------------------ 351 | 352 | ;;;;;;;;;;;;;;;;;;;; 353 | ;; 354 | ;; ## 11. Transient Validation 355 | ;; 356 | ;;;;;;;;;;;;;;;;;;;; 357 | 358 | (def transiently-validating-map 359 | (-> empty-wrap 360 | (w/assoc 361 | :T_assoc_k_v (fn [_ t-m k v] 362 | (if (number? v) 363 | (assoc! t-m k v) 364 | (throw (ex-info "Transient validation failed: Value must be number" {:key k :value v}))))))) 365 | 366 | ;; ### Example: 367 | 368 | ;; Successful batch update 369 | (persistent! 370 | (-> transiently-validating-map 371 | transient 372 | (assoc! :x 10) 373 | (assoc! :y 20))) 374 | ;=> {:x 10, :y 20} 375 | 376 | ;; Failing batch update (redefine transient-validating-map above first) 377 | ;; (re-evaluate the transient-validating-map definition above) 378 | (try 379 | (persistent! 380 | (-> transiently-validating-map 381 | transient 382 | (assoc! :x 10) 383 | (assoc! :y "not a number"))) ; This will throw 384 | (catch Exception e (ex-data e))) 385 | ;=> {:key :y, :value "not a number"} 386 | 387 | ;; ------------------------------------ 388 | 389 | ;;;;;;;;;;;;;;;;;;;; 390 | ;; 391 | ;; ## 12. Custom String Representation 392 | ;; 393 | ;;;;;;;;;;;;;;;;;;;; 394 | 395 | (def sanitizing-string-map 396 | (-> (wrap :user "secret-user" :id 123 :data [1 2 3]) 397 | (vary assoc 398 | :print-method_writer (fn [_ m w] 399 | (doto w 400 | (.write ""))) 403 | :toString (fn [_ m] (str ""))))) 404 | 405 | ;; ### Example: 406 | 407 | (str sanitizing-string-map) 408 | ;=> "" 409 | 410 | (println sanitizing-string-map) 411 | ; 412 | 413 | ;; ------------------------------------ 414 | -------------------------------------------------------------------------------- /dev/ex/readme_md.clj: -------------------------------------------------------------------------------- 1 | (ns ex.readme-md 2 | (:require 3 | [com.jolygon.wrap-map.api-0 :as w :refer [wrap]])) 4 | 5 | ;; preserve metadata 6 | (def x (with-meta {} {:a 1})) 7 | (meta x) ;=> {:a 1} 8 | (def y (wrap x)) 9 | (meta y) ;=> {:a 1} 10 | (def z (w/unwrap y)) 11 | (meta z) ;=> {:a 1} 12 | 13 | (def m1 (wrap :a 1 :b 2)) 14 | #_m1 15 | ;=> {:a 1, :b 2} 16 | 17 | ;; It behaves like a standard Clojure map: 18 | (get m1 :a) ;=> 1 19 | (get m1 :c 404) ;=> 404 20 | (:b m1) ;=> 2 21 | (count m1) ;=> 2 22 | (assoc m1 :c 3) ;=> {:c 3, :b 2, :a 1} 23 | (dissoc m1 :a) ;=> {:b 2} 24 | (keys m1) ;=> (:a :b) 25 | (vals m1) ;=> (1 2) 26 | 27 | ;; It's persistent: 28 | (def m2 (assoc m1 :c 3)) 29 | m1 ;=> {:b 2, :a 1} 30 | m2 ;=> {:c 3, :b 2, :a 1} 31 | 32 | ;; Transient support: 33 | (persistent! (assoc! (transient m1) :d 4)) 34 | ;=> {:b 2, :d 4, :a 1} 35 | 36 | (def validating-map 37 | (-> {} 38 | (w/assoc 39 | :valAt_k_nf (fn [_ m k _nf] 40 | (let [v (get m k ::nf)] ; Check underlying map 41 | (if (= v ::nf) 42 | (do (println (str "Key " k " not found, returning default!")) 43 | :my-default) ; Return custom default 44 | v))) 45 | :valAt_k 46 | (fn [{:as e :keys [valAt_k_nf]} m k] ; Delegate to above 47 | (valAt_k_nf e m k ::nf)) 48 | :assoc_k_v 49 | (fn [{:as e :keys [<-]} m k v] 50 | (if-not (and (keyword? k) (number? v)) ; Are k and v valid? 51 | (throw (ex-info "Invalid assoc" {:key k :value v})) 52 | (<- e (assoc m k v))))))) 53 | 54 | (def m3 (assoc validating-map :a 100)) 55 | (get m3 :a) ;=> 100 56 | (get m3 :b) ;=> :my-default 57 | (get m3 :b :different) ;=> :my-default (override ignores passed nf) 58 | 59 | (try (assoc m3 "c" 200) (catch Exception e (ex-data e))) 60 | 61 | ;; transients 62 | 63 | (def m1 (wrap :a 1)) 64 | 65 | ;; Create a transient version 66 | (def tm (transient m1)) 67 | 68 | 1;; Perform transient mutations 69 | (assoc! tm :b 2) 70 | (assoc! tm :c 3) 71 | 72 | ;; Convert back to persistent 73 | (def m-final (persistent! tm)) 74 | #_m-final ;=> {:c 3, :b 2, :a 1} 75 | 76 | ;; --- Overriding Transient Operations --- 77 | (def logging-when-transient-map 78 | (-> {} 79 | (w/assoc 80 | :T_assoc_k_v (fn [_ t-m k v] 81 | (println "[Transient] assoc! key:" k "val:" v) 82 | (assoc! t-m k v))))) 83 | 84 | (persistent! 85 | (-> (transient logging-when-transient-map) 86 | (assoc! :x 100) 87 | (assoc! :y 200))) 88 | ; Prints: [Transient] assoc! key: :x val: 100 89 | ; Prints: [Transient] assoc! key: :y val: 200 90 | ;=> {:x 100, :y 200} 91 | 92 | 93 | ;; --- Overriding Transient Operations --- 94 | (def logging-when-transient-map-on-plain-map 95 | (-> {} 96 | (w/assoc 97 | :T_assoc_k_v (fn [_ t-m k v] 98 | (println "[Transient] assoc! key:" k "val:" v) 99 | (assoc! t-m k v))))) 100 | 101 | (persistent! 102 | (-> (transient logging-when-transient-map-on-plain-map) 103 | (assoc! :x 100) 104 | (assoc! :y 200))) 105 | ; Prints: [Transient] assoc! key: :x val: 100 106 | ; Prints: [Transient] assoc! key: :y val: 200 107 | ;=> {:x 100, :y 200} 108 | 109 | ;; Now all in a row! 110 | 111 | (-> {:a 1} 112 | (assoc :b 2) 113 | (w/assoc 114 | :T_assoc_k_v (fn [_ t-m k v] 115 | (println "[Transient] assoc! key:" k "val:" v) 116 | (assoc! t-m k v))) 117 | transient 118 | (assoc! :x 100) 119 | (assoc! :y 200) 120 | persistent! 121 | w/unwrap 122 | (dissoc :b) 123 | (w/assoc 124 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 125 | (println "[Persistent] assoc key:" k "val:" v) 126 | (<- e (assoc m k v)))) 127 | (assoc :z 300) 128 | w/unwrap 129 | (assoc :done 1)) 130 | ; [Transient] assoc! key: :x val: 100 131 | ; [Transient] assoc! key: :y val: 200 132 | ; [Persistent] assoc key: :z val: 300 133 | {:a 1, :x 100, :y 200, :z 300, :done 1} 134 | 135 | ;; `{:a 1}` became side-effecting halfway through a pipeline, then back to a normal map, continuing through the pipeline. 136 | 137 | (-> {:a 1} 138 | (w/assoc 139 | :assoc #(if (= :easter %2) (throw (ex-info "Found the egg!" %1)) (assoc %1 %2 %3))) 140 | (assoc :b 2) 141 | (assoc :easter :egg) 142 | (assoc :c 3) 143 | w/unwrap 144 | (assoc :done 1)) 145 | 146 | ;; Just do it with w/assoc: 147 | 148 | (-> {:a 1} 149 | (assoc :b 2) 150 | (w/assoc :T_assoc_k_v (fn [_ t-m k v] 151 | (println "[Transient] assoc! key:" k "val:" v) 152 | (assoc! t-m k v))) 153 | transient 154 | (assoc! :x 100) 155 | (assoc! :y 200) 156 | persistent! 157 | w/unwrap 158 | (dissoc :b) 159 | (assoc :z 300)) 160 | ; [Transient] assoc! key: :x val: 100 161 | ; [Transient] assoc! key: :y val: 200 162 | ;=> {:a 1, :x 100, :y 200, :z 300} 163 | 164 | (-> {:a 1} 165 | (w/assoc 166 | :assoc #(do (when (= :easter! %3) (prn :egg! :assoc %2)) (assoc %1 %2 %3)) 167 | :assoc! #(do (when (= :easter! %3) (prn :egg! :assoc! %2)) (assoc! %1 %2 %3)) 168 | :get #(let [r (get %1 %2)] (when (= :easter! r) (prn :egg! :get %2)) r)) 169 | (assoc :b 2) 170 | #_... 171 | transient 172 | (assoc! :5ecr3t :easter!) 173 | persistent! 174 | #_... 175 | (assoc :5ecr3t :redacted) 176 | #_... 177 | #_... 178 | w/unwrap 179 | (assoc :done 1)) 180 | ; :egg! :assoc! :5ecr3t 181 | {:a 1, :b 2, :5ecr3t :redacted, :done 1} 182 | -------------------------------------------------------------------------------- /dev/ex/readme_md.cljc: -------------------------------------------------------------------------------- 1 | (ns ex.readme-md 2 | (:require 3 | [com.jolygon.wrap-map :as w :refer [wrap]])) 4 | 5 | (def m1 (wrap :a 1 :b 2)) 6 | #_m1 7 | ;=> {:a 1, :b 2} 8 | 9 | ;; It behaves like a standard Clojure map: 10 | (get m1 :a) ;=> 1 11 | (get m1 :c 404) ;=> 404 12 | (:b m1) ;=> 2 13 | (count m1) ;=> 2 14 | (assoc m1 :c 3) ;=> {:a 1, :b 2, :c 3} 15 | (dissoc m1 :a) ;=> {:b 2} 16 | (keys m1) ;=> (:a :b) 17 | (vals m1) ;=> (1 2) 18 | 19 | ;; It's persistent: 20 | (def m2 (assoc m1 :c 3)) 21 | m1 ;=> {:a 1, :b 2} 22 | m2 ;=> {:a 1, :b 2, :c 3} 23 | 24 | ;; Transient support: 25 | (persistent! (assoc! (transient m1) :d 4)) 26 | ;=> {:a 1, :b 2, :d 4} 27 | 28 | (def validating-map 29 | (-> {} 30 | (w/assoc 31 | :-lookup_k_nf (fn [_ m k _nf] 32 | (let [v (get m k ::nf)] ; Check underlying map 33 | (if (= v ::nf) 34 | (do (println (str "Key " k " not found, returning default!")) 35 | :my-default) ; Return custom default 36 | v))) 37 | :-lookup_k (fn [{:as e :keys [-lookup_k_nf]} m k] ; Delegate to above 38 | (-lookup_k_nf e m k ::nf)) 39 | 40 | :-assoc_k_v (fn [{:as e :keys [<-]} m k v] 41 | (if-not (and (keyword? k) (number? v)) 42 | (throw (ex-info "Invalid assoc" {:key k :value v})) 43 | (<- e (assoc m k v))))))) 44 | 45 | (def m3 (assoc validating-map :a 100)) 46 | (get m3 :a) ;=> 100 47 | (assoc m3 :a :bob) 48 | ; Execution error (ExceptionInfo) at (:1). 49 | ; Invalid assoc 50 | (get m3 :b) ;=> :my-default 51 | (get m3 :b :different) ;=> :my-default (override ignores passed nf) 52 | 53 | 54 | (-> m3 55 | transient 56 | (assoc! :x 100) 57 | (assoc! :y 200) 58 | persistent!) 59 | ;=> {:a 100, :x 100, :y 200} 60 | 61 | (-> m3 62 | (assoc :b 200) 63 | (assoc "c" 200) 64 | (try (catch :default e (ex-data e)))) 65 | ;=> {:key "c", :value 200} 66 | 67 | ;; transients 68 | 69 | (def m (wrap :a 1)) 70 | 71 | ;; Create a transient version 72 | (def tm (transient m)) 73 | 74 | ;; Perform transient mutations 75 | (assoc! tm :b 2) 76 | (assoc! tm :c 3) 77 | 78 | ;; Convert back to persistent 79 | (def m-final (persistent! tm)) 80 | #_m-final ;=> {:c 3, :b 2, :a 1} 81 | 82 | ;; --- Overriding Transient Operations --- 83 | (def logging-when-transient-map 84 | (-> {} 85 | (w/assoc 86 | :T_-assoc!_k_v (fn [_ t-m k v] 87 | (println "[Transient] assoc! key:" k "val:" v) 88 | (assoc! t-m k v))))) 89 | 90 | (persistent! 91 | (-> (transient logging-when-transient-map) 92 | (assoc! :x 100) 93 | (assoc! :y 200))) 94 | ; Prints: [Transient] assoc! key: :x val: 100 95 | ; Prints: [Transient] assoc! key: :y val: 200 96 | ;=> {:x 100, :y 200} 97 | 98 | (-> {:a 1} 99 | (w/assoc :T_-assoc!_k_v 100 | (fn [_ t-m k v] 101 | (println "[Transient] assoc! key:" k "val:" v) 102 | (assoc! t-m k v))) 103 | transient 104 | (assoc! :x 100) 105 | (assoc! :y 200) 106 | persistent! 107 | (assoc :b 2) 108 | w/unwrap ;; <- subsequent `assoc!` calls will not be logged 109 | transient 110 | (assoc! :r 4) 111 | (assoc! :s 5) 112 | persistent! 113 | (assoc :c 3)) 114 | ; [Transient] assoc! key: :x val: 100 115 | ; [Transient] assoc! key: :y val: 200 116 | ;=> {:a 1, :x 100, :y 200, :b 2, :r 4, :s 5, :c 3} 117 | -------------------------------------------------------------------------------- /dev/ex/readme_md.cljs: -------------------------------------------------------------------------------- 1 | (ns ex.readme-md 2 | (:require 3 | [com.jolygon.wrap-map :as w :refer [wrap]])) 4 | 5 | (def m1 (wrap :a 1 :b 2)) 6 | #_m1 7 | ;=> {:a 1, :b 2} 8 | 9 | ;; It behaves like a standard Clojure map: 10 | (get m1 :a) ;=> 1 11 | (get m1 :c 404) ;=> 404 12 | (:b m1) ;=> 2 13 | (count m1) ;=> 2 14 | (assoc m1 :c 3) ;=> {:a 1, :b 2, :c 3} 15 | (dissoc m1 :a) ;=> {:b 2} 16 | (keys m1) ;=> (:a :b) 17 | (vals m1) ;=> (1 2) 18 | 19 | ;; It's persistent: 20 | (def m2 (assoc m1 :c 3)) 21 | m1 ;=> {:a 1, :b 2} 22 | m2 ;=> {:a 1, :b 2, :c 3} 23 | 24 | ;; Transient support: 25 | (persistent! (assoc! (transient m1) :d 4)) 26 | ;=> {:a 1, :b 2, :d 4} 27 | 28 | (def validating-map 29 | (-> {} 30 | (w/assoc 31 | :-lookup_k_nf (fn [_ m k _nf] 32 | (let [v (get m k ::nf)] ; Check underlying map 33 | (if (= v ::nf) 34 | (do (println (str "Key " k " not found, returning default!")) 35 | :my-default) ; Return custom default 36 | v))) 37 | :-lookup_k (fn [{:as e :keys [-lookup_k_nf]} m k] ; Delegate to above 38 | (-lookup_k_nf e m k ::nf)) 39 | 40 | :-assoc_k_v (fn [{:as e :keys [<-]} m k v] 41 | (if-not (and (keyword? k) (number? v)) 42 | (throw (ex-info "Invalid assoc" {:key k :value v})) 43 | (<- e (assoc m k v))))))) 44 | 45 | (def m3 (assoc validating-map :a 100)) 46 | (get m3 :a) ;=> 100 47 | (assoc m3 :a :bob) 48 | ; Execution error (ExceptionInfo) at (:1). 49 | ; Invalid assoc 50 | (get m3 :b) ;=> :my-default 51 | (get m3 :b :different) ;=> :my-default (override ignores passed nf) 52 | 53 | 54 | (-> m3 55 | transient 56 | (assoc! :x 100) 57 | (assoc! :y 200) 58 | persistent!) 59 | ;=> {:a 100, :x 100, :y 200} 60 | 61 | (-> m3 62 | (assoc :b 200) 63 | (assoc "c" 200) 64 | (try (catch :default e (ex-data e)))) 65 | ;=> {:key "c", :value 200} 66 | 67 | ;; transients 68 | 69 | (def m (wrap :a 1)) 70 | 71 | ;; Create a transient version 72 | (def tm (transient m)) 73 | 74 | ;; Perform transient mutations 75 | (assoc! tm :b 2) 76 | (assoc! tm :c 3) 77 | 78 | ;; Convert back to persistent 79 | (def m-final (persistent! tm)) 80 | #_m-final ;=> {:c 3, :b 2, :a 1} 81 | 82 | ;; --- Overriding Transient Operations --- 83 | (def logging-when-transient-map 84 | (-> {} 85 | (w/assoc 86 | :T_-assoc!_k_v (fn [_ t-m k v] 87 | (println "[Transient] assoc! key:" k "val:" v) 88 | (assoc! t-m k v))))) 89 | 90 | (persistent! 91 | (-> (transient logging-when-transient-map) 92 | (assoc! :x 100) 93 | (assoc! :y 200))) 94 | ; Prints: [Transient] assoc! key: :x val: 100 95 | ; Prints: [Transient] assoc! key: :y val: 200 96 | ;=> {:x 100, :y 200} 97 | 98 | (-> {:a 1} 99 | (w/assoc :T_-assoc!_k_v 100 | (fn [_ t-m k v] 101 | (println "[Transient] assoc! key:" k "val:" v) 102 | (assoc! t-m k v))) 103 | transient 104 | (assoc! :x 100) 105 | (assoc! :y 200) 106 | persistent! 107 | (assoc :b 2) 108 | w/unwrap ;; <- subsequent `assoc!` calls will not be logged 109 | transient 110 | (assoc! :r 4) 111 | (assoc! :s 5) 112 | persistent! 113 | (assoc :c 3)) 114 | ; [Transient] assoc! key: :x val: 100 115 | ; [Transient] assoc! key: :y val: 200 116 | ;=> {:a 1, :x 100, :y 200, :b 2, :r 4, :s 5, :c 3} 117 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require 3 | [clojure.tools.namespace.repl :as repl] 4 | [clojure.test :as test])) 5 | 6 | (repl/set-refresh-dirs "dev" "src" "test") 7 | 8 | (defn reset 9 | "Reload changed namespaces." 10 | [] 11 | (repl/refresh)) 12 | 13 | (defn run-all-tests 14 | "Run all tests." 15 | [] 16 | (reset) 17 | (test/run-all-tests #"wrap-map.*-test")) 18 | 19 | (comment 20 | 21 | (reset) 22 | (run-all-tests) 23 | 24 | :end) 25 | -------------------------------------------------------------------------------- /doc/clj-bench.md: -------------------------------------------------------------------------------- 1 | # CLJ `wrap` Map Performance and Recent Improvements 2 | 3 | This document outlines the performance of `wrap` maps in Clojure. If you're looking for the CLJS benchmarks [look here](./cljs-bench.md). 4 | 5 | ## Improvement 6 | 7 | The initial release included some benchmark numbers. This table below shows how the performance of `wrap` maps have improved since then: 8 | 9 | | Benchmark Operation | Initial | Later | Overall Change (%) | 10 | | ------- | ------- | ------- | ------- | 11 | | Read Existing Key (Bench 1) | 98.9% | 98.8% | -0.1% | 12 | | Read Missing Key (Bench 2) | 55.4% | 88.2% | +59.2% | 13 | | Write (Update Existing Key) (Bench 3) | 91.9% | 95.1% | +3.5% | 14 | | Reduce (Sum Values) (Bench 4) | 99.7% | 91.3% | -8.4% | 15 | | Construct (`into`) (Bench 5) | 55.1% | 92.0% | +67.0% | 16 | | Construct (`apply`) (Bench 6) | 12.8% | 110.6% | +764.1% | 17 | | Simple `assoc` (Baseline Wrap - Bench 7) | 52.9% | 63.0% | +19.1% | 18 | | Simple `assoc` (Logging Wrap - Bench 7) | 16.4% | 38.5% | +134.8% | 19 | | `assoc` New Key (Baseline Wrap - Bench 8) | 5.35%* | 88.9% | +1561.7% | 20 | | `assoc` New Key (Validated Wrap - Bench 8) | 4.3%* | 74.5% | +1632.6% | 21 | | Batch `assoc!` (Baseline Wrap - Bench 9) | 33.9% | 96.1% | +183.5% | 22 | | Batch `assoc!` (Logging Wrap - Bench 9) | 53.5%* | 94.8% | +77.2% | 23 | | `persistent!` Cost (Bench 10) | 31.0% | 45.2% | +45.8% | 24 | | Contended Update (Illustrative - Bench 11) | 38.4% | 95.1% | +147.7% | 25 | 26 | As you can see, except for very small maps and override scenarios, `wrap` maps are generally within 10% of the performance of stock Clojure `hash-map`s. 27 | 28 | ## Frontmatter 29 | 30 | To get us started, here are some forms that will help us compare `wrap` maps and `hash-map`s. 31 | 32 | ```clojure 33 | (ns ex.core-bench 34 | (:require 35 | [com.jolygon.wrap-map :as w :refer [wrap empty-wrap]])) 36 | 37 | (do 38 | 39 | (def small-std-map {:a 1 :b 2 :c 3}) 40 | (def small-wrap-map (wrap :a 1 :b 2 :c 3)) 41 | (def large-map-size 10000) 42 | (def large-std-map (into {} (mapv (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 43 | (def large-wrap-map (wrap large-std-map)) 44 | (def keys-to-access (vec (keys large-std-map))) 45 | (defn rand-key [] (rand-nth keys-to-access)) 46 | 47 | ;; Example Overrides 48 | (def log-atom (atom 0)) 49 | (defn logging-assoc-impl [{:as e :keys [<-]} m k v] 50 | (swap! log-atom inc) 51 | (<- e (assoc m k v))) 52 | 53 | (defn validating-assoc-impl [{:as e :keys [<-]} m k v] 54 | (if (keyword? k) 55 | (<- e (assoc m k v)) 56 | (throw (ex-info "Invalid key" {:key k})))) 57 | 58 | (def logged-wrap-map (w/assoc small-wrap-map :assoc_k_v logging-assoc-impl)) 59 | (def validated-wrap-map (w/assoc large-wrap-map :assoc_k_v validating-assoc-impl)) 60 | 61 | (def invoke-override-map 62 | (w/assoc (wrap :factor 2) 63 | :invoke-variadic 64 | (fn [_ m x] (* (:factor m) x)))) 65 | 66 | :end) 67 | ``` 68 | 69 | ## Baseline Operations (Large Map - 10k elements) 70 | 71 | ### Read Existing Key (Bench 1): 72 | 73 | ```clojure 74 | (get large-wrap-map (rand-key)) 75 | ``` 76 | 77 | - Standard Map: 128.21 ns 78 | - Wrap Map: 129.78 ns 79 | - Wrap Map Speed: 98.8% of Standard 80 | 81 | ```clojure 82 | |-------------------------| Wrap (98.8%) 83 | |-------------------------| Std (100%) 84 | | 0% | 25% | 50% | 75% | 100% 85 | ``` 86 | 87 | ### Read Missing Key (Bench 2): 88 | 89 | ```clojure 90 | (get large-wrap-map :not-a-key :default-val) 91 | ``` 92 | 93 | - Standard Map: 13.66 ns 94 | - Wrap Map: 15.48 ns 95 | - Wrap Map Speed: 88.2% of Standard 96 | 97 | ```clojure 98 | |----------------------| | Wrap (88.2%) 99 | |-------------------------| Std (100%) 100 | | 0% | 25% | 50% | 75% | 100% 101 | ``` 102 | 103 | ### Write (Update Existing Key) (Bench 3): 104 | 105 | ```clojure 106 | (assoc large-wrap-map (rand-key) 999) 107 | ``` 108 | 109 | - Standard Map: 192.15 ns 110 | - Wrap Map: 202.10 ns 111 | - Wrap Map Speed: 95.1% of Standard 112 | 113 | ```clojure 114 | |------------------------|| Wrap (95.1%) 115 | |-------------------------| Std (100%) 116 | | 0% | 25% | 50% | 75% | 100% 117 | ``` 118 | 119 | ### Reduce (Sum Values) (Bench 4): 120 | 121 | ```clojure 122 | (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-wrap-map) 123 | ``` 124 | 125 | - Standard Map: 176.11 µs 126 | - Wrap Map: 192.87 µs 127 | - Wrap Map Speed: 91.3% of Standard 128 | 129 | ```clojure 130 | |-----------------------| | Wrap (91.3%) 131 | |-------------------------| Std (100%) 132 | | 0% | 25% | 50% | 75% | 100% 133 | ``` 134 | 135 | ### Construct (into) (Bench 5): 136 | 137 | ```clojure 138 | (into empty-wrap (mapv vec (partition 2 large-map-data))) 139 | ``` 140 | 141 | - Standard Map: 6.91 ms 142 | - Wrap Map: 7.50 ms 143 | - Wrap Map Speed: 92.0% of Standard 144 | 145 | ```clojure 146 | |-----------------------| | Wrap (92.0%) 147 | |-------------------------| Std (100%) 148 | | 0% | 25% | 50% | 75% | 100% 149 | ``` 150 | 151 | ### Construct (apply) (Bench 6): 152 | 153 | ```clojure 154 | (apply wrap large-map-data) 155 | ``` 156 | 157 | - Standard Map: 1.77 ms 158 | - Wrap Map: 1.60 ms 159 | - Wrap Map Speed: 110.6% of Standard (Wrap Faster!) 160 | 161 | ```clojure 162 | |-----------------------------| Wrap (110.6%) 163 | |-------------------------| Std (100%) 164 | | 0% | 25% | 50% | 75% | 100% 165 | ``` 166 | 167 | ## Override Impact 168 | 169 | ### Simple assoc (Small Map - Bench 7): 170 | 171 | ```clojure 172 | (assoc small-wrap-map :d 4) 173 | ``` 174 | 175 | - Standard Map: 35.87 ns 176 | - Wrap Map (Baseline): 56.93 ns -> 63.0% of Standard 177 | 178 | ```clojure 179 | |----------------| | Wrap (Baseline - 63.0%) 180 | |-------------------------| Std (100%) 181 | | 0% | 25% | 50% | 75% | 100% 182 | ``` 183 | 184 | ```clojure 185 | (assoc logged-wrap-map :d 4) 186 | ``` 187 | 188 | - Wrap Map (Logging): 93.17 ns -> 38.5% of Standard 189 | 190 | ```clojure 191 | |---------| | Wrap (Logging - 38.5%) 192 | |-------------------------| Std (100%) 193 | | 0% | 25% | 50% | 75% | 100% 194 | ``` 195 | 196 | ### assoc New Key (Large Map - Bench 8): 197 | 198 | ```clojure 199 | (assoc large-wrap-map :d 4) 200 | ``` 201 | 202 | - Standard Map: 96.43 ns 203 | - Wrap Map (Baseline): 108.39 ns -> 88.9% of Standard 204 | 205 | ```clojure 206 | |----------------------| | Wrap (Baseline - 88.9%) 207 | |-------------------------| Std (100%) 208 | | 0% | 25% | 50% | 75% | 100% 209 | ``` 210 | 211 | ```clojure 212 | (assoc validated-wrap-map :d 4) 213 | ``` 214 | 215 | - Wrap Map (Validated): 129.51 ns -> 74.5% of Standard 216 | 217 | ```clojure 218 | |------------------| | Wrap (Validated - 74.5%) 219 | |-------------------------| Std (100%) 220 | | 0% | 25% | 50% | 75% | 100% 221 | ``` 222 | 223 | ## Transient Operations 224 | 225 | ### Batch assoc! (Large Map - Bench 9): 226 | 227 | ```clojure 228 | (def items-to-add (vec (range large-map-size))) 229 | 230 | (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient empty-wrap) items-to-add)) 231 | ``` 232 | 233 | - Standard Transient: 2.33 ms 234 | - Wrap Map Transient (Baseline): 2.42 ms -> 96.1% of Standard 235 | 236 | ```clojure 237 | |------------------------|| Wrap (Baseline - 96.1%) 238 | |-------------------------| Std (100%) 239 | | 0% | 25% | 50% | 75% | 100% 240 | ``` 241 | 242 | ```clojure 243 | (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient logged-transient-map) items-to-add)) 244 | ``` 245 | 246 | - Wrap Map Transient (Logging): 2.46 ms -> 94.8% of Standard 247 | 248 | ```clojure 249 | |------------------------|| Wrap (Logging - 94.8%) 250 | |-------------------------| Std (100%) 251 | | 0% | 25% | 50% | 75% | 100% 252 | ``` 253 | 254 | ### persistent! Cost (Large Map - Bench 10): 255 | 256 | ```clojure 257 | (persistent! (transient large-wrap-map)) 258 | ``` 259 | 260 | - Standard Transient: 41.46 ns 261 | - Wrap Map Transient: 91.79 ns 262 | - Wrap Map Speed: 45.2% of Standard 263 | 264 | ```clojure 265 | |-----------| | Wrap Persistent! (45.2%) 266 | |-------------------------| Std Persistent! (100%) 267 | | 0% | 25% | 50% | 75% | 100% 268 | ``` 269 | 270 | ### Contended Update (Illustrative - Bench 11): 271 | 272 | ```clojure 273 | (def counter (atom 0)) 274 | (def contended-wrap-map 275 | (w/assoc empty-wrap 276 | :T_assoc_k_v 277 | (fn [_ t-m k v] 278 | (swap! counter inc) 279 | (assoc! t-m k v)))) 280 | 281 | (defn contended-wrap-update [n-updates] 282 | (reset! counter 0) 283 | (let [futures (doall (for [_ (range 10)] ; Simulate 10 threads 284 | (future 285 | (persistent! 286 | (reduce (fn [t i] (assoc! t (keyword (str "k" i)) i)) 287 | (transient contended-wrap-map) 288 | (range n-updates))))))] 289 | (run! deref futures))) ; Wait for all futures 290 | 291 | (contended-wrap-update 100) 292 | ``` 293 | 294 | - Standard Transient: 82.94 µs 295 | - Wrap Map Transient: 87.20 µs 296 | - Wrap Map Speed: 95.1% of Standard 297 | 298 | ```clojure 299 | |------------------------|| Wrap Contended (95.1%) 300 | |-------------------------| Std Contended (100%) 301 | | 0% | 25% | 50% | 75% | 100% 302 | ``` 303 | -------------------------------------------------------------------------------- /doc/cljdoc.edn: -------------------------------------------------------------------------------- 1 | {:cljdoc.doc/tree 2 | [["Readme" {:file "README.md"}] 3 | ["High Level Examples" {:file "doc/examples-high-level.md"}] 4 | ["Low Level Examples" {:file "doc/examples.md"}] 5 | ["Clojure Benchmarks" {:file "doc/clj-bench.md"}] 6 | ["ClojureScript Benchmarks" {:file "doc/cljs-bench.md"}]]} 7 | -------------------------------------------------------------------------------- /doc/cljs-bench.md: -------------------------------------------------------------------------------- 1 | # CLJS `wrap` Map Performance and Recent Improvements 2 | 3 | This document outlines the performance of `wrap` maps in ClojureScript (tested on Node.js), reflecting optimizations including multi-deftype implementation and the use of `defrecord` for implementation maps. If you're looking for the Clojure benchmarks [look here](./clj-bench.md). 4 | 5 | ## Improvement Summary (Run 1 vs Run 8) 6 | 7 | The initial results were recorded before major architectural changes. Significant optimizations were made leading up to the latest benchmarks. This table shows the relative performance improvement between these runs. I Gemini collate the numbers into this table. 8 | 9 | **Relative Speed % = (Standard Map Time / Wrap Map Time) * 100%** 10 | **Improvement % = `((Speed % Run 8 / Speed % Run 1) - 1) * 100%`** 11 | 12 | | Benchmark Operation | Original Speed (%) | Speed Now (%) | Overall Change (%) | 13 | | :--------------------------------------- | :-------------- | :-------------- | :----------------- | 14 | | Read Existing Key (Large Map) | 57.5% | 80% | **+39.1%** | 15 | | Read Missing Key | 51.0% | 66% | **+29.4%** | 16 | | Write (Update Existing Key - Large Map) | 52.7% | 92% | **+74.6%** | 17 | | Reduce (Sum Values - Large Map) | 107.8% | 97% | **-10.0%** | 18 | | Simple `assoc` (Baseline Wrap - Small) | 29.0% | 102% | **+251.7%** | 19 | | Simple `assoc` (Logging Wrap - Small) | 28.9% | 100% | **+246.0%** | 20 | | `assoc` New Key (Baseline Wrap - Large)| 52.5% | 96% | **+82.9%** | 21 | | `assoc` New Key (Validated Wrap - Large)| 53.3% | 92% | **+72.6%** | 22 | | Batch `assoc!` (Baseline Wrap) | 77.7% | 97% | **+24.8%** | 23 | | Batch `assoc!` (Logging Wrap) | 77.6% | 97%* | **+25.0%** | 24 | | `persistent!` Cost | 13.2% | 48% | **+263.6%** | 25 | 26 | As shown, massive improvements were achieved, particularly for `assoc` operations which now often meet or exceed standard map performance. Transient batch operations are also highly competitive. The main remaining bottleneck relative to standard maps in CLJS is the `persistent!` cost. 27 | 28 | ## Frontmatter 29 | 30 | Setup code similar to the Clojure benchmarks is used. 31 | 32 | ```clojure 33 | (ns ex.cljs-bench-setup ;; Example namespace 34 | (:require 35 | [com.jolygon.wrap-map :as w :refer [wrap empty-wrap freeze]])) 36 | 37 | (do 38 | ;; baseline 39 | (def small-std-map {:a 1 :b 2 :c 3}) 40 | (def small-wrap-map (wrap :a 1 :b 2 :c 3)) 41 | (def frozen-small-wrap-map (w/freeze small-wrap-map)) 42 | (def large-map-size 10000) 43 | (def large-std-map (into {} (mapv (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 44 | (def large-wrap-map (doall (into w/empty-wrap large-std-map))) 45 | (def frozen-large-wrap-map (w/freeze large-wrap-map)) 46 | (def keys-to-access (vec (keys large-std-map))) 47 | (defn rand-key [] (rand-nth keys-to-access)) 48 | ;; Overrides 49 | (def log-atom (atom 0)) 50 | (defn logging-assoc-impl [{:as e :keys [<-]} m k v] 51 | (swap! log-atom inc) 52 | (<- e (assoc m k v))) 53 | (defn validating-assoc-impl [{:as e :keys [<-]} m k v] 54 | (if (keyword? k) 55 | (<- e (assoc m k v)) 56 | (throw (ex-info "Invalid key" {:key k})))) 57 | (def logged-wrap-map (w/assoc small-wrap-map :assoc_k_v logging-assoc-impl)) 58 | (def frozen-logged-wrap-map (w/freeze logged-wrap-map)) 59 | (def validated-wrap-map (w/assoc large-wrap-map :assoc_k_v validating-assoc-impl)) 60 | (def frozen-validated-wrap-map (w/freeze validated-wrap-map)) 61 | (def large-map-data (vec (mapcat (fn [i] [(keyword (str "k" i)) i]) (range large-map-size)))) 62 | (def items-to-add (vec (range large-map-size))) 63 | :end) 64 | ``` 65 | 66 | ## Baseline Operations (Large Map - 10k elements) 67 | 68 | ### Baseline Read: Large Map 69 | 70 | ```clojure 71 | (get large-wrap-map (rand-key)) 72 | ``` 73 | 74 | - Standard Map: 151 ms 75 | - Wrap Map: 188 ms -> *80% of Standard* 76 | - Frozen Wrap: 274 ms -> *67% of Standard* 77 | 78 | ```clojure 79 | |--------------------| | Wrap (80%) 80 | |----------------| | Frozen Wrap (67%) 81 | |-------------------------| Std (100%) 82 | 0% 25% 50% 75% 100% 83 | ``` 84 | 85 | ### Baseline Read: Missing Key 86 | 87 | ```clojure 88 | (get large-wrap-map :not-a-key :default-val) 89 | ``` 90 | 91 | - Standard Map: 94 ms 92 | - Wrap Map: 141 ms -> *66% of Standard* 93 | - Frozen Wrap: 140 ms -> *65% of Standard* 94 | 95 | |----------------| | Wrap (66%) 96 | |---------------| | Frozen Wrap (65%) 97 | |-------------------------| Std (100%) 98 | 0% 25% 50% 75% 100% 99 | 100 | ### Baseline Write: Large Map Update 101 | 102 | ```clojure 103 | (assoc large-wrap-map (rand-key) 999) 104 | ``` 105 | 106 | - Standard Map: 560 ms 107 | - Wrap Map: 606 ms -> *92% of Standard* 108 | - Frozen Wrap: 438 ms -> *102% of Standard* (Frozen Faster!) 109 | 110 | ```clojure 111 | |----------------------| | Wrap (92%) 112 | |-------------------------| Frozen Wrap (102%) 113 | |-------------------------| Std (100%) 114 | 0% 25% 50% 75% 100% 115 | ``` 116 | 117 | ### Baseline Reduce: Large Map Sum Values 118 | 119 | ```clojure 120 | (reduce-kv (fn [acc _ v] (+ acc v)) 0 large-wrap-map) 121 | ``` 122 | 123 | - Standard Map: 274 ms 124 | - Wrap Map: 280 ms -> *97% of Standard* 125 | - Frozen Wrap: 276 ms -> *98% of Standard* 126 | 127 | ```clojure 128 | |-----------------------| | Wrap (97%) 129 | |------------------------| Wrap (98%) 130 | |-------------------------| Std (100%) 131 | 0% 25% 50% 75% 100% 132 | ``` 133 | 134 | ### Baseline Into: Large Map Construction 135 | 136 | ```clojure 137 | (into w/empty-wrap (mapv vec (partition 2 large-map-data))) 138 | ``` 139 | 140 | - Standard Map: 286 ms 141 | - Wrap Map: 301 ms -> *95% of Standard* 142 | - Frozen Wrap: 304 ms -> *91% of Standard* 143 | 144 | ```clojure 145 | |-----------------------| | Wrap (95%) 146 | |----------------------| | Frozen Wrap (91%) 147 | |-------------------------| Std (100%) 148 | 0% 25% 50% 75% 100% 149 | ``` 150 | 151 | ### Baseline Apply: Large Map Construction 152 | 153 | ```clojure 154 | (apply w/wrap large-map-data) 155 | ``` 156 | 157 | - Standard Map: 229 ms 158 | - Wrap Map: 292 ms -> *78% of Standard* 159 | 160 | ```clojure 161 | |-------------------| | Wrap (78%) 162 | |-------------------------| Std (100%) 163 | 0% 25% 50% 75% 100% 164 | ``` 165 | 166 | _(Note: No frozen apply constructor tested)_ 167 | 168 | ## Override Impact 169 | 170 | ### Override Impact Baseline: Simple Assoc 171 | 172 | ```clojure 173 | (assoc small-wrap-map :d 4) 174 | ``` 175 | 176 | - Standard Map: 128 ms 177 | - Wrap Map (Baseline): 125 ms -> *102% of Standard* (Wrap Faster!) 178 | 179 | ```clojure 180 | |-------------------------| Wrap (Baseline - 102%) 181 | |-------------------------| Std (100%) 182 | 0% 25% 50% 75% 100% 183 | ``` 184 | 185 | ### Override Impact: Simple Logging Assoc 186 | 187 | ```clojure 188 | (assoc logged-wrap-map :d 4) 189 | ``` 190 | 191 | - Standard Map: 123 ms 192 | - Wrap Map (Logging): 122 ms -> *100% of Standard* 193 | - Frozen Wrap (Logging): 125 ms -> *102% of Standard* (Frozen Faster!) 194 | 195 | ```clojure 196 | |-------------------------| Wrap (Logging - 100%) 197 | |-------------------------| Frozen Wrap (Logging - 102%) 198 | |-------------------------| Std (100%) 199 | 0% 25% 50% 75% 100% 200 | ``` 201 | 202 | ### Override Impact: Validating Assoc - Valid Key 203 | 204 | ```clojure 205 | (assoc validated-wrap-map :new-key 123) 206 | ``` 207 | 208 | - Standard Map: 306 ms 209 | - Wrap Map (Validated): 331 ms -> *92% of Standard* 210 | - Frozen Wrap (Validated): 326 ms -> *98% of Standard* 211 | 212 | ```clojure 213 | |----------------------| | Wrap (Validated - 92%) 214 | |------------------------| Frozen Wrap (Validated - 98%) 215 | |-------------------------| Std (100%) 216 | 0% 25% 50% 75% 100% 217 | ``` 218 | 219 | ### Compare Baseline Assoc Large (Assoc New Key) 220 | 221 | ```clojure 222 | (assoc large-wrap-map :new-key 123) 223 | ``` 224 | 225 | - Standard Map: 315 ms 226 | - Wrap Map (Baseline): 326 ms -> *96% of Standard* 227 | - Frozen Wrap (Baseline): 330 ms -> *95% of Standard* 228 | 229 | ```clojure 230 | |-----------------------| | Wrap (Baseline - 96%) 231 | |-----------------------| | Frozen Wrap (Baseline - 95%) 232 | |-------------------------| Std (100%) 233 | 0% 25% 50% 75% 100% 234 | ``` 235 | 236 | ## Transient Operations 237 | 238 | ### Transient: Batch Assoc! 239 | 240 | ```clojure 241 | (persistent! (reduce (fn [t i] (assoc! t (keyword (str "new" i)) i)) (transient w/empty-wrap) items-to-add)) 242 | ``` 243 | 244 | - Standard Transient: 663 ms 245 | - Wrap Map Transient (Baseline): 681 ms -> *97% of Standard* 246 | - Frozen Wrap Transient (Baseline): 694 ms -> *95% of Standard* 247 | 248 | ```clojure 249 | |-----------------------| | Wrap (Baseline - 97%) 250 | |-----------------------| | Frozen Wrap (Baseline - 95%) 251 | |-------------------------| Std (100%) 252 | 0% 25% 50% 75% 100% 253 | ``` 254 | 255 | ### Transient: persistent! Cost 256 | 257 | ```clojure 258 | (persistent! (transient large-wrap-map)) 259 | ``` 260 | 261 | - Standard Transient: 25 ms 262 | - Wrap Map Transient (Baseline): 52 ms -> *48% of Standard* 263 | - Frozen Wrap Transient (Baseline): 68 ms -> *52% of Standard* 264 | 265 | ```clojure 266 | |-----------| | Wrap (Baseline - 48%) 267 | |------------| | Frozen Wrap (Baseline - 52%) 268 | |-------------------------| Std (100%) 269 | 0% 25% 50% 75% 100% 270 | ``` 271 | -------------------------------------------------------------------------------- /doc/examples-high-level.md: -------------------------------------------------------------------------------- 1 | # `wrap` Map Examples 2 | 3 | This document provides various examples demonstrating how _`wrap` maps_ can be used to create specialized map-like structures by overriding default behaviors. 4 | 5 | ## Setup 6 | 7 | Most examples will require the following namespaces: 8 | 9 | ```clojure 10 | (ns ex.examples-high-level-md 11 | (:require 12 | [com.jolygon.wrap-map :as w :refer [wrap]])) 13 | ``` 14 | 15 | ## 1. Default Values for Missing Keys 16 | 17 | *Use Case*: You want a map that returns a specific default value (or `nil`) when a requested key is not found, instead of requiring the caller to provide a `nf` argument to `get`. 18 | 19 | *How?*: Override `:get`. 20 | 21 | ```clojure 22 | (def default-value-map 23 | (-> {} 24 | (w/assoc :get (fn [m k & [nf]] 25 | (get m k (or nf :not-available)))))) 26 | 27 | (def m1 (assoc default-value-map :a 1)) 28 | ``` 29 | 30 | ### Example Usage: 31 | 32 | ```clojure 33 | (get m1 :a) ;=> 1 34 | (m1 :a) ;=> 1 35 | (:a m1) ;=> 1 36 | 37 | (get m1 :b) ;=> :not-available 38 | (m1 :b) ;=> :not-available 39 | (:b m1) ;=> :not-available 40 | 41 | (get m1 :b :soon) ;=> :soon 42 | (m1 :b :soon) ;=> :soon 43 | (:b m1 :soon) ;=> :soon 44 | ``` 45 | 46 | ## 2. Case-Insensitive String Keys 47 | 48 | *Use Case*: You need a map where string keys are treated case-insensitively (e.g., for HTTP headers). 49 | 50 | *How?*: Override key lookup and association to normalize string keys (e.g., to lowercase). 51 | 52 | ```clojure 53 | (defn- normalize-key [k] 54 | (if (string? k) (.toLowerCase ^String k) k)) 55 | 56 | (def case-insensitive-map 57 | (-> {} 58 | (w/assoc 59 | :assoc (fn [m k v] (assoc m (normalize-key k) v)) 60 | :dissoc (fn [m k] (dissoc m (normalize-key k))) 61 | :contains? (fn [m k] (contains? m (normalize-key k))) 62 | :get (fn [m k & [nf]] (get m (normalize-key k) nf))))) 63 | 64 | (def headers 65 | (-> case-insensitive-map 66 | (assoc "Content-Type" "application/json") 67 | (assoc :other-header 123))) 68 | ``` 69 | 70 | ### Example Usage: 71 | 72 | ```clojure 73 | (get headers "content-type") ;=> "application/json" 74 | (get headers "CONTENT-TYPE") ;=> "application/json" 75 | (contains? headers "Content-type") ;=> true 76 | 77 | (get headers :other-header) ;=> 123 (Non-string keys unaffected) 78 | 79 | (dissoc headers "CONTENT-TYPE") ;=> {:other-header 123} 80 | ``` 81 | 82 | ## 3. Schema Validation on Assoc 83 | 84 | *Use Case*: Ensure that values associated with specific keys conform to a predefined schema (using `spec` in this example). 85 | 86 | *How?*: Override `:assoc` to perform validation before associating. 87 | 88 | ```clojure 89 | (require '[clojure.spec.alpha :as s]) 90 | 91 | (s/def ::name string?) 92 | (s/def ::age pos-int?) 93 | 94 | (def schema-map 95 | (-> {} 96 | (w/assoc 97 | :assoc (fn [m k v] 98 | (let [expected-type (case k :name ::name :age ::age :any)] 99 | (if (or (= expected-type :any) (s/valid? expected-type v)) 100 | (assoc m k v) 101 | (throw (ex-info "Schema validation failed" 102 | {:key k :value v :expected (s/describe expected-type)})))))))) 103 | ``` 104 | 105 | ### Example Usage: 106 | 107 | ```clojure 108 | (def user (-> schema-map (assoc :name "Alice") (assoc :age 30))) 109 | ;=> {:name "Alice", :age 30} 110 | 111 | (try 112 | (assoc user :age -5) 113 | (catch Exception e (ex-data e))) 114 | ;=> {:key :age, :value -5, :expected pos-int?} 115 | 116 | (try 117 | (assoc user :name 123) 118 | (catch Exception e (ex-data e))) 119 | ;=> {:key :name, :value 123, :expected string?} 120 | ``` 121 | 122 | ## 4. Logging Accesses (Read Logging) 123 | 124 | *Use Case*: Track which keys are being read from the map, perhaps for debugging or analytics. 125 | 126 | *How?*: Override `:get` to log the access. 127 | 128 | ```clojure 129 | (def access-log (atom [])) 130 | 131 | (def logging-read-map 132 | (-> {} 133 | (w/assoc 134 | :get (fn [m k & [nf]] 135 | (swap! access-log conj (if nf [:get k nf] [:get k])) 136 | (get m k nf))))) 137 | 138 | (def mlog (assoc logging-read-map :a 1)) 139 | ``` 140 | 141 | ### Example Usage: 142 | 143 | ```clojure 144 | (reset! access-log []) 145 | (get mlog :a) ;=> 1 146 | (get mlog :b) ;=> nil (Logged as [:get :b]) 147 | (get mlog :c 404) ;=> 404 148 | @access-log 149 | ;=> [[:get :a] [:get :b] [:get :c 404]] 150 | ``` 151 | 152 | ## 5. Side Effects on Update 153 | 154 | *Use Case*: Trigger an external action (like notifying a UI component or saving to a DB) whenever the map is modified. 155 | 156 | *How?*: Override `:assoc` and `:dissoc`. 157 | 158 | ```clojure 159 | (defn notify-change [change-type k value] 160 | (println "[Notification] Type:" change-type ", Key:" k ", Value:" value)) 161 | 162 | (def notifying-map 163 | (-> {} 164 | (w/assoc 165 | :assoc (fn [m k v] 166 | (notify-change :assoc k v) 167 | (assoc m k v)) 168 | :dissoc (fn [m k] 169 | (notify-change :dissoc k nil) 170 | (dissoc m k))))) 171 | ``` 172 | 173 | ### Example Usage: 174 | 175 | ```clojure 176 | (def nmap1 (assoc notifying-map :user "admin")) 177 | ; [Notification] Type: :assoc , Key: :user , Value: admin 178 | (def nmap2 (dissoc nmap1 :user)) 179 | ; [Notification] Type: :dissoc , Key: :user , Value: nil 180 | ``` 181 | 182 | ## 6. Computed / Virtual Properties 183 | 184 | *Use Case*: Define keys that don't store a static value but compute one based on other data in the map when accessed. 185 | 186 | *How?*: Override `:get`. 187 | 188 | ```clojure 189 | (def computed-prop-map 190 | (-> {:first-name "Jane" :last-name "Doe"} 191 | (w/assoc 192 | :get (fn [m k & [nf]] 193 | (if (= k :full-name) 194 | ;; Compute value for :full-name 195 | (str (:first-name m) " " (:last-name m)) 196 | ;; Otherwise, standard lookup 197 | (get m k nf)))))) 198 | ``` 199 | 200 | ### Example Usage: 201 | 202 | ```clojure 203 | (get computed-prop-map :first-name) ;=> "Jane" 204 | (get computed-prop-map :full-name) ;=> "Jane Doe" 205 | (get computed-prop-map :age :unknown) ;=> :unknown 206 | (get computed-prop-map :full-name :unknown) ;=> "Jane Doe" 207 | ``` 208 | 209 | ## 7. Lazy Loading from External Source 210 | 211 | *Use Case*: Defer loading data for certain keys until they are actually requested, perhaps fetching from a database or file. 212 | 213 | *How?*: Override `:get`. If the key isn't present, attempt to load it. This example also updates the map to cache the loaded value. 214 | 215 | ```clojure 216 | (defn simulate-db-fetch [k] 217 | (println "[DB] Fetching data for key:" k) 218 | (Thread/sleep 50) ; Simulate delay 219 | (if (= k :user-prefs) {:theme "dark" :lang "en"} nil)) 220 | 221 | (def lazy-loading-map 222 | (-> {} 223 | (w/assoc 224 | :get (fn [m k & [nf]] 225 | (let [v (get m k ::nf)] 226 | (if (= v ::nf) 227 | ;; Not found locally, try loading 228 | (if-let [loaded-val (simulate-db-fetch k)] 229 | ;; Found externally: assoc into a new map and return the value 230 | ;; This effectively caches the result. 231 | (do 232 | (println "[Cache] Storing loaded value for key:" k) 233 | loaded-val) ;; Simple version: just return loaded, no cache update 234 | ;; Not found externally either 235 | (or nf ::nf)) 236 | ;; Found locally 237 | v)))))) 238 | ``` 239 | 240 | ### Example Usage (Simple Version - No Caching): 241 | 242 | ```clojure 243 | (def lazy-map (assoc lazy-loading-map :config {:port 80})) 244 | 245 | (get lazy-map :config) ;=> {:port 80} (No fetch) 246 | 247 | (get lazy-map :user-prefs) 248 | ; [DB] Fetching data for key: :user-prefs 249 | ; [Cache] Storing loaded value for key: :user-prefs 250 | ;=> {:theme "dark", :lang "en"} 251 | 252 | (get lazy-map :user-prefs) ; Access again 253 | ; [DB] Fetching data for key: :user-prefs (Fetched again as simple version doesn't cache) 254 | ; [Cache] Storing loaded value for key: :user-prefs 255 | ;=> {:theme "dark", :lang "en"} 256 | 257 | (get lazy-map :other-key :default) 258 | ; [DB] Fetching data for key: :other-key 259 | ;=> :default 260 | ``` 261 | 262 | ## 8. Function Call Dispatch 263 | 264 | *Use Case*: Use the map itself as a dispatch mechanism, calling different functions based on arguments passed when the map is invoked. 265 | 266 | *How?*: Override `:invoke`. 267 | 268 | ```clojure 269 | (defn handle-add [x y] (+ x y)) 270 | (defn handle-multiply [x y] (* x y)) 271 | 272 | (def dispatching-map 273 | (-> {} 274 | (assoc :add-fn handle-add :mul-fn handle-multiply) 275 | (w/assoc 276 | :invoke (fn [m operation & args] 277 | (case operation 278 | :add (apply (:add-fn m) args) 279 | :multiply (apply (:mul-fn m) args) 280 | (throw (ex-info "Unknown operation" {:operation operation}))))))) 281 | ``` 282 | 283 | ### Example Usage: 284 | 285 | ```clojure 286 | (dispatching-map :add 10 5) ;=> 15 287 | (dispatching-map :multiply 10 5) ;=> 50 288 | 289 | (try (dispatching-map :subtract 10 5) (catch #?(:cljs :default :clj Exception) e (ex-data e))) 290 | ;=> {:operation :subtract} 291 | ``` 292 | 293 | ## 9. Access Counting 294 | 295 | *Use Case*: Keep track of how often keys are accessed. 296 | 297 | *How?*: Override `:get`. Store counts in an atom external to the map. 298 | 299 | ```clojure 300 | (def access-counts (atom {})) 301 | 302 | (def counting-map 303 | (-> (wrap :a 1 :b 2) 304 | (w/assoc 305 | :get (fn [m k & [nf]] 306 | (swap! access-counts update k (fnil inc 0)) 307 | (get m k nf))))) 308 | ``` 309 | 310 | ### Example Usage: 311 | 312 | ```clojure 313 | (reset! access-counts {}) 314 | (get counting-map :a) ;=> 1 315 | (get counting-map :b) ;=> 2 316 | (get counting-map :a) ;=> 1 317 | (get counting-map :c) ;=> nil 318 | @access-counts 319 | ;=> {:a 2, :b 1, :c 1} 320 | ``` 321 | 322 | ## 10. Custom String Representation 323 | 324 | *Use Case*: Control how the map is printed or converted to a string, perhaps hiding sensitive data or providing a summary. 325 | 326 | *How?*: Override `:print`. 327 | 328 | ```clojure 329 | (def sanitizing-string-map 330 | (-> (wrap :user "secret-user" :id 123 :data [1 2 3]) 331 | (w/assoc :print #(str "")))) 332 | ``` 333 | 334 | ### Example Usage: 335 | 336 | ```clojure 337 | (str sanitizing-string-map) 338 | ;=> "" 339 | 340 | (println sanitizing-string-map) 341 | ; 342 | ``` 343 | -------------------------------------------------------------------------------- /doc/examples.md: -------------------------------------------------------------------------------- 1 | # `wrap` Map Examples 2 | 3 | This document provides various examples demonstrating how _`wrap` maps_ can be used to create specialized map-like structures by overriding default behaviors. 4 | 5 | ## Setup 6 | 7 | Most examples will require the following namespaces: 8 | 9 | ```clojure 10 | (ns ex.examples-low-level-md 11 | (:require 12 | [com.jolygon.wrap-map :as w :refer [wrap empty-wrap vary]])) 13 | ``` 14 | 15 | ## 1. Default Values for Missing Keys 16 | 17 | *Use Case*: You want a map that returns a specific default value (or `nil`) when a requested key is not found, instead of requiring the caller to provide a `nf` argument to `get`. 18 | 19 | *How?*: Override `:valAt_k` and `:invoke-variadic`. 20 | 21 | ```clojure 22 | (def default-value-map 23 | (-> empty-wrap 24 | (vary assoc 25 | :valAt_k (fn [_ m k] (get m k :not-available)) 26 | :valAt_k_nf (fn [_ m k & [not-available]] (get m k (or not-available :not-available))) 27 | :invoke-variadic (fn [_ m k & [not-available]] 28 | (get m k (or not-available :not-available)))))) 29 | 30 | (def m1 (assoc default-value-map :a 1)) 31 | ``` 32 | 33 | ### Example Usage: 34 | 35 | ```clojure 36 | (get m1 :a) ;=> 1 37 | (m1 :a) ;=> 1 (Arity-1 invoke defaults to get override) 38 | (:a m1) ;=> 1 39 | 40 | (get m1 :b) ;=> :not-available 41 | (m1 :b) ;=> :not-available 42 | (:b m1) ;=> :not-available 43 | 44 | (get m1 :b :soon) ;=> :soon 45 | (m1 :b :soon) ;=> :soon 46 | (:b m1 :soon) ;=> :soon 47 | ``` 48 | 49 | ## 2. Case-Insensitive String Keys 50 | 51 | *Use Case*: You need a map where string keys are treated case-insensitively (e.g., for HTTP headers). 52 | 53 | *How?*: Override key lookup and association to normalize string keys (e.g., to lowercase). 54 | 55 | ```clojure 56 | (defn- normalize-key [k] 57 | (if (string? k) (.toLowerCase ^String k) k)) 58 | 59 | (def case-insensitive-map 60 | (-> {} 61 | (vary merge 62 | {:valAt_k (fn [_ m k] (get m (normalize-key k))) 63 | :valAt_k_nf (fn [_ m k nf] (get m (normalize-key k) nf)) 64 | :containsKey_k (fn [_ m k] (contains? m (normalize-key k))) 65 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 66 | (<- e (assoc m (normalize-key k) v))) 67 | :without_k (fn [{:as e :keys [<-]} m k] 68 | (<- e (dissoc m (normalize-key k))))}))) 69 | 70 | (def headers 71 | (-> case-insensitive-map 72 | (assoc "Content-Type" "application/json") 73 | (assoc :other-header 123))) 74 | ``` 75 | 76 | ### Example Usage: 77 | 78 | ```clojure 79 | (get headers "content-type") ;=> "application/json" 80 | (get headers "CONTENT-TYPE") ;=> "application/json" 81 | (contains? headers "Content-type") ;=> true 82 | 83 | (get headers :other-header) ;=> 123 (Non-string keys unaffected) 84 | 85 | (dissoc headers "CONTENT-TYPE") ;=> {:other-header 123} 86 | ``` 87 | 88 | ## 3. Schema Validation on Assoc 89 | 90 | *Use Case*: Ensure that values associated with specific keys conform to a predefined schema (using `spec` in this example). 91 | 92 | *How?*: Override `:assoc_k_v` to perform validation before associating. 93 | 94 | ```clojure 95 | (require '[clojure.spec.alpha :as s]) 96 | 97 | (s/def ::name string?) 98 | (s/def ::age pos-int?) 99 | 100 | (def schema-map 101 | (-> empty-wrap 102 | (vary assoc 103 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 104 | (let [expected-type (case k :name ::name :age ::age :any)] 105 | (if (or (= expected-type :any) (s/valid? expected-type v)) 106 | (<- e (assoc m k v)) 107 | (throw (ex-info "Schema validation failed" 108 | {:key k :value v :expected (s/describe expected-type)})))))))) 109 | ``` 110 | 111 | ### Example Usage: 112 | 113 | ```clojure 114 | (def user (-> schema-map (assoc :name "Alice") (assoc :age 30))) 115 | ;=> {:name "Alice", :age 30} 116 | 117 | (try 118 | (assoc user :age -5) 119 | (catch Exception e (ex-data e))) 120 | ;=> {:key :age, :value -5, :expected pos-int?} 121 | 122 | (try 123 | (assoc user :name 123) 124 | (catch Exception e (ex-data e))) 125 | ;=> {:key :name, :value 123, :expected string?} 126 | ``` 127 | 128 | ## 4. Logging Accesses (Read Logging) 129 | 130 | *Use Case*: Track which keys are being read from the map, perhaps for debugging or analytics. 131 | 132 | *How?*: Override `:valAt_k` and `:valAt_k_nf` to log the access. 133 | 134 | ```clojure 135 | (def access-log (atom [])) 136 | 137 | (def logging-read-map 138 | (-> {} 139 | (vary assoc 140 | :valAt_k (fn [_ m k] 141 | (swap! access-log conj [:get k]) 142 | (get m k)) 143 | :valAt_k_nf (fn [_ m k nf] 144 | (swap! access-log conj [:get k nf]) 145 | (get m k nf))))) 146 | 147 | (def mlog (assoc logging-read-map :a 1)) 148 | ``` 149 | 150 | ### Example Usage: 151 | 152 | ```clojure 153 | (reset! access-log []) 154 | (get mlog :a) ;=> 1 155 | (get mlog :b) ;=> nil (Logged as [:get :b]) 156 | (get mlog :c 404) ;=> 404 157 | @access-log 158 | ;=> [[:get :a] [:get :b] [:get :c 404]] 159 | ``` 160 | 161 | ## 5. Side Effects on Update 162 | 163 | *Use Case*: Trigger an external action (like notifying a UI component or saving to a DB) whenever the map is modified. 164 | 165 | *How?*: Override `:assoc_k_v` and `:without_k`. 166 | 167 | ```clojure 168 | (defn notify-change [change-type key value] 169 | (println "[Notification] Type:" change-type ", Key:" key ", Value:" value)) 170 | 171 | (def notifying-map 172 | (-> {} 173 | (vary assoc 174 | :assoc_k_v (fn [{:as e :keys [<-]} m k v] 175 | (notify-change :assoc k v) 176 | (<- e (assoc m k v))) 177 | :without_k (fn [{:as e :keys [<-]} m k] 178 | (notify-change :dissoc k nil) 179 | (<- e (dissoc m k)))))) 180 | ``` 181 | 182 | ### Example Usage: 183 | 184 | ```clojure 185 | (def nmap1 (assoc notifying-map :user "admin")) 186 | ; [Notification] Type: :assoc , Key: :user , Value: admin 187 | (def nmap2 (dissoc nmap1 :user)) 188 | ; [Notification] Type: :dissoc , Key: :user , Value: nil 189 | ``` 190 | 191 | ## 6. Computed / Virtual Properties 192 | 193 | *Use Case*: Define keys that don't store a static value but compute one based on other data in the map when accessed. 194 | 195 | *How?*: Override `:valAt_k` (and potentially `:valAt_k_nf`). 196 | 197 | ```clojure 198 | (def computed-prop-map 199 | (-> (wrap :first-name "Jane" :last-name "Doe") 200 | (vary assoc 201 | :valAt_k (fn [_ m k] 202 | (if (= k :full-name) 203 | (str (:first-name m) " " (:last-name m)) 204 | (get m k))) 205 | :valAt_k_nf (fn [{:as e :keys [valAt_k]} m k nf] 206 | (if (= k :full-name) 207 | (valAt_k e m k) ;; <- Delegate to valAt_k 208 | (get m k nf)))))) 209 | ``` 210 | 211 | ### Example Usage: 212 | 213 | ```clojure 214 | (get computed-prop-map :first-name) ;=> "Jane" 215 | (get computed-prop-map :full-name) ;=> "Jane Doe" 216 | (get computed-prop-map :age :unknown) ;=> :unknown 217 | (get computed-prop-map :full-name :unknown) ;=> "Jane Doe" 218 | ``` 219 | 220 | ## 7. Lazy Loading from External Source 221 | 222 | *Use Case*: Defer loading data for certain keys until they are actually requested, perhaps fetching from a database or file. 223 | 224 | *How?*: Override `:valAt_k_nf`. If the key isn't present, attempt to load it. This example also updates the map to cache the loaded value. 225 | 226 | ```clojure 227 | (defn simulate-db-fetch [k] 228 | (println "[DB] Fetching data for key:" k) 229 | (Thread/sleep 50) ; Simulate delay 230 | (if (= k :user-prefs) {:theme "dark" :lang "en"} nil)) 231 | 232 | (def lazy-loading-map 233 | (-> {} 234 | (vary assoc 235 | :valAt_k_nf (fn [_ m k nf] 236 | (let [v (get m k ::nf)] 237 | (if (= v ::nf) 238 | (if-let [loaded-val (simulate-db-fetch k)] 239 | (do 240 | (println "[Cache] Storing loaded value for key:" k) 241 | loaded-val) ;; Simple version: just return loaded, no cache update 242 | nf) 243 | v))) 244 | :valAt_k (fn [{:as e :keys [valAt_k_nf]} m k] 245 | (valAt_k_nf e m k ::nf))))) ; Delegate to above 246 | ``` 247 | 248 | ### Example Usage (Simple Version - No Caching): 249 | 250 | ```clojure 251 | (def lazy-map (assoc lazy-loading-map :config {:port 80})) 252 | 253 | (get lazy-map :config) ;=> {:port 80} (No fetch) 254 | 255 | (get lazy-map :user-prefs) 256 | ; [DB] Fetching data for key: :user-prefs 257 | ; [Cache] Storing loaded value for key: :user-prefs 258 | ;=> {:theme "dark", :lang "en"} 259 | 260 | (get lazy-map :user-prefs) ; Access again 261 | ; [DB] Fetching data for key: :user-prefs (Fetched again as simple version doesn't cache) 262 | ; [Cache] Storing loaded value for key: :user-prefs 263 | ;=> {:theme "dark", :lang "en"} 264 | 265 | (get lazy-map :other-key :default) 266 | ; [DB] Fetching data for key: :other-key 267 | ;=> :default 268 | ``` 269 | 270 | ## 8. Read-Only Map View 271 | 272 | *Use Case*: Provide a map interface to data that should not be modified through that interface. 273 | 274 | *How?*: Override all mutating impls (`assoc`, `dissoc`, `conj`, etc.) to throw `UnsupportedOperationException`. 275 | 276 | ```clojure 277 | (defn read-only-error [& _] 278 | (throw (UnsupportedOperationException. "Wrap map is read-only"))) 279 | 280 | (def read-only-map-impls 281 | {:assoc_k_v read-only-error 282 | :without_k read-only-error 283 | :assocEx_k_v read-only-error 284 | ;; Override transient mutations too if you want `(transient read-only-map)` to fail 285 | :T_assoc_k_v read-only-error 286 | :T_without_k read-only-error 287 | :T_conj_v read-only-error}) 288 | 289 | (def read-only-m 290 | (-> (wrap :a 1) 291 | (vary merge read-only-map-impls))) 292 | ``` 293 | 294 | ### Example Usage: 295 | 296 | ```clojure 297 | (get read-only-m :a) ;=> 1 298 | (count read-only-m) ;=> 1 299 | 300 | (try (assoc read-only-m :b 2) (catch Exception e (.getMessage e))) 301 | ;=> "Map is read-only" 302 | 303 | (try (dissoc read-only-m :a) (catch Exception e (.getMessage e))) 304 | ;=> "Map is read-only" 305 | 306 | ;; Transient operations also fail if overridden 307 | (try (persistent! (assoc! (transient read-only-m) :c 3)) (catch Exception e (.getMessage e))) 308 | ;=> "Map is read-only" 309 | ``` 310 | 311 | ## 9. Function Call Dispatch 312 | 313 | *Use Case*: Use the map itself as a dispatch mechanism, calling different functions based on arguments passed when the map is invoked. 314 | 315 | *How?*: Override `:invoke-variadic`. 316 | 317 | ```clojure 318 | (defn handle-add [x y] (+ x y)) 319 | (defn handle-multiply [x y] (* x y)) 320 | 321 | (def dispatching-map 322 | (-> {:add-fn handle-add :mul-fn handle-multiply} 323 | (w/assoc 324 | :invoke-variadic 325 | (fn [_ m operation & args] 326 | (case operation 327 | :add (apply (:add-fn m) args) 328 | :multiply (apply (:mul-fn m) args) 329 | (throw (ex-info "Unknown operation" {:operation operation}))))))) 330 | ``` 331 | 332 | ### Example Usage: 333 | 334 | ```clojure 335 | (dispatching-map :add 10 5) ;=> 15 336 | (dispatching-map :multiply 10 5) ;=> 50 337 | 338 | (try (dispatching-map :subtract 10 5) (catch Exception e (ex-data e))) 339 | ;=> {:operation :subtract} 340 | ``` 341 | 342 | ## 10. Access Counting 343 | 344 | *Use Case*: Keep track of how often keys are accessed. 345 | 346 | *How?*: Override `:valAt_k` and `:valAt_k_nf`. Store counts in an atom external to the map. 347 | 348 | ```clojure 349 | (def access-counts (atom {})) 350 | 351 | (def counting-map 352 | (-> (wrap :a 1 :b 2) 353 | (w/assoc 354 | :valAt_k 355 | (fn [_ m k] 356 | (swap! access-counts update k (fnil inc 0)) ; Increment count 357 | (get m k)) 358 | :valAt_k_nf 359 | (fn [_ m k nf] 360 | (swap! access-counts update k (fnil inc 0)) ; Increment count 361 | (get m k nf))))) 362 | ``` 363 | 364 | ### Example Usage: 365 | 366 | ```clojure 367 | (reset! access-counts {}) 368 | (get counting-map :a) ;=> 1 369 | (get counting-map :b) ;=> 2 370 | (get counting-map :a) ;=> 1 371 | (get counting-map :c) ;=> nil 372 | @access-counts 373 | ;=> {:a 2, :b 1, :c 1} 374 | ``` 375 | 376 | ## 11. Transient Validation 377 | 378 | *Use Case*: Perform validation efficiently during batch updates within a `transient`/`persistent!` block. 379 | 380 | *How?*: Override transient impls like `:T_assoc_k_v`. 381 | 382 | ```clojure 383 | (def transiently-validating-map 384 | (-> empty-wrap 385 | (vary assoc 386 | :T_assoc_k_v (fn [_ t-m k v] 387 | (if (number? v) 388 | (assoc! t-m k v) 389 | (throw (ex-info "Transient validation failed: Value must be number" {:key k :value v}))))))) 390 | ``` 391 | 392 | ### Example Usage: 393 | 394 | ```clojure 395 | ;; Successful batch update 396 | (persistent! 397 | (-> transiently-validating-map 398 | transient 399 | (assoc! :x 10) 400 | (assoc! :y 20))) 401 | ;=> {:x 10, :y 20} 402 | 403 | (try 404 | (persistent! 405 | (-> transiently-validating-map 406 | transient 407 | (assoc! :x 10) 408 | (assoc! :y "not a number"))) ; This will throw 409 | (catch Exception e (ex-data e))) 410 | ;=> {:key :y, :value "not a number"} 411 | ``` 412 | 413 | ## 12. Custom String Representation 414 | 415 | *Use Case*: Control how the map is printed or converted to a string, perhaps hiding sensitive data or providing a summary. 416 | 417 | *How?*: Override `:print-method_writer` and `:toString`. 418 | 419 | ```clojure 420 | (def sanitizing-string-map 421 | (-> (wrap :user "secret-user" :id 123 :data [1 2 3]) 422 | (w/assoc 423 | :print-method_writer 424 | (fn [_ m w] 425 | (doto w 426 | (.write ""))) 429 | :toString 430 | (fn [_ m] 431 | (str ""))))) 432 | ``` 433 | 434 | ### Example Usage: 435 | 436 | ```clojure 437 | (str sanitizing-string-map) 438 | ;=> "" 439 | 440 | (println sanitizing-string-map) 441 | ; 442 | ``` 443 | -------------------------------------------------------------------------------- /src/com/jolygon/wrap_map.cljc: -------------------------------------------------------------------------------- 1 | (ns com.jolygon.wrap-map 2 | "Public API for creating and manipulating wrap map instances. 3 | 4 | Provides functions to: 5 | - Create WrapMaps (`wrap`, `empty-wrap`). 6 | - Manage implementation overrides (`vary`). 7 | - Add behaviors (`assoc`). 8 | - Return the underlying persistent hash map (`unwrap`). 9 | - Freeze maps to prevent further implementation changes (`freeze`)." 10 | (:refer-clojure :exclude [assoc]) 11 | (:require 12 | [com.jolygon.wrap-map.api-0 :as w])) 13 | 14 | (def empty-wrap 15 | "A pre-defined empty WrapMap instance with no overrides." 16 | (w/make-wrap)) 17 | 18 | (def ^{:doc "Creates a new wrap map instance containing the supplied key-value pairs. 19 | 20 | Accepts either: 21 | - A single argument `m` which is an existing map to wrap. 22 | - A variadic list of key-value arguments `k1 v1 k2 v2 ...`. 23 | 24 | If any keys in the key-value list are equal, they are handled as if by 25 | repeated uses of `clojure.core/assoc` on the underlying map." 26 | :arglists '([& kvs])} 27 | wrap w/wrap) 28 | 29 | (def ^{:doc "Returns a 'frozen' version of the wrap map `coll`. 30 | 31 | A frozen wrap map prevents further modification of its implementation 32 | overrides environment via functions like `w/assoc`, `assoc-impl`, 33 | or `vary`. Attempts to modify the implementations of a frozen map 34 | will throw an exception." 35 | :arglists '([coll])} 36 | freeze w/freeze) 37 | 38 | (def ^{:doc "Applies function `afn` to the current implementation overrides 39 | environment of the WrapMap `coll`, passing `args` as additional arguments 40 | to `afn`. 41 | 42 | `afn` should take the current Impl environment map as its first argument 43 | and return the new environment map to be used. 44 | 45 | If `coll` is not already a wrap map, it will be implicitly wrapped using 46 | `(wrap coll)` before applying `afn`. 47 | 48 | Returns a new wrap map variant with the implementations resulting from `afn`." 49 | :arglists '([coll afn & args])} 50 | vary w/vary) 51 | 52 | (def ^{:doc "Returns the underlying persistent data collection being wrapped." 53 | :arglists '([coll])} 54 | unwrap w/unwrap) 55 | 56 | ;; High Level API 57 | 58 | (def ^{:doc "Associates behavior overrides on a map `coll`. 59 | 60 | Takes the map `coll` followed by key-value pairs where the key is a 61 | behavior keyword (e.g., :get, :assoc, :dissoc, :contains?, :invoke, :print) 62 | and the value is the corresponding handler function. 63 | 64 | Args: 65 | behavior key A keyword identifying the behavior to override 66 | (:get, :assoc, :dissoc, :contains?, :invoke, :print, or 67 | a raw implementation key). 68 | handler fn The function to handle the specified behavior. Its expected 69 | signature depends on `behavior-key`: 70 | - :get: `(fn [underlying-map k] ...)` or 71 | `(fn [underlying-map k not-found] ...)` - the wrapper 72 | will try to call the matching arity. 73 | - :assoc: `(fn [underlying-map k v] new-underlying-map)` 74 | - :dissoc: `(fn [underlying-map k] new-underlying-map)` 75 | - :contains?: `(fn [underlying-map k] boolean)` 76 | - :invoke: `(fn [underlying-map & args] ...)` 77 | - :print: `(fn [underlying-map] string-representation)` 78 | - Raw key: Depends on the specific low-level key contract. 79 | 80 | Example: 81 | (assoc my-wrap-map 82 | :get (fn [m k] (str \"Got: \" (clojure.core/get m k))) 83 | :assoc (fn [m k v] (clojure.core/assoc m (keyword k) (str v)))) 84 | 85 | Returns a new wrap map variant with the specified behaviors associated." 86 | :arglists '([coll & {:as e}])} 87 | assoc w/assoc) 88 | -------------------------------------------------------------------------------- /src/com/jolygon/wrap_map/api_0.cljc: -------------------------------------------------------------------------------- 1 | (ns com.jolygon.wrap-map.api-0 2 | (:refer-clojure :exclude [assoc dissoc]) 3 | (:require 4 | [com.jolygon.wrap-map.api-0.common :as wc] 5 | [com.jolygon.wrap-map.api-0.impl :as mi])) 6 | 7 | (defn make-wrap 8 | "Internal raw constructor for WrapMap. Creates a WrapMap instance 9 | directly from the underlying collection `m` and environment map 10 | `e`. Does NOT perform the internal preparation step (like 11 | ensuring default-invoke). Prefer `com.jolygon.wrap-map/wrap` 12 | for general use." 13 | ([] (make-wrap {} {})) 14 | ([m] 15 | (make-wrap {} m)) 16 | ([e m] 17 | (mi/wrap-map* (mi/map->Impls e) m))) 18 | 19 | (def empty-wrap (make-wrap)) 20 | 21 | (defn wrap 22 | "keyval => key val 23 | Returns a new wrap-map with supplied mappings. If any keys are 24 | equal, they are handled as if by repeated uses of assoc." 25 | [& kvs] 26 | (if (= 1 (count kvs)) 27 | (make-wrap (first kvs)) 28 | (make-wrap (apply hash-map kvs)))) 29 | 30 | (defn freeze 31 | [coll] 32 | (wc/-freeze coll)) 33 | 34 | (defn contains-impl? 35 | [coll k] 36 | (wc/-contains-impl? coll k)) 37 | 38 | (defn get-impl 39 | [coll k] 40 | (wc/-impl coll k)) 41 | 42 | (defn get-impls 43 | [coll] 44 | (wc/-get-impls coll)) 45 | 46 | (defn with-wrap 47 | [coll new-impls] 48 | (if-not (satisfies? wc/IWrapAssociative coll) 49 | (with-wrap (wrap coll) new-impls) 50 | (wc/-with-wrap coll new-impls))) 51 | 52 | (defn vary 53 | [coll afn & args] 54 | (if-not (satisfies? wc/IWrapAssociative coll) 55 | (apply vary (wrap coll) afn args) 56 | (wc/-vary coll afn args))) 57 | 58 | (defn unwrap 59 | [coll] 60 | (wc/-unwrap coll)) 61 | 62 | (defn dissoc-impl 63 | [coll & ks] 64 | (if-not (satisfies? wc/IWrapAssociative coll) ;; <- should never actually be true 65 | (apply dissoc-impl (wrap coll) ks) 66 | (->> ks 67 | (reduce (fn [c k] 68 | (wc/-dissoc-impl c k)) 69 | coll)))) 70 | 71 | (defn assoc-impl 72 | [coll & kvs] 73 | (if-not (satisfies? wc/IWrapAssociative coll) 74 | (apply assoc-impl (wrap coll) kvs) 75 | (->> kvs 76 | (partition 2) 77 | (reduce (fn [c [k v]] 78 | (wc/-assoc-impl c k v)) 79 | coll)))) 80 | 81 | ;; High Level API 82 | 83 | (defn p-assoc [pm behavior-key handler-fn] 84 | (case behavior-key 85 | :get 86 | (let [internal-get (fn [_e m k] (handler-fn m k)) 87 | internal-get-nf (fn [_e m k nf] (handler-fn m k nf))] 88 | (assoc-impl pm 89 | :invoke-variadic (fn invoke-variadic 90 | ([_e m k] 91 | (handler-fn m k)) 92 | ([_e m k nf] 93 | (handler-fn m k nf))) 94 | #?@(:clj [:valAt_k internal-get 95 | :valAt_k_nf internal-get-nf 96 | :T_valAt_k internal-get ;; <- get can handle both persistent and transient 97 | :T_valAt_k_nf internal-get-nf] 98 | :cljs [:-lookup_k internal-get 99 | :-lookup_k_nf internal-get-nf 100 | :T-lookup_k internal-get 101 | :T-lookup_k_nf internal-get-nf]))) 102 | :assoc 103 | (let [internal-assoc (fn [e m k v] 104 | (let [new-m (handler-fn m k v)] 105 | (make-wrap e new-m)))] 106 | (assoc-impl pm 107 | #?@(:clj [:assoc_k_v internal-assoc] 108 | :cljs [:-assoc_k_v internal-assoc]))) 109 | :dissoc 110 | (let [internal-dissoc (fn [e m k] 111 | (let [new-m (handler-fn m k)] 112 | (make-wrap e new-m)))] 113 | (assoc-impl pm 114 | #?@(:clj [:without_k internal-dissoc] 115 | :cljs [:-dissoc_k internal-dissoc]))) 116 | :contains? 117 | (let [internal-contains (fn [_e m k] (handler-fn m k))] 118 | (assoc-impl pm 119 | #?@(:clj [:containsKey_k internal-contains] 120 | :cljs [:-contains-key?_k internal-contains]))) 121 | :invoke 122 | (let [internal-invoke (fn [_e m & args] (apply handler-fn m args))] 123 | (assoc-impl pm :invoke-variadic internal-invoke)) 124 | 125 | :print 126 | (let [internal-to-string (fn [_e m] 127 | (handler-fn m)) 128 | internal-pr-writer (fn [_e m writer & [_opts]] 129 | (let [s ^String (handler-fn m)] 130 | #?(:clj (.write ^java.io.Writer writer s) 131 | :cljs (cljs.core/-write writer s))))] 132 | (assoc-impl pm 133 | :toString internal-to-string 134 | #?@(:clj [:print-method_writer internal-pr-writer] 135 | :cljs [:-pr-writer_writer_opts internal-pr-writer]))) 136 | ;; :transient 137 | :assoc! 138 | (let [T_internal-assoc (fn [_e m k v] 139 | (handler-fn m k v))] 140 | (assoc-impl pm 141 | #?@(:clj [:T_assoc_k_v T_internal-assoc] 142 | :cljs [:T_-assoc_k_v T_internal-assoc]))) 143 | 144 | :dissoc! 145 | (let [T_internal-dissoc (fn [_e m k] 146 | (handler-fn m k))] 147 | (assoc-impl pm 148 | #?@(:clj [:T_without_k T_internal-dissoc] 149 | :cljs [:T_-dissoc!_k T_internal-dissoc]))) 150 | ; default 151 | (assoc-impl pm behavior-key handler-fn))) 152 | 153 | (defn assoc [coll & {:as e}] 154 | (reduce-kv (fn [pm k handler] (p-assoc pm k handler)) coll e)) 155 | 156 | (defn p-dissoc [pm behavior-key] 157 | (case behavior-key 158 | :get (dissoc-impl pm #?@(:clj [:valAt_k :valAt_k_nf] 159 | :cljs [:-lookup_k :-lookup_k_nf])) 160 | :assoc (dissoc-impl pm #?(:clj :assoc_k_v :cljs :-assoc_k_v)) 161 | :assoc! (dissoc-impl pm #?(:clj :T_assoc_k_v :cljs :T_-assoc_k_v)) 162 | :dissoc (dissoc-impl pm #?(:clj :without_k :cljs :-dissoc_k)) 163 | :dissoc! (dissoc-impl pm #?(:clj :T_without_k :cljs :T_-dissoc_k)) 164 | :contains? (dissoc-impl pm #?(:clj :containsKey_k :cljs :-contains-key?_k)) 165 | :invoke (dissoc-impl pm :invoke-variadic) 166 | (dissoc-impl pm behavior-key))) 167 | 168 | (defn dissoc [coll & ks] 169 | (reduce (fn [pm k] (p-dissoc pm k)) coll ks)) 170 | -------------------------------------------------------------------------------- /src/com/jolygon/wrap_map/api_0/common.cljc: -------------------------------------------------------------------------------- 1 | (ns com.jolygon.wrap-map.api-0.common 2 | (:refer-clojure :exclude [count empty seq iterator get assoc dissoc meta reduce]) 3 | (:require 4 | [clojure.core :as c])) 5 | 6 | (defn ^:private default-map-invoke 7 | "Default IFn invoke behavior for WrapMap when no custom :invoke-variadic 8 | is provided. Mimics standard map lookup behavior: (map key) looks up key (arity 1), 9 | (map key nf) provides default (arity 2). Throws exceptions for all 10 | other arities (0, 3+)." 11 | ;; Arity 0: Invalid for map lookup 12 | ([_ _m] 13 | (throw (ex-info "Invalid arity: 0" 14 | {:error :invalid-arity 15 | :arity 0 16 | :args []}))) 17 | ;; Arity 1: Standard map lookup (key) 18 | ([_ m k] 19 | (c/get m k)) ;; Use aliased c/get 20 | ;; Arity 2: Standard map lookup (key, nf) 21 | ([_ m k nf] 22 | (c/get m k nf)) ;; Use aliased c/get 23 | ;; Arity 3: Invalid for map lookup 24 | ([_ _m a1 a2 a3] 25 | (throw (ex-info "Invalid arity: 3" 26 | {:error :invalid-arity 27 | :arity 3 28 | :args [a1 a2 a3]}))) 29 | ;; Variadic Arity (5+): Invalid for map lookup 30 | ([_ _m a1 a2 a3 a4 & rest-args] 31 | (let [;; Calculate the actual total arity 32 | arity (+ 4 (c/count rest-args)) 33 | ;; Combine all arguments for the error map 34 | all-args (concat [a1 a2 a3 a4] rest-args)] 35 | (throw (ex-info (str "Invalid arity: " arity) 36 | {:error :invalid-arity 37 | :arity arity 38 | :args all-args}))))) 39 | 40 | ;; needs optimization 41 | (defn handle-invoke 42 | "Core IFn invocation handler for WrapMap instances. 43 | Checks for :invoke-variadic in the environment map `e` 44 | and calls it if present with exact arity arguments 45 | (0-20). Otherwise delegates to default-map-invoke with 46 | exact arity arguments. Uses apply only for arity > 20." 47 | ([e m] 48 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 49 | (wrap-invoke e m) 50 | (default-map-invoke e m))) 51 | ([e m a1] 52 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 53 | (wrap-invoke e m a1) 54 | (default-map-invoke e m a1))) 55 | ([e m a1 a2] 56 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 57 | (wrap-invoke e m a1 a2) 58 | (default-map-invoke e m a1 a2))) 59 | ([e m a1 a2 a3] 60 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 61 | (wrap-invoke e m a1 a2 a3) 62 | (default-map-invoke e m a1 a2 a3))) 63 | ([e m a1 a2 a3 a4] 64 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 65 | (wrap-invoke e m a1 a2 a3 a4) 66 | (default-map-invoke e m a1 a2 a3 a4))) 67 | ([e m a1 a2 a3 a4 a5] 68 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 69 | (wrap-invoke e m a1 a2 a3 a4 a5) 70 | (default-map-invoke e m a1 a2 a3 a4 a5))) 71 | ([e m a1 a2 a3 a4 a5 a6] 72 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 73 | (wrap-invoke e m a1 a2 a3 a4 a5 a6) 74 | (default-map-invoke e m a1 a2 a3 a4 a5 a6))) 75 | ([e m a1 a2 a3 a4 a5 a6 a7] 76 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 77 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7) 78 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7))) 79 | ([e m a1 a2 a3 a4 a5 a6 a7 a8] 80 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 81 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8) 82 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8))) 83 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9] 84 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 85 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9) 86 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9))) 87 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] 88 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 89 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9) 90 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))) 91 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11] 92 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 93 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) 94 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11))) 95 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12] 96 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 97 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12) 98 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12))) 99 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13] 100 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 101 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13) 102 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13))) 103 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14] 104 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 105 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) 106 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14))) 107 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15] 108 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 109 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15) 110 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15))) 111 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16] 112 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 113 | (wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16) 114 | (default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16))) 115 | ([e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 & rest-args] 116 | (if-let [wrap-invoke (c/get e :invoke-variadic)] 117 | (apply wrap-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 rest-args) 118 | (apply default-map-invoke e m a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 rest-args)))) 119 | 120 | ;; --- Protocols --- 121 | 122 | (defprotocol IWrapAssociative 123 | "Protocol for managing the environment map ('e') of a persistent wrap map." 124 | (-assoc-impl [coll k v] "Associates impl k with function v in the environment map. Returns new wrap map.") 125 | (-contains-impl? [coll k] "Returns true if impl k exists in the environment map.") 126 | (-impl [coll k] "Returns the function associated with impl k, or nil.") 127 | (-get-impls [coll] "Returns the full persistent environment map.") 128 | (-with-wrap [coll new-impls] "Replaces the entire invironment map. Returns new wrap map.") 129 | (-vary [coll afn args] "Like vary-meta but for the invironment map. Returns new wrap map.") 130 | (-unwrap [coll] "Returns the underlying persistent data collection ('m').") 131 | (-freeze [coll] "Returns a version where `e` cannot be changed.") 132 | (-dissoc-impl [coll k] "Removes impl k from the envionment map. Returns new wrap map.")) 133 | -------------------------------------------------------------------------------- /src/com/jolygon/wrap_map/api_0/impl.cljs: -------------------------------------------------------------------------------- 1 | (ns com.jolygon.wrap-map.api-0.impl 2 | "Internal implementation details for WrapMap (ClojureScript). 3 | Provides the WrapMap and TransientWrapMap deftypes and related protocols. 4 | Users should generally prefer the API functions in 'com.jolygon.wrap-map.api-0' 5 | or subsequent API versions, and use the implementation keys defined in 6 | 'com.jolygon.wrap-map.api-0.common' and 'com.jolygon.wrap-map.api-0.trans.common'. 7 | 8 | This namespace is subject to change." 9 | (:require 10 | [com.jolygon.wrap-map.api-0.common :as wc])) 11 | 12 | ;;---------------------------------------------------------------------- 13 | ;; Transient Implementation 14 | ;;---------------------------------------------------------------------- 15 | 16 | (declare WrapMap WrapMap+-assoc_k_v WrapMap+-lookup_k WrapMap+-assoc_k_v|-lookup_k 17 | ->WrapMap ->WrapMap+-assoc_k_v ->WrapMap+-lookup_k ->WrapMap+-assoc_k_v|-lookup_k 18 | ->TransientWrapMap ->TransientWrapMap+-assoc!_k_v ->TransientWrapMap+-lookup_k 19 | ->TransientWrapMap+-assoc!_k_v|-lookup_k construct) 20 | 21 | (def allowable-impls 22 | #{:frozen? :metadata :this :wrap :twrap :pwrap :<- 23 | :toString :-conj_v :-empty :-dissoc_k :-assoc_k_v :-contains-key?_k 24 | :-find_k :-seq :-meta :withMeta_new-meta :-count :-lookup_k 25 | :-lookup_k_nf :kv-reduce_f_init :T_-conj! :T_-assoc!_k_v :T_-dissoc!_k 26 | :T_-lookup_k :T_-lookup_k_nf :T_-count :invoke :invoke-variadic 27 | :-pr-writer_writer_opts}) 28 | 29 | #_{:clj-kondo/ignore [:shadowed-var]} 30 | (defrecord Impls 31 | [frozen? metadata this wrap twrap pwrap <- 32 | toString -conj_v -empty -dissoc_k -assoc_k_v -contains-key?_k -find_k 33 | -seq -meta withMeta_new-meta -count -lookup_k -lookup_k_nf kv-reduce_f_init 34 | T_-conj! T_-assoc!_k_v T_-dissoc!_k T_-lookup_k T_-lookup_k_nf T_-count 35 | invoke invoke-variadic -pr-writer_writer_opts]) 36 | 37 | (def empty-impls (map->Impls {})) 38 | 39 | (deftype TransientWrapMap [^Impls e ^:mutable ^ITransientMap t_m] 40 | ITransientCollection 41 | (^TransientWrapMap -conj! [this entry] 42 | (if-let [f (.-T_conj_v e)] 43 | (do (set! t_m (f e t_m entry)) 44 | this) 45 | (do (set! t_m (-conj! t_m entry)) 46 | this))) 47 | (^WrapMap -persistent! [_this] 48 | ((.-pwrap e) e ^IPersistentMap (-persistent! t_m))) 49 | ITransientAssociative 50 | (^TransientWrapMap -assoc! [this k v] 51 | (set! t_m (-assoc! t_m k v)) 52 | this) 53 | ITransientMap 54 | (^TransientWrapMap -dissoc! [this k] 55 | (if-let [f (.-T_-dissoc!_k e)] 56 | (do (set! t_m (f e t_m k)) 57 | this) 58 | (do (set! t_m (-dissoc! t_m k)) 59 | this))) 60 | ILookup 61 | (-lookup [_this k] 62 | (-lookup t_m k)) 63 | (-lookup [_this k nf] 64 | (-lookup t_m k nf)) 65 | ICounted 66 | (^number -count [_this] 67 | (if-let [f (.-T_count e)] 68 | (f e t_m) 69 | (-count t_m)))) 70 | 71 | (deftype TransientWrapMap+-assoc!_k_v [^Impls e ^:mutable ^ITransientMap t_m] 72 | ITransientCollection 73 | (^TransientWrapMap+-assoc!_k_v -conj! [this entry] 74 | (if-let [f (.-T_conj_v e)] 75 | (do (set! t_m (f e t_m entry)) 76 | this) 77 | (do (set! t_m (-conj! t_m entry)) 78 | this))) 79 | (^WrapMap -persistent! [_this] 80 | ((.-pwrap e) e ^IPersistentMap (-persistent! t_m))) 81 | ITransientAssociative 82 | (^TransientWrapMap+-assoc!_k_v -assoc! [this k v] 83 | (set! t_m ((.-T_-assoc!_k_v e) e t_m k v)) 84 | this) 85 | ITransientMap 86 | (^TransientWrapMap+-assoc!_k_v -dissoc! [this k] 87 | (if-let [f (.-T_-dissoc!_k e)] 88 | (do (set! t_m (f e t_m k)) 89 | this) 90 | (do (set! t_m (-dissoc! t_m k)) 91 | this))) 92 | ILookup 93 | (-lookup [_this k] 94 | (-lookup t_m k)) 95 | (-lookup [_this k nf] 96 | (-lookup t_m k nf)) 97 | ICounted 98 | (^number -count [_this] 99 | (if-let [f (.-T_count e)] 100 | (f e t_m) 101 | (-count t_m)))) 102 | 103 | (deftype TransientWrapMap+-lookup_k [^Impls e ^:mutable ^ITransientMap t_m] 104 | ITransientCollection 105 | (^TransientWrapMap+-lookup_k -conj! [this entry] 106 | (if-let [f (.-T_conj_v e)] 107 | (do (set! t_m (f e t_m entry)) 108 | this) 109 | (do (set! t_m (-conj! t_m entry)) 110 | this))) 111 | (^WrapMap -persistent! [_this] 112 | ((.-pwrap e) e ^IPersistentMap (-persistent! t_m))) 113 | ITransientAssociative 114 | (^TransientWrapMap+-lookup_k -assoc! [this k v] 115 | (set! t_m (-assoc! t_m k v)) 116 | this) 117 | ITransientMap 118 | (^TransientWrapMap+-lookup_k -dissoc! [this k] 119 | (if-let [f (.-T_-dissoc!_k e)] 120 | (do (set! t_m (f e t_m k)) 121 | this) 122 | (do (set! t_m (-dissoc! t_m k)) 123 | this))) 124 | ILookup 125 | (-lookup [_this k] 126 | ((.-T_-lookup_k e) e t_m k)) 127 | (-lookup [_this k nf] 128 | ((.-T_-lookup_k_nf e) e t_m k nf)) 129 | ICounted 130 | (^number -count [_this] 131 | (if-let [f (.-T_count e)] 132 | (f e t_m) 133 | (-count t_m)))) 134 | 135 | (deftype TransientWrapMap+-assoc!_k_v|-lookup_k [^Impls e ^:mutable ^ITransientMap t_m] 136 | ITransientCollection 137 | (^TransientWrapMap+-assoc!_k_v|-lookup_k -conj! [this entry] 138 | (if-let [f (.-T_conj_v e)] 139 | (do (set! t_m (f e t_m entry)) 140 | this) 141 | (do (set! t_m (-conj! t_m entry)) 142 | this))) 143 | (^WrapMap -persistent! [_this] 144 | ((.-pwrap e) e ^IPersistentMap (-persistent! t_m))) 145 | ITransientAssociative 146 | (^TransientWrapMap+-assoc!_k_v|-lookup_k -assoc! [this k v] 147 | (set! t_m ((.-T_-assoc!_k_v e) e t_m k v)) 148 | this) 149 | ITransientMap 150 | (^TransientWrapMap+-assoc!_k_v|-lookup_k -dissoc! [this k] 151 | (if-let [f (.-T_-dissoc!_k e)] 152 | (do (set! t_m (f e t_m k)) 153 | this) 154 | (do (set! t_m (-dissoc! t_m k)) 155 | this))) 156 | ILookup 157 | (-lookup [_this k] 158 | ((.-T_-lookup_k e) e t_m k)) 159 | (-lookup [_this k nf] 160 | ((.-T_-lookup_k_nf e) e t_m k nf)) 161 | ICounted 162 | (^number -count [_this] 163 | (if-let [f (.-T_count e)] 164 | (f e t_m) 165 | (-count t_m)))) 166 | 167 | ;;---------------------------------------------------------------------- 168 | ;; Persistent Implementation 169 | ;;---------------------------------------------------------------------- 170 | 171 | (deftype WrapMap [^:Impls e ^:IPersistentMap m] 172 | Object 173 | (toString [_this] 174 | (if-let [f (.-toString e)] 175 | (f e m) 176 | (pr-str* m))) 177 | IHash 178 | (-hash [_this] 179 | (-hash m)) 180 | IEquiv 181 | (-equiv [_this other] 182 | (-equiv m other)) 183 | IFn 184 | (-invoke [_this] (apply wc/handle-invoke e m [])) 185 | (-invoke [_this k] (apply wc/handle-invoke e m [k])) 186 | (-invoke [_this k nf] (apply wc/handle-invoke e m [k nf])) 187 | (-invoke [_this a b c] (apply wc/handle-invoke e m [a b c])) 188 | (-invoke [_this a b c d] (apply wc/handle-invoke e m [a b c d])) 189 | (-invoke [_this a b c d e] (apply wc/handle-invoke e m [a b c d e])) 190 | (-invoke [_this a b c d e f] (apply wc/handle-invoke e m [a b c d e f])) 191 | (-invoke [_this a b c d e f g] (apply wc/handle-invoke e m [a b c d e f g])) 192 | (-invoke [_this a b c d e f g h] (apply wc/handle-invoke e m [a b c d e f g h])) 193 | (-invoke [_this a b c d e f g h i] (apply wc/handle-invoke e m [a b c d e f g h i])) 194 | (-invoke [_this a b c d e f g h i j] (apply wc/handle-invoke e m [a b c d e f g h i j])) 195 | (-invoke [_this a b c d e f g h i j k] (apply wc/handle-invoke e m [a b c d e f g h i j k])) 196 | (-invoke [_this a b c d e f g h i j k l] (apply wc/handle-invoke e m [a b c d e f g h i j k l])) 197 | (-invoke [_this a b c d e f g h i j k l m] (apply wc/handle-invoke e m [a b c d e f g h i j k l m])) 198 | (-invoke [_this a b c d e f g h i j k l m n] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n])) 199 | (-invoke [_this a b c d e f g h i j k l m n o] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o])) 200 | (-invoke [_this a b c d e f g h i j k l m n o p] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p])) 201 | (-invoke [_this a b c d e f g h i j k l m n o p q] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q])) 202 | (-invoke [_this a b c d e f g h i j k l m n o p q r] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r])) 203 | (-invoke [_this a b c d e f g h i j k l m n o p q r s] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s])) 204 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s t])) 205 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t the-rest] (apply wc/handle-invoke e m (concat [a b c d e f g h i j k l m n o p q r s t] the-rest))) 206 | ICollection 207 | (^WrapMap -conj [_this entry] 208 | (if-let [f (.--conj_v e)] 209 | (f e m entry) 210 | (WrapMap. e (-conj m entry)))) 211 | IEmptyableCollection 212 | (^WrapMap -empty [_this] 213 | (if-let [f (.--empty e)] 214 | (f e m) 215 | (WrapMap. e (-empty m)))) 216 | IMap 217 | (^WrapMap -dissoc [_this k] 218 | (if-let [f (.--dissoc_k e)] 219 | (f e m k) 220 | (WrapMap. e (-dissoc m k)))) 221 | 222 | IAssociative 223 | (^WrapMap -assoc [_this k v] (WrapMap. e (-assoc m k v))) 224 | 225 | (^boolean -contains-key? [_this k] 226 | (if-let [f (.--contains-key?_k e)] 227 | (f e m k) 228 | (-contains-key? m k))) 229 | IFind 230 | (-find [_this k] 231 | (if-let [f (.--find_k e)] 232 | (f e m k) 233 | (-find m k))) 234 | ISeqable 235 | (-seq [_this] 236 | (if-let [f (.--seq e)] 237 | (f e m) 238 | (-seq m))) 239 | IIterable 240 | IMeta 241 | (-meta [_this] 242 | (if-let [f (.--meta e)] 243 | (f e m) 244 | (.-metadata e))) 245 | IWithMeta 246 | (^WrapMap -with-meta [this ^:IPersistentMap new-meta] 247 | (if-let [f (.-withMeta_meta e)] 248 | (f e m new-meta) 249 | (if (identical? new-meta (.-metadata e)) 250 | this 251 | (WrapMap. (assoc e :metadata new-meta) (with-meta m new-meta))))) 252 | ICounted 253 | (^number -count [_this] 254 | (if-let [f (.-count e)] 255 | (f e m) 256 | (-count m))) 257 | 258 | ILookup 259 | (-lookup [_this k] (-lookup m k)) 260 | (-lookup [_this k nf] (-lookup m k nf)) 261 | 262 | IKVReduce 263 | (-kv-reduce [_this f init] 264 | (if-let [reduce-fn (.-kv-reduce_f_init e)] 265 | (reduce-fn e m f init) 266 | (-kv-reduce m f init))) 267 | wc/IWrapAssociative 268 | (-assoc-impl [_this k v] 269 | (assert (allowable-impls k)) 270 | (if (.-frozen? e) 271 | (throw (ex-info "Cannot associate impl on frozen wrap map" {})) 272 | (construct (map->Impls (assoc e k v)) m))) 273 | (^boolean -contains-impl? [_this k] 274 | (not (nil? (get e k)))) 275 | (-impl [_this k] 276 | (-lookup e k)) 277 | (^IPersistentMap -get-impls [_this] 278 | e) 279 | (-with-wrap [_this ^:IPersistentMap new-impls] 280 | (assert (every? allowable-impls (keys new-impls))) 281 | (if (.-frozen? e) 282 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 283 | (construct (map->Impls new-impls) m))) 284 | (-vary [_this afn args] 285 | (if (.-frozen? e) 286 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 287 | (let [new-impls (apply afn e args)] 288 | (assert (every? allowable-impls (keys new-impls))) 289 | (construct (map->Impls new-impls) m)))) 290 | (^IPersistentMap -unwrap [_this] 291 | m) 292 | (-dissoc-impl [_this k] 293 | (assert (allowable-impls k)) 294 | (if (.-frozen? e) 295 | (throw (ex-info "Cannot disassociate impl on frozen wrap map" {})) 296 | (construct (-dissoc e k) m))) 297 | (-freeze [_this] 298 | (WrapMap. (assoc e :frozen? true) m)) 299 | IEditableCollection 300 | (-as-transient [_this] 301 | ((.-twrap e) e ^IPersistentMap (transient m))) 302 | IPrintWithWriter 303 | (-pr-writer [this writer opts] 304 | (let [m (.-m this) 305 | e (.-e this)] 306 | (if-let [f (.--pr-writer_writer_opts e)] 307 | (f e m writer opts) 308 | #_{:clj-kondo/ignore [:private-call]} 309 | (print-map this pr-writer writer opts))))) 310 | 311 | ;;---------------------------------------------------------------------- 312 | ;; Static Methods / Setup for WrapMap 313 | ;;---------------------------------------------------------------------- 314 | 315 | (set! (.-EMPTY WrapMap) (WrapMap. empty-impls {})) 316 | 317 | (set! (.-fromArray WrapMap) 318 | (fn [arr ^boolean no-clone] 319 | (let [arr (if no-clone arr (.slice arr)) 320 | len (.-length arr)] 321 | (loop [i 0 322 | ret (.asTransient (.-EMPTY WrapMap))] 323 | (if (< i len) 324 | (recur (inc i) (-assoc! ret (aget arr i) (aget arr (inc i)))) 325 | (-persistent! ret)))))) 326 | 327 | ;;---------------------------------------------------------------------- 328 | ;; Persistent Implementation 329 | ;;---------------------------------------------------------------------- 330 | 331 | (deftype WrapMap+-assoc_k_v [^:Impls e ^:IPersistentMap m] 332 | Object 333 | (toString [_this] 334 | (if-let [f (.-toString e)] 335 | (f e m) 336 | (pr-str* m))) 337 | IHash 338 | (-hash [_this] 339 | (-hash m)) 340 | IEquiv 341 | (-equiv [_this other] 342 | (-equiv m other)) 343 | IFn 344 | (-invoke [_this] (apply wc/handle-invoke e m [])) 345 | (-invoke [_this k] (apply wc/handle-invoke e m [k])) 346 | (-invoke [_this k nf] (apply wc/handle-invoke e m [k nf])) 347 | (-invoke [_this a b c] (apply wc/handle-invoke e m [a b c])) 348 | (-invoke [_this a b c d] (apply wc/handle-invoke e m [a b c d])) 349 | (-invoke [_this a b c d e] (apply wc/handle-invoke e m [a b c d e])) 350 | (-invoke [_this a b c d e f] (apply wc/handle-invoke e m [a b c d e f])) 351 | (-invoke [_this a b c d e f g] (apply wc/handle-invoke e m [a b c d e f g])) 352 | (-invoke [_this a b c d e f g h] (apply wc/handle-invoke e m [a b c d e f g h])) 353 | (-invoke [_this a b c d e f g h i] (apply wc/handle-invoke e m [a b c d e f g h i])) 354 | (-invoke [_this a b c d e f g h i j] (apply wc/handle-invoke e m [a b c d e f g h i j])) 355 | (-invoke [_this a b c d e f g h i j k] (apply wc/handle-invoke e m [a b c d e f g h i j k])) 356 | (-invoke [_this a b c d e f g h i j k l] (apply wc/handle-invoke e m [a b c d e f g h i j k l])) 357 | (-invoke [_this a b c d e f g h i j k l m] (apply wc/handle-invoke e m [a b c d e f g h i j k l m])) 358 | (-invoke [_this a b c d e f g h i j k l m n] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n])) 359 | (-invoke [_this a b c d e f g h i j k l m n o] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o])) 360 | (-invoke [_this a b c d e f g h i j k l m n o p] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p])) 361 | (-invoke [_this a b c d e f g h i j k l m n o p q] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q])) 362 | (-invoke [_this a b c d e f g h i j k l m n o p q r] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r])) 363 | (-invoke [_this a b c d e f g h i j k l m n o p q r s] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s])) 364 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s t])) 365 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t the-rest] (apply wc/handle-invoke e m (concat [a b c d e f g h i j k l m n o p q r s t] the-rest))) 366 | ICollection 367 | (^WrapMap+-assoc_k_v -conj [_this entry] 368 | (if-let [f (.--conj_v e)] 369 | (f e m entry) 370 | (WrapMap+-assoc_k_v. e (-conj m entry)))) 371 | IEmptyableCollection 372 | (^WrapMap+-assoc_k_v -empty [_this] 373 | (if-let [f (.--empty e)] 374 | (f e m) 375 | (WrapMap+-assoc_k_v. e (-empty m)))) 376 | IMap 377 | (^WrapMap+-assoc_k_v -dissoc [_this k] 378 | (if-let [f (.--dissoc_k e)] 379 | (f e m k) 380 | (WrapMap+-assoc_k_v. e (-dissoc m k)))) 381 | 382 | IAssociative 383 | (^WrapMap+-assoc_k_v -assoc [_this k v] 384 | ((.--assoc_k_v e) e m k v)) 385 | 386 | (^boolean -contains-key? [_this k] 387 | (if-let [f (.--contains-key?_k e)] 388 | (f e m k) 389 | (-contains-key? m k))) 390 | IFind 391 | (-find [_this k] 392 | (if-let [f (.--find_k e)] 393 | (f e m k) 394 | (-find m k))) 395 | ISeqable 396 | (-seq [_this] 397 | (if-let [f (.--seq e)] 398 | (f e m) 399 | (-seq m))) 400 | IIterable 401 | IMeta 402 | (-meta [_this] 403 | (if-let [f (.--meta e)] 404 | (f e m) 405 | (.-metadata e))) 406 | IWithMeta 407 | (^WrapMap+-assoc_k_v -with-meta [this ^:IPersistentMap new-meta] 408 | (if-let [f (.-withMeta_meta e)] 409 | (f e m new-meta) 410 | (if (identical? new-meta (.-metadata e)) 411 | this 412 | (WrapMap+-assoc_k_v. (assoc e :metadata new-meta) (with-meta m new-meta))))) 413 | ICounted 414 | (^number -count [_this] 415 | (if-let [f (.-count e)] 416 | (f e m) 417 | (-count m))) 418 | ILookup 419 | (-lookup [_this k] 420 | (-lookup m k)) 421 | (-lookup [_this k nf] 422 | (-lookup m k nf)) 423 | IKVReduce 424 | (-kv-reduce [_this f init] 425 | (if-let [reduce-fn (.-kv-reduce_f_init e)] 426 | (reduce-fn e m f init) 427 | (-kv-reduce m f init))) 428 | wc/IWrapAssociative 429 | (-assoc-impl [_this k v] 430 | (assert (allowable-impls k)) 431 | (if (.-frozen? e) 432 | (throw (ex-info "Cannot associate impl on frozen wrap map" {})) 433 | (construct (map->Impls (assoc e k v)) m))) 434 | (^boolean -contains-impl? [_this k] 435 | (not (nil? (get e k)))) 436 | (-impl [_this k] 437 | (-lookup e k)) 438 | (^IPersistentMap -get-impls [_this] 439 | e) 440 | (-with-wrap [_this ^:IPersistentMap new-impls] 441 | (assert (every? allowable-impls (keys new-impls))) 442 | (if (.-frozen? e) 443 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 444 | (construct (map->Impls new-impls) m))) 445 | (-vary [_this afn args] 446 | (if (.-frozen? e) 447 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 448 | (let [new-impls (apply afn e args)] 449 | (assert (every? allowable-impls (keys new-impls))) 450 | (construct (map->Impls new-impls) m)))) 451 | (^IPersistentMap -unwrap [_this] 452 | m) 453 | (-dissoc-impl [_this k] 454 | (assert (allowable-impls k)) 455 | (if (.-frozen? e) 456 | (throw (ex-info "Cannot disassociate impl on frozen wrap map" {})) 457 | (construct (-dissoc e k) m))) 458 | (-freeze [_this] 459 | (WrapMap+-assoc_k_v. (assoc e :frozen? true) m)) 460 | IEditableCollection 461 | (-as-transient [_this] 462 | ((.-twrap e) e ^IPersistentMap (transient m))) 463 | IPrintWithWriter 464 | (-pr-writer [this writer opts] 465 | (let [m (.-m this) 466 | e (.-e this)] 467 | (if-let [f (.--pr-writer_writer_opts e)] 468 | (f e m writer opts) 469 | #_{:clj-kondo/ignore [:private-call]} 470 | (print-map this pr-writer writer opts))))) 471 | 472 | ;;---------------------------------------------------------------------- 473 | ;; Static Methods / Setup for WrapMap 474 | ;;---------------------------------------------------------------------- 475 | 476 | (set! (.-EMPTY WrapMap+-assoc_k_v) (WrapMap+-assoc_k_v. empty-impls {})) 477 | 478 | (set! (.-fromArray WrapMap+-assoc_k_v) 479 | (fn [arr ^boolean no-clone] 480 | (let [arr (if no-clone arr (.slice arr)) 481 | len (.-length arr)] 482 | (loop [i 0 483 | ret (.asTransient (.-EMPTY WrapMap+-assoc_k_v))] 484 | (if (< i len) 485 | (recur (inc i) (-assoc! ret (aget arr i) (aget arr (inc i)))) 486 | (-persistent! ret)))))) 487 | 488 | ;;---------------------------------------------------------------------- 489 | ;; Persistent Implementation 490 | ;;---------------------------------------------------------------------- 491 | 492 | (deftype WrapMap+-lookup_k [^:Impls e ^:IPersistentMap m] 493 | Object 494 | (toString [_this] 495 | (if-let [f (.-toString e)] 496 | (f e m) 497 | (pr-str* m))) 498 | IHash 499 | (-hash [_this] 500 | (-hash m)) 501 | IEquiv 502 | (-equiv [_this other] 503 | (-equiv m other)) 504 | IFn 505 | (-invoke [_this] (apply wc/handle-invoke e m [])) 506 | (-invoke [_this k] (apply wc/handle-invoke e m [k])) 507 | (-invoke [_this k nf] (apply wc/handle-invoke e m [k nf])) 508 | (-invoke [_this a b c] (apply wc/handle-invoke e m [a b c])) 509 | (-invoke [_this a b c d] (apply wc/handle-invoke e m [a b c d])) 510 | (-invoke [_this a b c d e] (apply wc/handle-invoke e m [a b c d e])) 511 | (-invoke [_this a b c d e f] (apply wc/handle-invoke e m [a b c d e f])) 512 | (-invoke [_this a b c d e f g] (apply wc/handle-invoke e m [a b c d e f g])) 513 | (-invoke [_this a b c d e f g h] (apply wc/handle-invoke e m [a b c d e f g h])) 514 | (-invoke [_this a b c d e f g h i] (apply wc/handle-invoke e m [a b c d e f g h i])) 515 | (-invoke [_this a b c d e f g h i j] (apply wc/handle-invoke e m [a b c d e f g h i j])) 516 | (-invoke [_this a b c d e f g h i j k] (apply wc/handle-invoke e m [a b c d e f g h i j k])) 517 | (-invoke [_this a b c d e f g h i j k l] (apply wc/handle-invoke e m [a b c d e f g h i j k l])) 518 | (-invoke [_this a b c d e f g h i j k l m] (apply wc/handle-invoke e m [a b c d e f g h i j k l m])) 519 | (-invoke [_this a b c d e f g h i j k l m n] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n])) 520 | (-invoke [_this a b c d e f g h i j k l m n o] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o])) 521 | (-invoke [_this a b c d e f g h i j k l m n o p] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p])) 522 | (-invoke [_this a b c d e f g h i j k l m n o p q] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q])) 523 | (-invoke [_this a b c d e f g h i j k l m n o p q r] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r])) 524 | (-invoke [_this a b c d e f g h i j k l m n o p q r s] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s])) 525 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s t])) 526 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t the-rest] (apply wc/handle-invoke e m (concat [a b c d e f g h i j k l m n o p q r s t] the-rest))) 527 | ICollection 528 | (^WrapMap+-lookup_k -conj [_this entry] 529 | (if-let [f (.--conj_v e)] 530 | (f e m entry) 531 | (WrapMap+-lookup_k. e (-conj m entry)))) 532 | IEmptyableCollection 533 | (^WrapMap+-lookup_k -empty [_this] 534 | (if-let [f (.--empty e)] 535 | (f e m) 536 | (WrapMap+-lookup_k. e (-empty m)))) 537 | IMap 538 | (^WrapMap+-lookup_k -dissoc [_this k] 539 | (if-let [f (.--dissoc_k e)] 540 | (f e m k) 541 | (WrapMap+-lookup_k. e (-dissoc m k)))) 542 | IAssociative 543 | (^WrapMap+-lookup_k -assoc [_this k v] 544 | (WrapMap+-lookup_k. e (-assoc m k v))) 545 | (^boolean -contains-key? [_this k] 546 | (if-let [f (.--contains-key?_k e)] 547 | (f e m k) 548 | (-contains-key? m k))) 549 | IFind 550 | (-find [_this k] 551 | (if-let [f (.--find_k e)] 552 | (f e m k) 553 | (-find m k))) 554 | ISeqable 555 | (-seq [_this] 556 | (if-let [f (.--seq e)] 557 | (f e m) 558 | (-seq m))) 559 | IIterable 560 | IMeta 561 | (-meta [_this] 562 | (if-let [f (.--meta e)] 563 | (f e m) 564 | (.-metadata e))) 565 | IWithMeta 566 | (^WrapMap+-lookup_k -with-meta [this ^:IPersistentMap new-meta] 567 | (if-let [f (.-withMeta_meta e)] 568 | (f e m new-meta) 569 | (if (identical? new-meta (.-metadata e)) 570 | this 571 | (WrapMap+-lookup_k. (assoc e :metadata new-meta) (with-meta m new-meta))))) 572 | ICounted 573 | (^number -count [_this] 574 | (if-let [f (.-count e)] 575 | (f e m) 576 | (-count m))) 577 | ILookup 578 | (-lookup [_this k] 579 | ((.--lookup_k e) e m k)) 580 | (-lookup [_this k nf] 581 | ((.--lookup_k_nf e) e m k nf)) 582 | IKVReduce 583 | (-kv-reduce [_this f init] 584 | (if-let [reduce-fn (.-kv-reduce_f_init e)] 585 | (reduce-fn e m f init) 586 | (-kv-reduce m f init))) 587 | wc/IWrapAssociative 588 | (-assoc-impl [_this k v] 589 | (assert (allowable-impls k)) 590 | (if (.-frozen? e) 591 | (throw (ex-info "Cannot associate impl on frozen wrap map" {})) 592 | (construct (map->Impls (assoc e k v)) m))) 593 | (^boolean -contains-impl? [_this k] 594 | (not (nil? (get e k)))) 595 | (-impl [_this k] 596 | (-lookup e k)) 597 | (^IPersistentMap -get-impls [_this] 598 | e) 599 | (-with-wrap [_this ^:IPersistentMap new-impls] 600 | (assert (every? allowable-impls (keys new-impls))) 601 | (if (.-frozen? e) 602 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 603 | (construct (map->Impls new-impls) m))) 604 | (-vary [_this afn args] 605 | (if (.-frozen? e) 606 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 607 | (let [new-impls (apply afn e args)] 608 | (assert (every? allowable-impls (keys new-impls))) 609 | (construct (map->Impls new-impls) m)))) 610 | (^IPersistentMap -unwrap [_this] 611 | m) 612 | (-dissoc-impl [_this k] 613 | (assert (allowable-impls k)) 614 | (if (.-frozen? e) 615 | (throw (ex-info "Cannot disassociate impl on frozen wrap map" {})) 616 | (construct (-dissoc e k) m))) 617 | (-freeze [_this] 618 | (WrapMap+-lookup_k. (assoc e :frozen? true) m)) 619 | IEditableCollection 620 | (-as-transient [_this] 621 | ((.-twrap e) e ^IPersistentMap (transient m))) 622 | IPrintWithWriter 623 | (-pr-writer [this writer opts] 624 | (let [m (.-m this) 625 | e (.-e this)] 626 | (if-let [f (.--pr-writer_writer_opts e)] 627 | (f e m writer opts) 628 | #_{:clj-kondo/ignore [:private-call]} 629 | (print-map this pr-writer writer opts))))) 630 | 631 | ;;---------------------------------------------------------------------- 632 | ;; Static Methods / Setup for WrapMap 633 | ;;---------------------------------------------------------------------- 634 | 635 | (set! (.-EMPTY WrapMap) (WrapMap+-lookup_k. empty-impls {})) 636 | 637 | (set! (.-fromArray WrapMap+-lookup_k) 638 | (fn [arr ^boolean no-clone] 639 | (let [arr (if no-clone arr (.slice arr)) 640 | len (.-length arr)] 641 | (loop [i 0 642 | ret (.asTransient (.-EMPTY WrapMap+-lookup_k))] 643 | (if (< i len) 644 | (recur (inc i) (-assoc! ret (aget arr i) (aget arr (inc i)))) 645 | (-persistent! ret)))))) 646 | 647 | ;;---------------------------------------------------------------------- 648 | ;; Persistent Implementation 649 | ;;---------------------------------------------------------------------- 650 | 651 | (deftype WrapMap+-assoc_k_v|-lookup_k [^:Impls e ^:IPersistentMap m] 652 | Object 653 | (toString [_this] 654 | (if-let [f (.-toString e)] 655 | (f e m) 656 | (pr-str* m))) 657 | IHash 658 | (-hash [_this] 659 | (-hash m)) 660 | IEquiv 661 | (-equiv [_this other] 662 | (-equiv m other)) 663 | IFn 664 | (-invoke [_this] (apply wc/handle-invoke e m [])) 665 | (-invoke [_this k] (apply wc/handle-invoke e m [k])) 666 | (-invoke [_this k nf] (apply wc/handle-invoke e m [k nf])) 667 | (-invoke [_this a b c] (apply wc/handle-invoke e m [a b c])) 668 | (-invoke [_this a b c d] (apply wc/handle-invoke e m [a b c d])) 669 | (-invoke [_this a b c d e] (apply wc/handle-invoke e m [a b c d e])) 670 | (-invoke [_this a b c d e f] (apply wc/handle-invoke e m [a b c d e f])) 671 | (-invoke [_this a b c d e f g] (apply wc/handle-invoke e m [a b c d e f g])) 672 | (-invoke [_this a b c d e f g h] (apply wc/handle-invoke e m [a b c d e f g h])) 673 | (-invoke [_this a b c d e f g h i] (apply wc/handle-invoke e m [a b c d e f g h i])) 674 | (-invoke [_this a b c d e f g h i j] (apply wc/handle-invoke e m [a b c d e f g h i j])) 675 | (-invoke [_this a b c d e f g h i j k] (apply wc/handle-invoke e m [a b c d e f g h i j k])) 676 | (-invoke [_this a b c d e f g h i j k l] (apply wc/handle-invoke e m [a b c d e f g h i j k l])) 677 | (-invoke [_this a b c d e f g h i j k l m] (apply wc/handle-invoke e m [a b c d e f g h i j k l m])) 678 | (-invoke [_this a b c d e f g h i j k l m n] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n])) 679 | (-invoke [_this a b c d e f g h i j k l m n o] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o])) 680 | (-invoke [_this a b c d e f g h i j k l m n o p] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p])) 681 | (-invoke [_this a b c d e f g h i j k l m n o p q] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q])) 682 | (-invoke [_this a b c d e f g h i j k l m n o p q r] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r])) 683 | (-invoke [_this a b c d e f g h i j k l m n o p q r s] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s])) 684 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t] (apply wc/handle-invoke e m [a b c d e f g h i j k l m n o p q r s t])) 685 | (-invoke [_this a b c d e f g h i j k l m n o p q r s t the-rest] (apply wc/handle-invoke e m (concat [a b c d e f g h i j k l m n o p q r s t] the-rest))) 686 | ICollection 687 | (^WrapMap+-assoc_k_v|-lookup_k -conj [_this entry] 688 | (if-let [f (.--conj_v e)] 689 | (f e m entry) 690 | (WrapMap+-assoc_k_v|-lookup_k. e (-conj m entry)))) 691 | IEmptyableCollection 692 | (^WrapMap+-assoc_k_v|-lookup_k -empty [_this] 693 | (if-let [f (.--empty e)] 694 | (f e m) 695 | (WrapMap+-assoc_k_v|-lookup_k. e (-empty m)))) 696 | IMap 697 | (^WrapMap+-assoc_k_v|-lookup_k -dissoc [_this k] 698 | (if-let [f (.--dissoc_k e)] 699 | (f e m k) 700 | (WrapMap+-assoc_k_v|-lookup_k. e (-dissoc m k)))) 701 | IAssociative 702 | (^WrapMap+-assoc_k_v|-lookup_k -assoc [_this k v] 703 | ((.--assoc_k_v e) e m k v)) 704 | (^boolean -contains-key? [_this k] 705 | (if-let [f (.--contains-key?_k e)] 706 | (f e m k) 707 | (-contains-key? m k))) 708 | IFind 709 | (-find [_this k] 710 | (if-let [f (.--find_k e)] 711 | (f e m k) 712 | (-find m k))) 713 | ISeqable 714 | (-seq [_this] 715 | (if-let [f (.--seq e)] 716 | (f e m) 717 | (-seq m))) 718 | IIterable 719 | IMeta 720 | (-meta [_this] 721 | (if-let [f (.--meta e)] 722 | (f e m) 723 | (.-metadata e))) 724 | IWithMeta 725 | (^WrapMap+-assoc_k_v|-lookup_k -with-meta [this ^:IPersistentMap new-meta] 726 | (if-let [f (.-withMeta_meta e)] 727 | (f e m new-meta) 728 | (if (identical? new-meta (.-metadata e)) 729 | this 730 | (WrapMap+-assoc_k_v|-lookup_k. (assoc e :metadata new-meta) (with-meta m new-meta))))) 731 | ICounted 732 | (^number -count [_this] 733 | (if-let [f (.-count e)] 734 | (f e m) 735 | (-count m))) 736 | ILookup 737 | (-lookup [_this k] 738 | ((.--lookup_k e) e m k)) 739 | (-lookup [_this k nf] 740 | ((.--lookup_k_nf e) e m k nf)) 741 | IKVReduce 742 | (-kv-reduce [_this f init] 743 | (if-let [reduce-fn (.-kv-reduce_f_init e)] 744 | (reduce-fn e m f init) 745 | (-kv-reduce m f init))) 746 | wc/IWrapAssociative 747 | (-assoc-impl [_this k v] 748 | (assert (allowable-impls k)) 749 | (if (.-frozen? e) 750 | (throw (ex-info "Cannot associate impl on frozen wrap map" {})) 751 | (construct (map->Impls (assoc e k v)) m))) 752 | (^boolean -contains-impl? [_this k] 753 | (not (nil? (get e k)))) 754 | (-impl [_this k] 755 | (-lookup e k)) 756 | (^IPersistentMap -get-impls [_this] 757 | e) 758 | (-with-wrap [_this ^:IPersistentMap new-impls] 759 | (assert (every? allowable-impls (keys new-impls))) 760 | (if (.-frozen? e) 761 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 762 | (construct (map->Impls new-impls) m))) 763 | (-vary [_this afn args] 764 | (if (.-frozen? e) 765 | (throw (ex-info "Cannot set impls on frozen wrap map" {})) 766 | (let [new-impls (apply afn e args)] 767 | (assert (every? allowable-impls (keys new-impls))) 768 | (construct (map->Impls new-impls) m)))) 769 | (^IPersistentMap -unwrap [_this] 770 | m) 771 | (-dissoc-impl [_this k] 772 | (assert (allowable-impls k)) 773 | (if (.-frozen? e) 774 | (throw (ex-info "Cannot disassociate impl on frozen wrap map" {})) 775 | (construct (-dissoc e k) m))) 776 | (-freeze [_this] 777 | (WrapMap+-assoc_k_v|-lookup_k. (assoc e :frozen? true) m)) 778 | IEditableCollection 779 | (-as-transient [_this] 780 | ((.-twrap e) e ^IPersistentMap (transient m))) 781 | IPrintWithWriter 782 | (-pr-writer [this writer opts] 783 | (let [m (.-m this) 784 | e (.-e this)] 785 | (if-let [f (.--pr-writer_writer_opts e)] 786 | (f e m writer opts) 787 | #_{:clj-kondo/ignore [:private-call]} 788 | (print-map this pr-writer writer opts))))) 789 | 790 | ;;---------------------------------------------------------------------- 791 | ;; Static Methods / Setup for WrapMap 792 | ;;---------------------------------------------------------------------- 793 | 794 | (set! (.-EMPTY WrapMap+-assoc_k_v|-lookup_k) (WrapMap+-assoc_k_v|-lookup_k. empty-impls {})) 795 | 796 | (set! (.-fromArray WrapMap) 797 | (fn [arr ^boolean no-clone] 798 | (let [arr (if no-clone arr (.slice arr)) 799 | len (.-length arr)] 800 | (loop [i 0 801 | ret (.asTransient (.-EMPTY WrapMap+-assoc_k_v|-lookup_k))] 802 | (if (< i len) 803 | (recur (inc i) (-assoc! ret (aget arr i) (aget arr (inc i)))) 804 | (-persistent! ret)))))) 805 | 806 | (defn get-wrap-persistent [e] 807 | (let [-assoc_k_v? (.--assoc_k_v e) 808 | -lookup_k? (.--lookup_k e) 809 | -lookup_k_nf? (.--lookup_k_nf e)] 810 | (if (and -assoc_k_v? (not -lookup_k?)) 811 | ->WrapMap+-assoc_k_v 812 | (if (and -lookup_k? -lookup_k_nf? (not -assoc_k_v?)) 813 | ->WrapMap+-lookup_k 814 | (if (and -assoc_k_v? -lookup_k?) 815 | ->WrapMap+-assoc_k_v|-lookup_k 816 | ->WrapMap))))) 817 | 818 | (defn get-wrap-transient [e] 819 | (if (and (.-T_-assoc!_k_v e) (.-T_-lookup_k e)) 820 | ->TransientWrapMap+-assoc!_k_v|-lookup_k 821 | (if (.-T_-assoc!_k_v e) 822 | ->TransientWrapMap+-assoc!_k_v 823 | (if (.-T_-lookup_k e) 824 | ->TransientWrapMap+-lookup_k 825 | ->TransientWrapMap)))) 826 | 827 | (defn construct [e m & [transient?]] 828 | (if-not (instance? Impls e) 829 | (construct (map->Impls e) m) 830 | (let [pwrap (get-wrap-persistent e) 831 | twrap (get-wrap-transient e) 832 | new-impls (assoc e :<- pwrap :pwrap pwrap :twrap twrap :metadata (meta m))] 833 | (if transient? 834 | (twrap new-impls m) 835 | (pwrap new-impls m))))) 836 | 837 | ;;---------------------------------------------------------------------- 838 | ;; Constructor 839 | ;;---------------------------------------------------------------------- 840 | 841 | (defn wrap-map* 842 | "Internal raw constructor for WrapMap. Creates a WrapMap instance 843 | directly from the underlying collection `m` and environment map 844 | `e`. Does NOT perform the internal preparation step (like 845 | ensuring default-invoke). Prefer `com.jolygon.wrap-map.api-0/wrap` 846 | for general use." 847 | ^WrapMap 848 | ([] (construct empty-impls {})) 849 | ^WrapMap 850 | ([^IPersistentMap m] (construct empty-impls m)) 851 | ^WrapMap 852 | ([^Impls e ^IPersistentMap m] (construct e m))) 853 | -------------------------------------------------------------------------------- /test/com/jolygon/wrap_map/api_0_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.jolygon.wrap-map.api-0-test 2 | (:require 3 | [clojure.test :refer [deftest is]] 4 | [com.jolygon.wrap-map.api-0 :as w :refer [empty-wrap wrap]])) 5 | 6 | (deftest wrap-map-build-test 7 | (is (= (type empty-wrap) (type (wrap)))) 8 | (is (= {:a 1, :b 2} (wrap :a 1, :b 2))) 9 | (is (= {:a 1, :b 2} (wrap :b 2, :a 1))) 10 | (is (= {:a 1, :b 2, :c 3} (wrap :a 1, :b 2, :c 3))) 11 | (is (= {:a 1, :b 2, :c 3} (wrap :c 3, :a 1, :b 2))) 12 | (is (= {:a 1, :b 2, :c 3} (wrap :c 3, :b 2, :a 1))) 13 | (is (= {:a 1, :b 2, :c 3} (wrap :b 2, :c 3, :a 1)))) 14 | 15 | (deftest wrap-map-arity-test 16 | (is (= "clojure.lang.ExceptionInfo: Invalid arity: 0 {:error :invalid-arity, :arity 0, :args []}" 17 | (try ((wrap)) (catch Exception e (str e))))) 18 | (is (= 1 ((wrap :a 1) :a))) 19 | (is (= nil ((wrap :a 1) :b))) 20 | (is (= "clojure.lang.ExceptionInfo: Invalid arity: 3 {:error :invalid-arity, :arity 3, :args [1 2 3]}" 21 | (try ((wrap) 1 2 3) (catch Exception e (str e))))) 22 | (is (= "clojure.lang.ExceptionInfo: Invalid arity: 4 {:error :invalid-arity, :arity 4, :args (1 2 3 4)}" 23 | (try ((wrap) 1 2 3 4) (catch Exception e (str e)))))) 24 | 25 | (deftest wrap-map-assoc-dissoc-test 26 | (is (= {:a 1, :b 2} (assoc (wrap :a 1) :b 2))) 27 | (is (= (type empty-wrap) 28 | (type (assoc (wrap :a 1) :b 2)))) 29 | 30 | (is (= {:a 1} (dissoc (wrap :a 1 :b 2) :b))) 31 | (is (= (type empty-wrap) 32 | (type (dissoc (wrap :a 1 :b 2) :b)))) 33 | 34 | (is (= {:a 1, :b 2} (merge (wrap :a 1) {:b 2}))) 35 | (is (= (type empty-wrap) 36 | (type (merge (wrap :a 1) {:b 2}))))) 37 | 38 | (deftest wrap-map-conj-test 39 | (is (= (conj (wrap) {}) (wrap))) 40 | (is (= (conj (wrap) {:a 1}) (wrap :a 1))) 41 | (is (= (conj (wrap) {:a 1} {:b 2}) (wrap :a 1 :b 2))) 42 | (is (= (conj (wrap) {:a 1} {:b 2 :c 3}) (wrap :a 1 :b 2 :c 3))) 43 | 44 | (is (= (conj (wrap :a 1) {}) (wrap :a 1))) 45 | (is (= (conj (wrap :a 1) {:b 2}) (wrap :a 1 :b 2))) 46 | (is (= (conj (wrap :a 1) {:b 2} {:c 3}) (wrap :a 1 :b 2 :c 3))) 47 | 48 | (is (= (conj (wrap) (first (wrap :a 1))) 49 | (wrap :a 1))) 50 | (is (= (conj (wrap :b 2) (first (wrap :a 1))) 51 | (wrap :a 1 :b 2))) 52 | (is (= (conj (wrap :b 2) (first (wrap :a 1)) (first (wrap :c 3))) 53 | (wrap :a 1 :b 2 :c 3))) 54 | 55 | (is (= (conj (wrap) [:a 1]) 56 | (wrap :a 1))) 57 | (is (= (conj (wrap :b 2) [:a 1]) 58 | (wrap :a 1 :b 2))) 59 | (is (= (conj (wrap :b 2) [:a 1] [:c 3]) 60 | (wrap :a 1 :b 2 :c 3))) 61 | 62 | (is (= (conj (wrap) (wrap nil (wrap))) 63 | (wrap nil (wrap)))) 64 | (is (= (conj (wrap) (wrap (wrap) nil)) 65 | (wrap (wrap) nil))) 66 | (is (= (conj (wrap) (wrap (wrap) (wrap))) 67 | (wrap (wrap) (wrap))))) 68 | 69 | (deftest wrap-map-find-test 70 | (is (= (conj (wrap) {}) (wrap))) 71 | (is (= (find (wrap) :a) nil)) 72 | (is (= (find (wrap :a 1) :a) [:a 1])) 73 | (is (= (find (wrap :a 1) :b) nil)) 74 | (is (= (find (wrap nil 1) nil) [nil 1])) 75 | (is (= (find (wrap :a 1 :b 2) :a) [:a 1])) 76 | (is (= (find (wrap :a 1 :b 2) :b) [:b 2])) 77 | (is (= (find (wrap :a 1 :b 2) :c) nil)) 78 | (is (= (find (wrap) nil) nil)) 79 | (is (= (find (wrap :a 1) nil) nil)) 80 | (is (= (find (wrap :a 1 :b 2) nil) nil))) 81 | 82 | (deftest wrap-map-contains-test 83 | (is (= (contains? (wrap) :a) false)) 84 | (is (= (contains? (wrap) nil) false)) 85 | (is (= (contains? (wrap :a 1) :a) true)) 86 | (is (= (contains? (wrap :a 1) :b) false)) 87 | (is (= (contains? (wrap :a 1) nil) false)) 88 | (is (= (contains? (wrap nil 1) nil) true)) 89 | (is (= (contains? (wrap :a 1 :b 2) :a) true)) 90 | (is (= (contains? (wrap :a 1 :b 2) :b) true)) 91 | (is (= (contains? (wrap :a 1 :b 2) :c) false)) 92 | (is (= (contains? (wrap :a 1 :b 2) nil) false))) 93 | 94 | (deftest wrap-map-keys-vals-test 95 | (is (= (keys (wrap)) nil)) 96 | (is (= (keys (wrap :a 1)) '(:a))) 97 | (is (= (keys (wrap nil 1)) '(nil))) 98 | (is (= (vals (wrap)) nil)) 99 | (is (= (vals (wrap :a 1)) '(1))) 100 | (is (= (vals (wrap nil 1)) '(1)))) 101 | #_{:clj-kondo/ignore [:single-key-in]} 102 | (deftest wrap-map-get-test 103 | (let [m (wrap :a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5})] 104 | (is (= (get m :a) 1)) 105 | (is (= (get m :e) nil)) 106 | (is (= (get m :e 0) 0)) 107 | (is (= (get m nil) {:h 5})) 108 | (is (= (get m :b 0) 2)) 109 | (is (= (get m :f 0) nil)) 110 | (is (= (get-in m [:c :e]) 4)) 111 | (is (= (get-in m '(:c :e)) 4)) 112 | (is (= (get-in m [:c :x]) nil)) 113 | (is (= (get-in m [:f]) nil)) 114 | (is (= (get-in m [:g]) false)) 115 | (is (= (get-in m [:h]) nil)) 116 | (is (= (get-in m []) m)) 117 | (is (= (get-in m nil) m)) 118 | (is (= (get-in m [:c :e] 0) 4)) 119 | (is (= (get-in m '(:c :e) 0) 4)) 120 | (is (= (get-in m [:c :x] 0) 0)) 121 | (is (= (get-in m [:b] 0) 2)) 122 | (is (= (get-in m [:f] 0) nil)) 123 | (is (= (get-in m [:g] 0) false)) 124 | (is (= (get-in m [:h] 0) 0)) 125 | (is (= (get-in m [:x :y] {:y 1}) {:y 1})) 126 | (is (= (get-in m [] 0) m)) 127 | (is (= (get-in m nil 0) m)))) 128 | 129 | (deftest wrap-map-destructure-test 130 | (let [sample-map (wrap :a 1 :b {:a 2}) 131 | {ao1 :a {ai1 :a} :b} sample-map 132 | {ao2 :a {ai2 :a :as _m1} :b :as _m2} sample-map 133 | {ao3 :a {ai3 :a :as _m} :b :as _m} sample-map 134 | {{ai4 :a :as _m} :b ao4 :a :as _m} sample-map] 135 | (is (and (= 2 ai1) (= 1 ao1))) 136 | (is (and (= 2 ai2) (= 1 ao2))) 137 | (is (and (= 2 ai3) (= 1 ao3))) 138 | (is (and (= 2 ai4) (= 1 ao4))))) 139 | 140 | (deftest test-wrap-map-impls 141 | (let [dm (w/with-wrap (wrap :a 1 :b 2) 142 | {:invoke (fn [_env & args] (apply + args))})] 143 | 144 | (is (w/contains-impl? dm :invoke) "Should contain :invoke impl") 145 | (is (not (w/contains-impl? dm :non-existent)) "Should not contain :non-existent impl") 146 | 147 | (is (fn? (w/get-impl dm :invoke)) ":invoke impl should be a function") 148 | (is (nil? (w/get-impl dm :non-existent)) "Non-existent impl should return nil") 149 | 150 | (let [e (w/get-impls dm)] 151 | (is (map? e) "get-impls should return a map") 152 | (is (contains? e :invoke) "Implementations should contain :invoke")) 153 | 154 | (is (= {:a 1 :b 2} (w/unwrap dm)) "unwrap should return the underlying collection") 155 | 156 | (let [updated-dm (w/dissoc-impl dm :invoke)] 157 | (is (not (w/contains-impl? updated-dm :invoke)) "Implementations should be removed after dissoc-impl")))) 158 | 159 | ;; --- Tests for Implementation Manipulation API --- 160 | 161 | (deftest test-impl-api-persistent 162 | (let [m0 w/empty-wrap 163 | f1 (fn [_ _] "f1") 164 | f2 (fn [_ _ k] (str "f2-" k))] 165 | (is (not (w/contains-impl? m0 :valAt_k)) "Empty map shouldn't contain impl") 166 | (is (nil? (w/get-impl m0 :valAt_k)) "Getting non-existent impl returns nil") 167 | 168 | (let [m1 (w/assoc-impl m0 :valAt_k f1)] 169 | (is (w/contains-impl? m1 :valAt_k) "Should contain impl after assoc-impl") 170 | (is (= f1 (w/get-impl m1 :valAt_k)) "Should retrieve correct impl") 171 | (is (map? (w/get-impls m1)) "get-impls returns a map") 172 | (is (= f1 (get (w/get-impls m1) :valAt_k)) "get-impls includes added impl")) 173 | 174 | (let [m2 (w/assoc-impl m0 :valAt_k f1 :valAt_k_nf f2)] 175 | (is (w/contains-impl? m2 :valAt_k) "Contains first impl") 176 | (is (w/contains-impl? m2 :valAt_k_nf) "Contains second impl") 177 | (is (= f1 (w/get-impl m2 :valAt_k))) 178 | (is (= f2 (w/get-impl m2 :valAt_k_nf)))) 179 | 180 | (let [m1 (w/assoc-impl m0 :valAt_k f1) 181 | m3 (w/dissoc-impl m1 :valAt_k)] 182 | (is (not (w/contains-impl? m3 :valAt_k)) "Should not contain impl after dissoc-impl")) 183 | 184 | (let [m1 (w/assoc m0 :valAt_k f1) 185 | new-impls {:assoc_k_v f2} 186 | m4 (w/with-wrap m1 new-impls)] 187 | (is (not (w/contains-impl? m4 :valAt_k)) "Old impl gone after with-wrap") 188 | (is (w/contains-impl? m4 :assoc_k_v) "New impl present after with-wrap")))) 189 | 190 | ;; --- Tests for Common Override Scenarios --- 191 | 192 | (deftest test-override-get-default-value 193 | (let [default-val :i-am-default 194 | m (w/assoc 195 | (wrap :a 1) 196 | :valAt_k_nf 197 | (fn [_ m k _nf] 198 | (let [v (get m k ::nf)] 199 | (if (= v ::nf) 200 | default-val ;; Return custom default 201 | v))) 202 | :valAt_k 203 | (fn [_ m k] 204 | (let [v (get m k ::nf)] ;;<- same as above 205 | (if (= v ::nf) 206 | default-val 207 | v))))] 208 | (is (= 1 (get m :a)) "Getting existing key works normally") 209 | (is (= 1 (get m :a :wrong-default)) "Getting existing key ignores nf") 210 | (is (= default-val (get m :b)) "Getting missing key returns custom default") 211 | (is (= default-val (get m :b :wrong-default)) "Getting missing key returns custom default even if nf supplied"))) 212 | 213 | (deftest test-override-assoc-validation 214 | (let [validated-map 215 | (w/assoc-impl 216 | w/empty-wrap 217 | :assoc_k_v 218 | (fn [{:as e :keys [<-]} m k v] 219 | (if (string? v) 220 | ;; Construct new map instance - using wrap constructor for now 221 | (<- e (assoc m k (str "Validated: " v))) 222 | (throw (ex-info "Validation failed: Value must be string" {:key k :value v})))))] 223 | (let [m1 (assoc validated-map :a "hello")] 224 | (is (= {:a "Validated: hello"} m1)) 225 | (is (instance? com.jolygon.wrap_map.api_0.impl.WrapMap+assoc_k_v m1))) 226 | (is (thrown? clojure.lang.ExceptionInfo (assoc validated-map :b 123))))) 227 | 228 | (deftest test-override-invoke-variadic 229 | (let [callable-map 230 | (w/assoc 231 | (wrap :base 10) 232 | :invoke-variadic 233 | (fn [_ m & args] 234 | (+ (:base m) (apply + args))))] 235 | (is (= 10 (callable-map)) "Invoke with 0 args") 236 | (is (= 15 (callable-map 5)) "Invoke with 1 arg") 237 | (is (= 16 (callable-map 1 2 3)) "Invoke with multiple args") 238 | (is (= 10 (get callable-map :base)) "Lookup still works (invoke not called for arity 1/2 by default)") 239 | (is (= :nf (get callable-map :missing :nf)) "Lookup still works"))) 240 | 241 | (deftest test-override-transient-logging 242 | (let [log (atom []) 243 | logging-map 244 | (w/assoc 245 | (wrap) 246 | :T_assoc_k_v 247 | (fn [_ t-m k v] 248 | (swap! log conj [:assoc! k v]) 249 | (assoc! t-m k v)) 250 | :T_without_k 251 | (fn [_ t-m k] 252 | (swap! log conj [:without! k]) 253 | (dissoc! t-m k))) 254 | final-map (persistent! 255 | (-> (transient logging-map) 256 | (assoc! :a 1) 257 | (assoc! :b 2) 258 | (dissoc! :a) 259 | (assoc! :c 3)))] 260 | (is (= {:b 2 :c 3} final-map) "Final map state is correct") 261 | (is (= [[:assoc! :a 1] 262 | [:assoc! :b 2] 263 | [:without! :a] 264 | [:assoc! :c 3]] @log) "Log contains correct operations"))) 265 | 266 | (deftest test-override-toString 267 | (let [m (w/assoc 268 | (wrap :a 1 :b 2) 269 | :toString 270 | (fn [_ m] 271 | (str "")))] 272 | (is (= "" (str m))))) 273 | 274 | (comment 275 | ;;; runnning tests 276 | (do 277 | (wrap-map-build-test) 278 | (wrap-map-arity-test) 279 | (wrap-map-assoc-dissoc-test) 280 | (wrap-map-conj-test) 281 | (wrap-map-find-test) 282 | (wrap-map-contains-test) 283 | (wrap-map-keys-vals-test) 284 | (wrap-map-get-test) 285 | (wrap-map-destructure-test) 286 | (test-wrap-map-impls) 287 | (test-impl-api-persistent) 288 | (test-override-get-default-value) 289 | (test-override-assoc-validation) 290 | (test-override-invoke-variadic) 291 | (test-override-transient-logging) 292 | (test-override-toString)) 293 | 294 | :end) 295 | -------------------------------------------------------------------------------- /test/com/jolygon/wrap_map/api_0_test.cljs: -------------------------------------------------------------------------------- 1 | (ns com.jolygon.wrap-map.api-0-test 2 | (:require 3 | [clojure.test :refer [deftest is]] 4 | [com.jolygon.wrap-map.api-0 :as w :refer [empty-wrap wrap]] 5 | [com.jolygon.wrap-map.api-0.impl :as mi])) 6 | 7 | (deftest wrap-map-build-test 8 | (is (= (type empty-wrap) (type (wrap)))) 9 | (is (= {:a 1, :b 2} (wrap :a 1, :b 2))) 10 | (is (= {:a 1, :b 2} (wrap :b 2, :a 1))) 11 | (is (= {:a 1, :b 2, :c 3} (wrap :a 1, :b 2, :c 3))) 12 | (is (= {:a 1, :b 2, :c 3} (wrap :c 3, :a 1, :b 2))) 13 | (is (= {:a 1, :b 2, :c 3} (wrap :c 3, :b 2, :a 1))) 14 | (is (= {:a 1, :b 2, :c 3} (wrap :b 2, :c 3, :a 1)))) 15 | 16 | (deftest wrap-map-arity-test 17 | (is (= "invalid-arity 0" 18 | (try ((wrap)) (catch :default e 19 | (str (name (:error (ex-data e))) 20 | " " 21 | (:arity (ex-data e))))))) 22 | (is (= 1 ((wrap :a 1) :a))) 23 | (is (= nil ((wrap :a 1) :b))) 24 | (is (= "invalid-arity 3" 25 | (try ((wrap) 1 2 3) (catch :default e 26 | (str (name (:error (ex-data e))) 27 | " " 28 | (:arity (ex-data e))))))) 29 | (is (= "invalid-arity 4" 30 | (try ((wrap) 1 2 3 4) (catch :default e 31 | (str (name (:error (ex-data e))) 32 | " " 33 | (:arity (ex-data e)))))))) 34 | 35 | (deftest wrap-map-assoc-dissoc-test 36 | (is (= {:a 1, :b 2} (assoc (wrap :a 1) :b 2))) 37 | (is (= (type empty-wrap) 38 | (type (assoc (wrap :a 1) :b 2)))) 39 | 40 | (is (= {:a 1} (dissoc (wrap :a 1 :b 2) :b))) 41 | (is (= (type empty-wrap) 42 | (type (dissoc (wrap :a 1 :b 2) :b)))) 43 | 44 | (is (= {:a 1, :b 2} (merge (wrap :a 1) {:b 2}))) 45 | (is (= (type empty-wrap) 46 | (type (merge (wrap :a 1) {:b 2}))))) 47 | 48 | (deftest wrap-map-conj-test 49 | (is (= (conj (wrap) {}) (wrap))) 50 | (is (= (conj (wrap) {:a 1}) (wrap :a 1))) 51 | (is (= (conj (wrap) {:a 1} {:b 2}) (wrap :a 1 :b 2))) 52 | (is (= (conj (wrap) {:a 1} {:b 2 :c 3}) (wrap :a 1 :b 2 :c 3))) 53 | 54 | (is (= (conj (wrap :a 1) {}) (wrap :a 1))) 55 | (is (= (conj (wrap :a 1) {:b 2}) (wrap :a 1 :b 2))) 56 | (is (= (conj (wrap :a 1) {:b 2} {:c 3}) (wrap :a 1 :b 2 :c 3))) 57 | 58 | (is (= (conj (wrap) (first (wrap :a 1))) 59 | (wrap :a 1))) 60 | (is (= (conj (wrap :b 2) (first (wrap :a 1))) 61 | (wrap :a 1 :b 2))) 62 | (is (= (conj (wrap :b 2) (first (wrap :a 1)) (first (wrap :c 3))) 63 | (wrap :a 1 :b 2 :c 3))) 64 | 65 | (is (= (conj (wrap) [:a 1]) 66 | (wrap :a 1))) 67 | (is (= (conj (wrap :b 2) [:a 1]) 68 | (wrap :a 1 :b 2))) 69 | (is (= (conj (wrap :b 2) [:a 1] [:c 3]) 70 | (wrap :a 1 :b 2 :c 3))) 71 | 72 | (is (= (conj (wrap) (wrap nil (wrap))) 73 | (wrap nil (wrap)))) 74 | (is (= (conj (wrap) (wrap (wrap) nil)) 75 | (wrap (wrap) nil))) 76 | (is (= (conj (wrap) (wrap (wrap) (wrap))) 77 | (wrap (wrap) (wrap))))) 78 | 79 | (deftest wrap-map-find-test 80 | (is (= (conj (wrap) {}) (wrap))) 81 | (is (= (find (wrap) :a) nil)) 82 | (is (= (find (wrap :a 1) :a) [:a 1])) 83 | (is (= (find (wrap :a 1) :b) nil)) 84 | (is (= (find (wrap nil 1) nil) [nil 1])) 85 | (is (= (find (wrap :a 1 :b 2) :a) [:a 1])) 86 | (is (= (find (wrap :a 1 :b 2) :b) [:b 2])) 87 | (is (= (find (wrap :a 1 :b 2) :c) nil)) 88 | (is (= (find (wrap) nil) nil)) 89 | (is (= (find (wrap :a 1) nil) nil)) 90 | (is (= (find (wrap :a 1 :b 2) nil) nil))) 91 | 92 | (deftest wrap-map-contains-test 93 | (is (= (contains? (wrap) :a) false)) 94 | (is (= (contains? (wrap) nil) false)) 95 | (is (= (contains? (wrap :a 1) :a) true)) 96 | (is (= (contains? (wrap :a 1) :b) false)) 97 | (is (= (contains? (wrap :a 1) nil) false)) 98 | (is (= (contains? (wrap nil 1) nil) true)) 99 | (is (= (contains? (wrap :a 1 :b 2) :a) true)) 100 | (is (= (contains? (wrap :a 1 :b 2) :b) true)) 101 | (is (= (contains? (wrap :a 1 :b 2) :c) false)) 102 | (is (= (contains? (wrap :a 1 :b 2) nil) false))) 103 | 104 | (deftest wrap-map-keys-vals-test 105 | (is (= (keys (wrap)) nil)) 106 | (is (= (keys (wrap :a 1)) '(:a))) 107 | (is (= (keys (wrap nil 1)) '(nil))) 108 | (is (= (vals (wrap)) nil)) 109 | (is (= (vals (wrap :a 1)) '(1))) 110 | (is (= (vals (wrap nil 1)) '(1)))) 111 | #_{:clj-kondo/ignore [:single-key-in]} 112 | (deftest wrap-map-get-test 113 | (let [m (wrap :a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5})] 114 | (is (= (get m :a) 1)) 115 | (is (= (get m :e) nil)) 116 | (is (= (get m :e 0) 0)) 117 | (is (= (get m nil) {:h 5})) 118 | (is (= (get m :b 0) 2)) 119 | (is (= (get m :f 0) nil)) 120 | (is (= (get-in m [:c :e]) 4)) 121 | (is (= (get-in m '(:c :e)) 4)) 122 | (is (= (get-in m [:c :x]) nil)) 123 | (is (= (get-in m [:f]) nil)) 124 | (is (= (get-in m [:g]) false)) 125 | (is (= (get-in m [:h]) nil)) 126 | (is (= (get-in m []) m)) 127 | (is (= (get-in m nil) m)) 128 | (is (= (get-in m [:c :e] 0) 4)) 129 | (is (= (get-in m '(:c :e) 0) 4)) 130 | (is (= (get-in m [:c :x] 0) 0)) 131 | (is (= (get-in m [:b] 0) 2)) 132 | (is (= (get-in m [:f] 0) nil)) 133 | (is (= (get-in m [:g] 0) false)) 134 | (is (= (get-in m [:h] 0) 0)) 135 | (is (= (get-in m [:x :y] {:y 1}) {:y 1})) 136 | (is (= (get-in m [] 0) m)) 137 | (is (= (get-in m nil 0) m)))) 138 | 139 | (deftest wrap-map-destructure-test 140 | (let [sample-map (wrap :a 1 :b {:a 2}) 141 | {ao1 :a {ai1 :a} :b} sample-map 142 | {ao2 :a {ai2 :a :as _m1} :b :as _m2} sample-map 143 | {ao3 :a {ai3 :a :as _m} :b :as _m} sample-map 144 | {{ai4 :a :as _m} :b ao4 :a :as _m} sample-map] 145 | (is (and (= 2 ai1) (= 1 ao1))) 146 | (is (and (= 2 ai2) (= 1 ao2))) 147 | (is (and (= 2 ai3) (= 1 ao3))) 148 | (is (and (= 2 ai4) (= 1 ao4))))) 149 | 150 | (deftest test-wrap-map-impls 151 | (let [dm (w/with-wrap (wrap :a 1 :b 2) 152 | {:invoke (fn [_env & args] (apply + args))})] 153 | 154 | (is (w/contains-impl? dm :invoke) "Should contain :invoke impl") 155 | (is (not (w/contains-impl? dm :non-existent)) "Should not contain :non-existent impl") 156 | 157 | (is (fn? (w/get-impl dm :invoke)) ":invoke impl should be a function") 158 | (is (nil? (w/get-impl dm :non-existent)) "Non-existent impl should return nil") 159 | 160 | (let [e (w/get-impls dm)] 161 | (is (map? e) "get-impls should return a map") 162 | (is (contains? e :invoke) "Implementations should contain :invoke")) 163 | 164 | (is (= {:a 1 :b 2} (w/unwrap dm)) "unwrap should return the underlying collection") 165 | 166 | (let [updated-dm (w/dissoc-impl dm :invoke)] 167 | (is (not (w/contains-impl? updated-dm :invoke)) "Implementation should be removed after dissoc-impl")))) 168 | 169 | ;; --- Tests for Implementation Manipulation API --- 170 | 171 | (deftest test-impl-api-persistent 172 | (let [m0 w/empty-wrap 173 | f1 (fn [_ _] "f1") 174 | f2 (fn [_ _ k] (str "f2-" k))] 175 | (is (not (w/contains-impl? m0 :-lookup_k)) "Empty map shouldn't contain impl") 176 | (is (nil? (w/get-impl m0 :g-lookup_ket_k)) "Getting non-existent impl returns nil") 177 | 178 | (let [m1 (w/assoc-impl m0 :-lookup_k f1)] 179 | (is (w/contains-impl? m1 :-lookup_k) "Should contain impl after assoc-impl") 180 | (is (= f1 (w/get-impl m1 :-lookup_k)) "Should retrieve correct impl") 181 | (is (map? (w/get-impls m1)) "get-impls returns a map") 182 | (is (= f1 (get (w/get-impls m1) :-lookup_k)) "get-impls includes added impl")) 183 | 184 | (let [m2 (w/assoc-impl m0 :-lookup_k f1 :-lookup_k_nf f2)] 185 | (is (w/contains-impl? m2 :-lookup_k) "Contains first impl") 186 | (is (w/contains-impl? m2 :-lookup_k_nf) "Contains second impl") 187 | (is (= f1 (w/get-impl m2 :-lookup_k))) 188 | (is (= f2 (w/get-impl m2 :-lookup_k_nf)))) 189 | 190 | (let [m1 (w/assoc-impl m0 :-lookup_k f1) 191 | m3 (w/dissoc-impl m1 :-lookup_k)] 192 | (is (not (w/contains-impl? m3 :-lookup_k)) "Should not contain impl after dissoc-impl")) 193 | 194 | (let [m1 (w/assoc-impl m0 :-lookup_k f1) 195 | new-impls {:-assoc_k_v f2} 196 | m4 (w/with-wrap m1 new-impls)] 197 | (is (not (w/contains-impl? m4 :-lookup_k)) "Old impl gone after with-wrap") 198 | (is (w/contains-impl? m4 :-assoc_k_v) "New impl present after with-wrap")))) 199 | 200 | ;; --- Tests for Common Override Scenarios --- 201 | ;; (def default-val :i-am-default) 202 | (deftest test-override-get-default-value 203 | (let [default-val :i-am-default 204 | m (w/assoc-impl 205 | (wrap :a 1) 206 | :-lookup_k_nf 207 | (fn [_ m k _nf] 208 | (let [v (get m k ::nf)] 209 | (if (= v ::nf) 210 | default-val ;; Return custom default 211 | v))) 212 | :-lookup_k 213 | (fn [_ m k] 214 | (let [v (get m k ::nf)] ;;<- same as above 215 | (if (= v ::nf) 216 | default-val 217 | v))))] 218 | (is (= 1 (get m :a)) "Getting existing key works normally") 219 | (is (= 1 (get m :a :wrong-default)) "Getting existing key ignores nf") 220 | (is (= default-val (get m :b)) "Getting missing key returns custom default") 221 | (is (= default-val (get m :b :wrong-default)) "Getting missing key returns custom default even if nf supplied"))) 222 | 223 | (deftest test-override-assoc-validation 224 | (let [validated-map 225 | (w/assoc 226 | w/empty-wrap 227 | :-assoc_k_v 228 | (fn [{:as e :keys [<-]} m k v] 229 | (if (string? v) 230 | ;; Construct new map instance - using impl constructor for now 231 | (<- e (assoc m k (str "Validated: " v))) 232 | (throw (ex-info "Validation failed: Value must be string" {:key k :value v})))))] 233 | (let [m1 (assoc validated-map :a "hello")] 234 | (is (= {:a "Validated: hello"} m1)) 235 | (is (instance? mi/WrapMap+-assoc_k_v m1))) 236 | (is (thrown? :default (assoc validated-map :b 123))))) 237 | 238 | (deftest test-override-invoke-variadic 239 | (let [callable-map 240 | (w/assoc-impl 241 | (wrap :base 10) 242 | :invoke-variadic 243 | (fn [_ m & args] 244 | (+ (:base m) (apply + args))))] 245 | (is (= 10 (callable-map)) "Invoke with 0 args") 246 | (is (= 15 (callable-map 5)) "Invoke with 1 arg") 247 | (is (= 16 (callable-map 1 2 3)) "Invoke with multiple args") 248 | (is (= 10 (get callable-map :base)) "Lookup still works (invoke not called for arity 1/2 by default)") 249 | (is (= :nf (get callable-map :missing :nf)) "Lookup still works"))) 250 | 251 | (deftest test-override-transient-logging 252 | (let [log (atom []) 253 | logging-map 254 | (w/assoc 255 | (wrap) 256 | :T_-assoc!_k_v 257 | (fn T_-assoc!_k_v [_ t-m k v] 258 | (swap! log conj [:T_assoc! k v]) 259 | (assoc! t-m k v)) 260 | :T_-dissoc!_k 261 | (fn T_-dissoc!_k [_ t-m k] 262 | (swap! log conj [:T_without! k]) 263 | (dissoc! t-m k))) 264 | final-map (persistent! 265 | (-> (transient logging-map) 266 | (assoc! :a 1) 267 | (assoc! :b 2) 268 | (dissoc! :a) 269 | (assoc! :c 3)))] 270 | (is (= {:b 2 :c 3} final-map) "Final map state is correct") 271 | (is (= [[:T_assoc! :a 1] 272 | [:T_assoc! :b 2] 273 | [:T_without! :a] 274 | [:T_assoc! :c 3]] @log) "Log contains correct operations"))) 275 | 276 | (deftest test-override-toString 277 | (let [m (w/assoc 278 | (w/wrap :a 1 :b 2) 279 | :toString 280 | (fn [_ m] 281 | (str "")))] 282 | (is (= "" (str m))))) 283 | 284 | (comment 285 | ;;; runnning tests 286 | (println :hi) 287 | (do 288 | (wrap-map-build-test) 289 | (wrap-map-arity-test) 290 | (wrap-map-assoc-dissoc-test) 291 | (wrap-map-conj-test) 292 | (wrap-map-find-test) 293 | (wrap-map-contains-test) 294 | (wrap-map-keys-vals-test) 295 | (wrap-map-get-test) 296 | (wrap-map-destructure-test) 297 | (test-wrap-map-impls) 298 | (test-impl-api-persistent) 299 | (test-override-get-default-value) 300 | (test-override-assoc-validation) 301 | (test-override-invoke-variadic) 302 | (test-override-transient-logging) 303 | (test-override-toString))) 304 | 305 | (defn -main [] 306 | (println :starting :test) 307 | (wrap-map-build-test) 308 | (wrap-map-arity-test) 309 | (wrap-map-assoc-dissoc-test) 310 | (wrap-map-conj-test) 311 | (wrap-map-find-test) 312 | (wrap-map-contains-test) 313 | (wrap-map-keys-vals-test) 314 | (wrap-map-get-test) 315 | (wrap-map-destructure-test) 316 | (test-wrap-map-impls) 317 | (test-impl-api-persistent) 318 | (test-override-get-default-value) 319 | (test-override-assoc-validation) 320 | (test-override-invoke-variadic) 321 | (test-override-transient-logging) 322 | (test-override-toString) 323 | (println :test :complete)) 324 | --------------------------------------------------------------------------------