├── .gitignore ├── .lein-repl-history ├── LICENSE ├── README.md ├── project.clj ├── resources └── datview-schema.edn └── src ├── .supress-folder-errors.keep └── dat ├── sub.cljs ├── view.clj ├── view.cljs └── view ├── context.cljs ├── forms.cljs ├── query.cljc ├── representation.cljc ├── router.cljs ├── routes.cljc ├── settings.cljs ├── styles.cljc ├── table.cljs └── utils.cljs /.gitignore: -------------------------------------------------------------------------------- 1 | *.iml 2 | target 3 | pom.xml 4 | checkouts/ 5 | -------------------------------------------------------------------------------- /.lein-repl-history: -------------------------------------------------------------------------------- 1 | (run) 2 | cd .. 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of Washington and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Datview 2 | 3 | [Insert explosive graphic] 4 | 5 | 6 | 7 | ## Introduction 8 | 9 | If om-next gets the idea of components requesting the shape of data they need correct, Datview goes one step further in realizing you can let the shape of the data you request direct the rendering of that data. 10 | 11 | Instead of decorating components with information about where they get their data, decorate _queries_ with information about how they render :-) 12 | This data driven approach leads to effortlessly composable view code, meaning complex UI can be programmatically constructed from simple pieces. 13 | This will make it possible to very rapidly build complex data driven applications. 14 | 15 | It's going to take a bit of work to fully smooth out all the defaults and patterns, but I'm liking the picture so far. 16 | 17 | 18 | ## How does it work? 19 | 20 | We do this with metadata on parts of our pull expressions and queries 21 | 22 | Example: 23 | 24 | 25 | ```clj 26 | (def small-fonts {:font-size "8px"}) 27 | (def small-fonts-bold (merge small-fonts 28 | {:font-weight "bold"})) 29 | 30 | (def time-entry-view 31 | ^{:attributes {:e/description {:style small-fonts}} 32 | ;; Possible? But not supported yet. 33 | :derived-attributes {:time.entry/duration 34 | ^{:datview.derived-attribute/of [:time.entry/stop-time :time.entry/start-time]} 35 | (fn [{:as time-entry :keys [time.entry/stop-time time.entry/start-time]}] 36 | (- stop-time start-time))}} 37 | [:e/description :time.entry/duration] 38 | 39 | (def todo-view 40 | ^{:attributes {:e/tags {:style small-fonts-bold :summarize tag-name-fn} 41 | :e/description {:style small-fonts} 42 | :e/category {:style small-fonts-bold} 43 | :todo/hours {:wrapper todo-hours-with-summary}} 44 | :wrapper [lined-box]} 45 | [:e/name :e/category :e/tags :e/description 46 | ;; Here we have some reference attributes 47 | {:todo/time-entries time-entry-view} 48 | {:todo/subtasks ^{:note "Here merge into the attributes passed down recursively"} 49 | '...}]) 50 | ``` 51 | 52 | 53 | Functions (Reagent components) like `pull-view`, `attr-view` and `value-view` are wired together into a recursive tree, based on various entry points. 54 | Each one of these entry points can be customized in the structure of the pull metadata. 55 | Thus everything is perfectly composable, because everything is **just data**. 56 | We can override things so that when we push down into some particular part of a pull expression, the corresponding components will be rendered exactly as you wish :-) 57 | 58 | The brilliant thing is that we can also just do this if you don't need customization: 59 | 60 | (pull-view conn [:e/name :e/category :e/tags :e/description {:todo/subtasks ...}]) 61 | ;; uhh... actually not _quite_ yet... need to get `'...` to work in posh 62 | 63 | Or even better 64 | 65 | (pull-view conn '[*] eid) 66 | 67 | Fine... 68 | 69 | (entity-view conn eid) 70 | 71 | Collections? 72 | 73 | Yeah, we got that too: 74 | 75 | (pull-many-view conn todo-view todo-eids) 76 | ;; Just kidding! Coming soon... 77 | 78 | What about q? 79 | 80 | (q-view conn {:find [[('pull todo-view '?todo) '...]] 81 | :where '[[?todo :e/type :e.type/Todo] 82 | [?todo :e/category :category/Work]]}) 83 | ;; Haha; Also j/k. Vaporware Suckers (TM)! 84 | 85 | This lets us build tables or other collection views using the full expressiveness of DataScript Datalog for scope. 86 | 87 | Imagine that? 88 | Composing queries which know how to render themselves. 89 | 90 | This schema is serializable to the DataScript DB, and can be accessed and operated upon in the component functions. 91 | The default functions pull from these. 92 | But you can customize and extend them more or less as you wish. 93 | And of course, all of these settings are overridable by the metadata specifications on a local basis. 94 | 95 | 96 | ## Datview Specification Schema 97 | 98 | Datview is half way towards using Prismatic Schema for type specifications. 99 | However, now that Clojure 1.9 has proper specs, we'll probably redraft in terms of those. 100 | Still, for the mean time, the specs in `datview.schema` should serve as a rough guide for the shape of the datview specification grammar. 101 | 102 | 103 | ## Customizing global defaults 104 | 105 | You might have a set of global defaults (for styles, wrappers, rendering functions, etc) you'd like to apply without having to manually pass in the metadata each time. 106 | 107 | We support this with the following functions: 108 | 109 | * `default-config`: Returns a reaction of the default configuration. 110 | * `update-default-config!`: Atomically update default config using an update function. 111 | * `set-default-config!`: Resets the default-config. 112 | 113 | 114 | 115 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject datview "0.0.1-alpha1-SNAPSHOT" 2 | :description "Effortlessly compose data visualizations and controls for Datomic and DataScript data" 3 | :url "http://github.com/metasoarous/datview" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :min-lein-version "2.0.0" 7 | :dependencies [[org.clojure/clojure "1.9.0-alpha6"] 8 | [org.clojure/clojurescript "1.9.36"] 9 | [org.clojure/core.match "0.3.0-alpha4"] 10 | ;; datomic needed for reader literals 11 | [com.datomic/datomic-free "0.9.5372" :exclusions [joda-time org.slf4j/slf4j-nop com.google.guava/guava]] 12 | ;; Datsys things 13 | [datspec "0.0.1-alpha1-SNAPSHOT"] 14 | [datreactor "0.0.1-alpha1-SNAPSHOT"] 15 | ;; Other stuff 16 | [com.stuartsierra/component "0.3.1"] 17 | [com.andrewmcveigh/cljs-time "0.5.0-alpha1"] 18 | [testdouble/clojurescript.csv "0.2.0"] 19 | [datascript "0.15.0"] 20 | [posh "0.5.4"] 21 | [reagent "0.6.0"] 22 | [markdown-clj "0.9.89"] 23 | [servant "0.1.5"] 24 | ;; Not sure if this should just be a dev dep; It's kinda nice 25 | [data-frisk-reagent "0.3.5"] 26 | [re-com "0.9.0" :exclusions [cljsjs/react cljsjs/react-dom]] 27 | [bidi "2.0.9"] 28 | [io.rkn/conformity "0.4.0"] ;; should this be here? 29 | [prismatic/plumbing "0.5.2"] ;; aren't using currently 30 | [com.lucasbradstreet/cljs-uuid-utils "1.0.2"]] ;; used for table view 31 | ;; 32 | ;; ## Snipped from DataScript's 33 | ;; ============================ 34 | ;; 35 | ;; The following was taken from DataScript's project.clj; may need to clean up a bit 36 | ;; 37 | ;; Leaving this out for now 38 | ;:global-vars {*warn-on-reflection* true} 39 | :cljsbuild {:builds [{:id "release" 40 | :source-paths ["src"] 41 | :assert false 42 | :compiler {:output-to "release-js/datview.bare.js" 43 | :optimizations :advanced 44 | :pretty-print false 45 | :elide-asserts true 46 | :output-wrapper false 47 | :parallel-build true}}]} 48 | ;:notify-command ["release-js/wrap_bare.sh"] 49 | :profiles {:dev {:source-paths ["bench/src" "test" "dev" "src"] 50 | :plugins [[lein-cljsbuild "1.1.2"] 51 | [lein-typed "0.3.5"]] 52 | :cljsbuild {:builds [{:id "advanced" 53 | :source-paths ["src" "test"] 54 | :compiler {:output-to "target/datview.js" 55 | :optimizations :advanced 56 | :source-map "target/datview.js.map" 57 | :pretty-print true 58 | :recompile-dependents false 59 | :parallel-build true}} 60 | {:id "none" 61 | :source-paths ["src" "test" "dev"] 62 | :compiler {:main datview.test 63 | :output-to "target/datview.js" 64 | :output-dir "target/none" 65 | :optimizations :none 66 | :source-map true 67 | :recompile-dependents false 68 | :parallel-build true}}]}}} 69 | :clean-targets ^{:protect false} ["target" 70 | "release-js/datview.bare.js" 71 | "release-js/datview.js"] 72 | ;; 73 | ;; ## Back to from extraction... 74 | ;; ============================= 75 | ;; 76 | ;; Once we're ready 77 | ;:core.typed {:check [] 78 | ;:check-cljs []} 79 | ;; 80 | ;; Not sure if we need these either 81 | :resource-paths ["resources" "resources-index/prod"] 82 | :target-path "target/%s" 83 | :aliases {"package" 84 | ["with-profile" "prod" "do" 85 | "clean" ["cljsbuild" "once"]]}) 86 | 87 | 88 | -------------------------------------------------------------------------------- /resources/datview-schema.edn: -------------------------------------------------------------------------------- 1 | 2 | {:dat.view/base-schema 3 | {:txes 4 | [[;; ## Top level, generic, polymorphic attributes 5 | ;; 6 | {:db/id #db/id[:db.part/db] 7 | :db/ident :e/name 8 | :db/valueType :db.type/string 9 | :db/cardinality :db.cardinality/one 10 | :db/doc "A name; polymorphic; could relate to anything" 11 | :db.install/_attribute :db.part/db} 12 | {:db/id #db/id[:db.part/db] 13 | :db/ident :e/description 14 | :db/valueType :db.type/string 15 | :db/cardinality :db.cardinality/one 16 | :db/doc "A generic, polymorhpic description attribute" 17 | :db.install/_attribute :db.part/db} 18 | {:db/id #db/id[:db.part/db] 19 | :db/ident :attribute/label 20 | :db/valueType :db.type/string 21 | :db/cardinality :db.cardinality/one 22 | :db/doc "The label string of an attribute (for forms and views)" 23 | :db.install/_attribute :db.part/db}] 24 | ;; Giving :attribute/label it's own :attribute/label 25 | [[:db/add :attribute/label :attribute/label "Attribute Label"] 26 | [:db/add :e/name :attribute/label "Name"] 27 | [:db/add :e/description :attribute/label "Description"]] 28 | [{:db/id #db/id[:db.part/db] 29 | :attribute/label "Hide attribute?" 30 | :db/ident :attribute/hidden? 31 | :db/valueType :db.type/boolean 32 | :db/cardinality :db.cardinality/one 33 | :db/doc "Should this attribute be hidden in views and forms?" 34 | :db.install/_attribute :db.part/db} 35 | {:db/id #db/id[:db.part/db] 36 | :db/ident :attribute/sort-by 37 | :db/valueType :db.type/ref 38 | :db/cardinality :db.cardinality/one 39 | :db/doc "For reference attributes, the attribute by which results should be sorted" 40 | :db.install/_attribute :db.part/db}] 41 | ;; 42 | ;; 43 | ;; # Type hierarchy 44 | ;; ================ 45 | ;; 46 | ;; * type/Entity; You typically inherit from Entity, though you don't strictly need to 47 | ;; * type/MaterializedEntity; This is something you would compute from data in datomic; Don't need to use 48 | ;; * type/Type; A type 49 | ;; 50 | ;; Note that in these type definitions, the only attribute we have to add are the generics (:e/name, mostly) 51 | ;; 52 | ;; These are the abstract types from which we'll want to be able to inherit 53 | [{:db/id #db/id[:db.part/db] 54 | :db/ident :e/type 55 | :db/valueType :db.type/ref 56 | :db/cardinality :db.cardinality/one 57 | :db/doc "Specifies the type of a given entity" 58 | :db.install/_attribute :db.part/db} 59 | {:db/id #db/id[:db.part/user] 60 | :db/ident :e.type/Type 61 | :db/doc "A type type... Cause we be meta-like-that" 62 | :e/name "Type"}] 63 | ;; This maybe should have an :attribute/label attribute itself, if we dynamically generate new record types 64 | [{:db/id #db/id[:db.part/db] 65 | :db/ident :attribute.ref/types 66 | :db/valueType :db.type/ref 67 | :db/cardinality :db.cardinality/many 68 | :db/doc "For a reference attribute, what e.types are acceptable?" 69 | :db.install/_attribute :db.part/db} 70 | ;; Also going to make it possible to directly assign options for a ref attribute, in cases of enums (basically) 71 | {:db/id #db/id[:db.part/db] 72 | :db/ident :attribute.ref/options 73 | :db/valueType :db.type/ref 74 | :db/cardinality :db.cardinality/many 75 | :db/doc "For a reference attribute, what explicit collection of entities should be selectable?" 76 | :db.install/_attribute :db.part/db}] 77 | ;; Some misc recursive installation 78 | [[:db/add :attribute.ref/types :attribute.ref/types :e.type/Type] 79 | [:db/add :e/type :attribute.ref/types :e.type/Type] 80 | [:db/add :e.type/Type :e/type :e.type/Type]] 81 | [{:db/id #db/id[:db.part/db] 82 | :db/ident :e.type/attributes 83 | :db/valueType :db.type/ref 84 | :db/cardinality :db.cardinality/many 85 | :db/doc "The attributes associated with a paritcular :e/type. Mainly useful for dynamically building forms." 86 | :attribute/label "Attributes" 87 | :db.install/_attribute :db.part/db}] 88 | [{:db/id #db/id[:db.part/db] 89 | :db/ident :e.type/isa 90 | :db/valueType :db.type/ref 91 | :attribute.ref/types [:e.type/Type] 92 | :db/cardinality :db.cardinality/many 93 | :attribute/label "Ancestral Type" 94 | :db/doc "Indicates that one entity type 'is' some special case of another, and should inherit all of it's fields. We can build multimethod hierarchies out of these things." 95 | :db.install/_attribute :db.part/db}] 96 | [{:db/id #db/id[:db.part/user] 97 | :db/ident :e.type/Entity 98 | :e/type :e.type/Type 99 | :e/name "Entity" 100 | :db/doc "Abstract entity type, from which all other types inherit."}] 101 | [{:db/id #db/id[:db.part/user] 102 | :db/ident :e.type/EntityAttribute 103 | ;; Are there any subtypes here? 104 | :e/type :e.type/Type 105 | :e/name "Entity Attribute" 106 | :e.type/isa :e.type/Entity 107 | :e.type/attributes [:db/ident :attribute/label :db/doc :db/valueType :attribute/hidden?]} 108 | {:db/id #db/id[:db.part/user] 109 | :db/ident :e.type/MaterializedEntity 110 | :e/type :e.type/Type 111 | :e/name "Materialized Entity" 112 | :db/doc "This may not be the best name, but it represents a computed value from the db that should behave roughly like an entity."}] 113 | [[:db/add :e.type/attributes :attribute.ref/types :e.type/EntityAttribute]] 114 | ;; The following are for some little helper types for Datview widgets and things 115 | [{:db/id #db/id[:db.part/user] 116 | :db/ident :e.type/Tag 117 | :e/type :e.type/Type 118 | :e.type/attributes [:e/name]} 119 | {:db/id #db/id[:db.part/user] 120 | :db/ident :e.type/Category 121 | :e/type :e.type/Type 122 | :e/name "Category" 123 | :e.type/attributes [:e/name :e/description] 124 | :e.type/isa :e.type/Entity} 125 | {:db/id #db/id[:db.part/user] 126 | :db/ident :e.type/FileAttachment 127 | :e/type :e.type/Type 128 | :e/name "File Attachment" 129 | :db/doc "A file attachment which can be placed on any entity you wish"}] 130 | ;; XXX Need to make this a ref instead of a keyword, but that will end up being a mess of rewriting 131 | [ 132 | {:db/id #db/id[:db.part/db] 133 | :db/ident :e/tags 134 | :db/valueType :db.type/ref 135 | ;; Need to make sure of these... 136 | :attribute.ref/types [:e.type/Tag] 137 | :db/cardinality :db.cardinality/many 138 | :db/doc "The user defined tags associated with an entity." 139 | :db.install/_attribute :db.part/db} 140 | {:db/id #db/id[:db.part/db] 141 | :db/ident :e/category 142 | :db/valueType :db.type/ref 143 | :attribute.ref/types [:e.type/Category] 144 | :db/cardinality :db.cardinality/one 145 | :db/doc "The user defined category of an item." 146 | :db.install/_attribute :db.part/db}] 147 | ;[[:db/add :db/id :attribute/hidden? true]] 148 | ;; should have abstract `ordered` operations for some general purpose dat lib (maybe datview for now, but 149 | ;; maybe this should be something like datcore; general purpose datomic/datascript utilities?) 150 | [{:db/id #db/id[:db.part/db] 151 | :db/ident :e/order 152 | :db/valueType :db.type/long 153 | :db/cardinality :db.cardinality/one 154 | :db/doc "Abstract representation of somethings order as a reference" 155 | :attribute/label "Order" 156 | :db.install/_attribute :db.part/db} 157 | {:db/id #db/id[:db.part/db] 158 | :db/ident :dat.view.creation/token 159 | :db/valueType :db.type/uuid 160 | :db/cardinality :db.cardinality/one 161 | :db/unique :db.unique/identity 162 | :db/doc "A remote token used for referencing new entities created on clients (should this be datsync really? What are the semantics of this thing?)" 163 | :attribute/label "Datview creation token" 164 | :attribute/hidden? true 165 | :db.install/_attribute :db.part/db}] 166 | ;; 167 | ;; ## Comment 168 | ;; 169 | ;; Mostly just a :note/body, but maybe has a description and name as well 170 | [{:db/id #db/id[:db.part/user] 171 | :db/ident :e.type/Comment 172 | :e/type :e.type/Type 173 | :e/name "Comment" 174 | :e.type/isa :e.type/Entity}] 175 | [{:db/id #db/id[:db.part/db] 176 | :db/ident :e/comments 177 | :db/valueType :db.type/ref 178 | :db/cardinality :db.cardinality/many 179 | :db/doc "A reference to a comment" 180 | :db/isComponent true 181 | :attribute/label "Comments" 182 | :attribute.ref/types [:e.type/Comment] 183 | :db.install/_attribute :db.part/db}] 184 | [{:db/id #db/id[:db.part/db] 185 | :db/ident :comment/body 186 | :db/valueType :db.type/string 187 | :db/cardinality :db.cardinality/one 188 | :db/fulltext true 189 | :db/doc "The text body of a comment" 190 | :attribute/label "Comment body" 191 | :e.type/_attributes :e.type/Comment 192 | :db.install/_attribute :db.part/db} 193 | {:db/id #db/id[:db.part/db] 194 | :db/ident :comment/author 195 | :db/valueType :db.type/ref 196 | :db/cardinality :db.cardinality/one 197 | :db/doc "The abstract author of a comment." 198 | :attribute/label "Author" 199 | :e.type/_attributes :e.type/Comment 200 | :db.install/_attribute :db.part/db}] 201 | ;; 202 | ;; ### Have to attach things to comments like this: TODO 203 | ;; How you hook up what things can be commented on: 204 | ;[[:db/add :e.type/YourType :e.type/attributes :e/comments] 205 | ;[:db/add :e.type/YourOtherType :e.type/attributes :e/comments]] 206 | ;; How you hook up what things can be comment authors 207 | ;[[:db/add :comment/author :attrbute.ref/types :s.type/YourType]] 208 | ;; 209 | ;; ## Built in file attatchments 210 | [{:db/id #db/id[:db.part/db] 211 | :db/ident :file.attachment/filename 212 | :db/valueType :db.type/string 213 | :db/cardinality :db.cardinality/one 214 | :db/doc "The filename of a file attachment" 215 | :attribute/label "The file name" 216 | :e.type/_attributes :e.type/FileAttachment 217 | :db.install/_attribute :db.part/db} 218 | {:db/id #db/id[:db.part/db] 219 | :db/ident :file.attachment/content-type 220 | :db/valueType :db.type/string 221 | :db/cardinality :db.cardinality/one 222 | :db/doc "Classic content-type string" 223 | :attribute/label "Content type" 224 | :db.install/_attribute :db.part/db} 225 | {:db/id #db/id[:db.part/db] 226 | :db/ident :file.attachment/uploaded? 227 | :db/valueType :db.type/boolean 228 | :db/cardinality :db.cardinality/one 229 | :db/doc "Whether or not the file has been uploaded; we can use this to trigger " 230 | :attribute/label "File uploaded?" 231 | :db.install/_attribute :db.part/db} 232 | {:db/id #db/id[:db.part/db] 233 | :db/ident :e/attachments 234 | :db/valueType :db.type/ref 235 | :db/isComponent true 236 | :db/cardinality :db.cardinality/many 237 | :db/doc "File attachments for an entity" 238 | :attribute/label "File attachments" 239 | :attribute.ref/types [:e.type/FileAttachment] 240 | :db.install/_attribute :db.part/db}] 241 | ;;; You'll have to install on your attributes like TODO 242 | ;[[:db/add :e.type/YourType :e.type/attributes :e/attachments] 243 | ;[:db/add :e.type/YourOtherType :e.type/attributes :e/attachments]] 244 | ;; 245 | ;; Copy functionality 246 | [{:db/id #db/id[:db.part/db] 247 | :db/ident :e/copy-of 248 | :db/valueType :db.type/ref 249 | :db/cardinality :db.cardinality/one 250 | :db/doc "Notates that this entity is a copy of some other entity; used for making it easy to copy over comments etc" 251 | :attribute/label "Copy of" 252 | :attribute.ref/types [:e.type/Entity] 253 | :db.install/_attribute :db.part/db}]]}} 254 | ;; 255 | ;; Future migrations will go here... 256 | ;:datview/future-extension 257 | ;{:requires :datview/base-schema 258 | ;:txes 259 | ;[;; Domain types 260 | ;[{:db/id #db/id[:db.part/db] 261 | ;:db/ident :e.type/Category} 262 | ;{:db/id #db/id[:db.part/db] 263 | ;:db/ident :e.type/Tag}] 264 | ;;; Domain model attributes 265 | ;[{:db/id #db/id[:db.part/db] 266 | ;:db/ident :category/subcategory 267 | ;:db/valueType :db.type/ref 268 | ;:db/isComponent true 269 | ;:db/cardinality :db.cardinality/many 270 | ;:db/doc "Imaginary subcategories" 271 | ;:db.install/_attribute :db.part/db}]]} 272 | ;; End of schema 273 | 274 | 275 | 276 | -------------------------------------------------------------------------------- /src/.supress-folder-errors.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metasoarous/datview/42c1ee973f6b1e52932e2bcf94e783d3e424539b/src/.supress-folder-errors.keep -------------------------------------------------------------------------------- /src/dat/sub.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.sub 2 | (:require-macros [reagent.ratom :refer [reaction]] 3 | [cljs.core.async.macros :as async-macros :refer [go go-loop]] 4 | [servant.macros :refer [defservantfn]]) 5 | (:require 6 | ;[dat.reactor :as reactor] 7 | ;[dat.reactor.dispatcher :as dispatcher] 8 | ;[dat.view.representation :as representation] 9 | ;[dat.view.router :as router] 10 | ;[dat.view.utils :as utils] 11 | ;[dat.view.context :as context] 12 | [dat.view.utils :as utils] 13 | [dat.view.query :as query] 14 | ;[dat.view.routes :as routes] 15 | ;[dat.view.settings :as settings] 16 | ;[dat.spec.protocols :as protocols] 17 | ;; Things outside datsys, but intimately tied to datsys 18 | [datascript.core :as d] 19 | [posh.reagent :as posh] 20 | [reagent.core :as r] 21 | [reagent.ratom :as ratom :include-macros true] 22 | [re-com.core :as re-com] 23 | ;; Other stuff 24 | [taoensso.timbre :as log :include-macros true] 25 | [com.stuartsierra.component :as component] 26 | ;[clojure.walk :as walk] 27 | [cljs.core.async :as async :refer [chan close! timeout put! !]] 28 | ;[cljs.spec :as s] 29 | ;[cljs.core.match :as match :refer-macros [match]] 30 | [servant.core :as servant] 31 | [servant.worker :as worker] 32 | [com.stuartsierra.component :as component] 33 | [datascript.core :as d] 34 | [reagent.core :as r])) 35 | 36 | 37 | ;; This should realy be moved out to it's own thing, but I'll leave it in datview for now, while incubating. 38 | 39 | (defrecord ServantManager 40 | [worker-count worker-script servant-channel] 41 | component/Lifecycle 42 | (start [component] 43 | (log/info ">> Starting ServantManager") 44 | (let [servant-channel (or servant-channel (servant/spawn-servants worker-count worker-script))] 45 | (assoc component :servant-channel servant-channel))) 46 | (stop [component] 47 | ;; Here you have the ability to specify how many servants to kill off. 48 | (log/info "<< Stopping ServantManager") 49 | (servant/kill-servants servant-channel worker-count) 50 | (assoc component :servant-channel nil))) 51 | 52 | 53 | ;(defn servant-reaction 54 | ; [app cache servant-f args options] 55 | ; (let [;conn (:conn app) ;; need to think about how to treat conn separately 56 | ; servant-channel (-> app :servant :servant-channel) 57 | ; options (merge default-pull-options 58 | ; options) 59 | ; answer-atom (if (:dat.sub/cache? options) 60 | ; (if-let [cached-ans (get @cache args)] 61 | ; cached-ans 62 | ; (let [new-ans (r/atom (:dat.sub/default options))] 63 | ; (swap! cache assoc args new-ans) 64 | ; new-ans)) 65 | ; (r/atom (:dat.sub/default options)))] 66 | ; (reaction 67 | ; (let [;db @conn ;; TODO This is where we need to add posh filters when appropriate 68 | ; args (map utils/deref-or-value args) 69 | ; result-channel (apply servant/servant-thread servant-channel servant/standard-message servant-f args)] 70 | ; (go 71 | ; (let [ans (ServantManager (merge 83 | default-servant-options 84 | options))) 85 | ([] 86 | (new-servant-manager {}))) 87 | 88 | 89 | (defservantfn dostuff 90 | [x y] 91 | (* x y)) 92 | 93 | 94 | (defn dostuff-reaction 95 | [servant-manager x y] 96 | (let [a (r/atom nil)] 97 | (log/debug "Making a dostuff-reaction with x y:" x y) 98 | (log/debug "Servant channel" (:servant-channel servant-manager)) 99 | (let [result-chan (servant/servant-thread (:servant-channel servant-manager) servant/standard-message dostuff x y)] 100 | (log/debug "Servant thread created!") 101 | (go (let [result (> "datview-schema.edn" 8 | ;; Swap out once a lib XXX TODO 9 | io/resource 10 | slurp 11 | (edn/read-string {:readers *data-readers*}))) 12 | 13 | ;; Other things for the clj version? 14 | 15 | -------------------------------------------------------------------------------- /src/dat/view.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view 2 | "# Datview" 3 | (:require-macros [reagent.ratom :refer [reaction]] 4 | [cljs.core.async.macros :as async-macros :refer [go go-loop]]) 5 | (:require [dat.reactor :as reactor] 6 | [dat.reactor.dispatcher :as dispatcher] 7 | [dat.view.representation :as representation] 8 | [dat.view.router :as router] 9 | [dat.view.utils :as utils] 10 | [dat.view.context :as context] 11 | [dat.view.query :as query] 12 | [dat.view.routes :as routes] 13 | [dat.view.settings :as settings] 14 | [dat.spec.protocols :as protocols] 15 | ;; Things outside datsys, but intimately tied to datsys 16 | [datascript.core :as d] 17 | [posh.reagent :as posh] 18 | [reagent.core :as r] 19 | [reagent.ratom :as ratom] 20 | [re-com.core :as re-com] 21 | ;; Other stuff 22 | [datafrisk.core :as frisk] 23 | [taoensso.timbre :as log :include-macros true] 24 | [com.stuartsierra.component :as component] 25 | [clojure.walk :as walk] 26 | [goog.date.Date] 27 | [cljs-time.core :as cljs-time] 28 | [cljs.core.async :as async] 29 | [cljs.spec.alpha :as s] 30 | [cljs-time.format] 31 | [cljs-time.coerce] 32 | [cljs.pprint :as pp] 33 | [cljs.core.match :as match :refer-macros [match]] 34 | [markdown.core :as md] 35 | [dat.view.styles :as styles] 36 | [re-com.input-time])) 37 | 38 | 39 | 40 | (defn- time->mins 41 | [time] 42 | (rem time 100)) 43 | (defn- time->hrs 44 | [time] 45 | (quot time 100)) 46 | 47 | 48 | ;; ## Represent 49 | 50 | ;; This is really the cornerstone of all of dat.view 51 | ;; This multimethod represents the abstract ability to render/represent something based on abstract context 52 | 53 | (def represent 54 | "Maps args `[app context data]` to a representation (hiccup, most likely) as dispatched by (first context). Representations can 55 | be added via register-representation. 56 | 57 | Note: State is currently in a var in dat.view.representation; There will maybe eventually be a default such, but it 58 | would be good to make it possible to not do that." 59 | representation/represent) 60 | 61 | (def register-representation 62 | "Registers a representation function (maping of args args `[app context data]` to a view representation) for a given 63 | context-id (the first value of `context := [context-id context-data]`). as dispatched by (first context). Representations can 64 | be added via register-representation. 65 | 66 | Note: State is currently in a var in dat.view.representation; There will maybe eventually be a default such, but it 67 | would be good to manage the state yourself." 68 | representation/register-representation) 69 | 70 | 71 | 72 | ;; ## Events 73 | 74 | ;; Speccing some things out about events. 75 | ;; Much of this should all get moved over to the datspec namespace probably. 76 | ;; Only datview specific things should stay here. 77 | 78 | 79 | (s/def ::event-id (s/and keyword? namespace)) 80 | 81 | (s/def ::event (s/and vector? (s/cat :event-id ::event-id 82 | :event-data (constantly true)))) 83 | 84 | (s/def ::conn d/conn?) 85 | 86 | (s/def ::dispatcher #(satisfies? protocols/PDispatcher %)) 87 | 88 | ;; TODO: 89 | (s/def ::base-context map?) 90 | 91 | 92 | 93 | ;;abstraction over a sente connection 94 | (s/def ::remote (s/and #(satisfies? protocols/PRemoteSendEvent %) 95 | #(satisfies? protocols/PRemoteEventChan %))) 96 | 97 | 98 | (s/def ::app (s/keys :req-un [::conn ::dispatcher ::base-context] 99 | :opt-un [::remote])) 100 | 101 | 102 | 103 | ;; Some wrappers for convenience 104 | 105 | (defn dispatch! 106 | ([app event] 107 | (dispatcher/dispatch! (:dispatcher app) event)) 108 | ([app event level] 109 | (dispatcher/dispatch! (:dispatcher app) event level))) 110 | 111 | (s/def ::dispatch-args (s/cat :app ::app :event ::event :level (s/? keyword?))) 112 | 113 | (s/fdef dispatch! 114 | :args ::dispatch-args 115 | :ret (constantly true)) 116 | 117 | (defn dispatch-error! 118 | [app event] 119 | (dispatcher/dispatch-error! (:dispatcher app) event)) 120 | 121 | (s/fdef dispatch-error! 122 | :args (s/cat :app ::app :event ::event) 123 | :ret (constantly true)) 124 | 125 | 126 | ;; TODO Should rename send-remote-tx! 127 | (defn send-tx! 128 | "Helper function for dispatching tx messages to server." 129 | [app tx-forms] 130 | ;; TODO This should be smarter, and look to see whether dat.sys is loaded, and dispatch occordingly 131 | (dispatch! app [:dat.sync.client/send-remote-tx tx-forms])) 132 | 133 | 134 | (defn send-remote-event! 135 | [app remote-event] 136 | (dispatch! app [:dat.remote/send-event! remote-event])) 137 | 138 | 139 | 140 | 141 | ;; Importing styles, etc 142 | 143 | (def box-styles styles/box-styles) 144 | (def h-box-styles styles/h-box-styles) 145 | (def v-box-styles styles/v-box-styles) 146 | (def bordered-box-style styles/bordered-box-style) 147 | 148 | ;; ## Metadata view specification structure defaults 149 | 150 | (defn box 151 | "Prefers children over child" 152 | [{:as args :keys [style children child]}] 153 | [:div {:style (merge box-styles style)} 154 | ;; Not sure yet if this will work as expected 155 | (or (seq children) child)]) 156 | 157 | ;; For debugging 158 | 159 | (defn debug-str 160 | ([message data] 161 | (str message (debug-str data))) 162 | ([data] 163 | (with-out-str (pp/pprint data)))) 164 | 165 | (defn debug 166 | ([message data] 167 | [:div.debug 168 | [:p message] 169 | [:pre {:style {:max-height "300px" :overflow-y "auto"}} (debug-str data)]]) 170 | ([data] 171 | (debug "" data))) 172 | 173 | 174 | 175 | ;; Default view when a representation can't be found 176 | 177 | 178 | (representation/register-representation 179 | :default 180 | (fn [_ context data] 181 | [:div 182 | [:h4 "No representation for:"] 183 | [debug "context:" context] 184 | [debug "data:" data]])) 185 | 186 | 187 | 188 | (def base-pull 189 | [* {:e/type [*]}]) 190 | 191 | 192 | 193 | ;; ## Reactions 194 | 195 | (def deref-or-value utils/deref-or-value) 196 | (def deep-merge utils/deep-merge) 197 | (def as-reaction utils/as-reaction) 198 | (def safe-q utils/safe-q) 199 | (def pull-many utils/pull-many) 200 | (def pull-attr utils/pull-attr) 201 | (def pull-path utils/pull-path) 202 | 203 | 204 | ;; Context 205 | 206 | (def default-base-context context/default-base-context) 207 | (def base-context context/base-context) 208 | (def update-base-context! context/update-base-context!) 209 | (def set-base-context! context/set-base-context!) 210 | (def attr-signature-reaction context/attr-signature-reaction) 211 | (def attribute-schema-reaction context/attribute-schema-reaction) 212 | (def component-context context/component-context) 213 | 214 | 215 | 216 | ;; ## DataScript schema 217 | 218 | ;; Some basic schema that needs to be transacted into the database in order for these functions to work 219 | 220 | (def base-schema 221 | {:dat.view.base-context/value {}}) 222 | 223 | (def default-settings 224 | [{:db/ident ::base-context 225 | :dat.view.base-context/value {}}]) 226 | 227 | ;; Have to think about how styles should be separated from container structure, etc, and how things like 228 | ;; little control bars can be modularly extended, etc. 229 | ;; How can this be modularized enough to be truly generally useful? 230 | 231 | ;; These should be moved into styles ns or something 232 | 233 | 234 | 235 | ;; ## Client Helper components 236 | 237 | ;; Need to think about the abstract shape of a control like a button 238 | 239 | (defn loading-notification 240 | [message] 241 | [re-com/v-box 242 | :style {:align-items "center" 243 | :justify-content "center"} 244 | :gap "15px" 245 | :children 246 | [[re-com/title :label message] 247 | [re-com/throbber :size :large]]]) 248 | 249 | 250 | (defn collapse-button 251 | "A collapse button for hiding information; arg collapse? should be a bool or an ratom thereof. 252 | If no click handler is specified, toggles the atom." 253 | ([collapse? on-click-fn] 254 | (let [[icon-name tooltip] (if (utils/deref-or-value collapse?) ;; not positive this will work the way I expect 255 | ["zmdi-caret-right" "Expand collection"] 256 | ["zmdi-caret-down" "Hide collection"])] 257 | [re-com/md-icon-button :md-icon-name icon-name 258 | :tooltip tooltip 259 | :on-click on-click-fn])) 260 | ([collapse?] 261 | (collapse-button collapse? (fn [] (swap! collapse? not))))) 262 | 263 | 264 | 265 | ;; ## Builder pieces 266 | 267 | ;; These are builder pieces part of the public api; 268 | ;; These should be accessible for wrapping, and should be overridable/extensible via correspondingly named keys of the context map at various entry points 269 | 270 | (defn ^:dynamic pull-summary-string 271 | [pull-data] 272 | (match [pull-data] 273 | [{:e/name name}] name 274 | [{:attribute/label label}] label 275 | [{:db/ident ident :e/type {:db/ident :e.type/Type}}] (str (name ident) " Type") 276 | [{:db/ident ident}] (name ident) 277 | [{:e/type {:db/ident type-ident}}] (str (name type-ident) " instance") 278 | ;; A terrible assumption really, but fine enough for now 279 | :else (pr-str pull-data))) 280 | 281 | 282 | (representation/register-representation 283 | ::pull-summary-string 284 | (fn [_ _ pull-data] 285 | [:span #_:label (pull-summary-string pull-data)])) 286 | 287 | 288 | (representation/register-representation 289 | ::pull-summary-view 290 | (fn [app [_ context] pull-data] 291 | [:div (:dom/attrs context) 292 | [represent app [::pull-summary-string (:dat.view.context/locals context)] pull-data]])) 293 | 294 | (defn pull-summary-view 295 | [app context pull-data] 296 | [represent app [::pull-summary-view (:dat.view.context/locals context)] pull-data]) 297 | 298 | 299 | (representation/register-representation 300 | ::collapse-summary 301 | (fn [app [_ context] values] 302 | ;; XXX Need to stylyze and take out of re-com styling 303 | (let [local-context (:dat.view.context/locals context)] 304 | (if (map? values) 305 | [represent app [::pull-summary-view local-context] values] 306 | [:div {:style (merge h-box-styles 307 | {:padding "10px"})} 308 | ;:align :end})} 309 | ;:gap "20px" 310 | ;[debug "collapse-vals: " values] 311 | (for [value values] 312 | ^{:key (hash value)} 313 | [represent app [::pull-summary-view local-context] value])])))) 314 | 315 | (defn collapse-summary 316 | [app context values] 317 | [represent app [::collapse-summary (:dat.view.context/locals context)] values]) 318 | 319 | 320 | 321 | ;; ## Attribute view 322 | 323 | ;; View all of the values for some entity, attribute pair 324 | ;; Values must be passed in explicitly, or in an atom 325 | 326 | (defn lablify-attr-ident 327 | [attr-ident] 328 | (let [[x & xs] (clojure.string/split (name attr-ident) #"-")] 329 | (clojure.string/join " " (concat [(clojure.string/capitalize x)] xs)))) 330 | 331 | 332 | (def label-styles 333 | {:font-size "14px" 334 | :font-weight "bold"}) 335 | 336 | (representation/register-representation 337 | ::label-view 338 | (fn [app _ attr-ident] 339 | [:div 340 | (when attr-ident 341 | [re-com/label 342 | :style label-styles 343 | :label 344 | (or (when (= attr-ident :db/id) "DB ID") 345 | (:attribute/label @(posh/pull (:conn app) [:db/id :db/ident :attribute/label] [:db/ident attr-ident])) 346 | (lablify-attr-ident attr-ident))])])) 347 | 348 | (defn label-view 349 | "For a given attr-ident, render a label for that attribute." 350 | ([app context attr-ident] 351 | (let [local-context (:dat.view.context/locals context)] 352 | [represent app [::label-view local-context] attr-ident])) 353 | ([app attr-ident] 354 | (label-view app {} attr-ident))) 355 | 356 | 357 | (defn get-nested-pull-expr 358 | [pull-expr attr-ident] 359 | (or 360 | (some (fn [attr-entry] 361 | (cond 362 | ;; Not sure if these :component assignments are the right ticket 363 | (and (keyword? attr-entry) (= attr-entry attr-ident)) 364 | ;^{::component summary-view} 365 | '[*] 366 | (and (map? attr-entry) (get attr-entry attr-ident)) 367 | (get attr-entry attr-ident) 368 | :else false)) 369 | pull-expr) 370 | ;^{::component summary-view} 371 | '[*])) 372 | 373 | ;; Summary needs to be handled somewhat more cleverly... Set up as a special function that returns the corresponding pull-expr component? 374 | 375 | 376 | ;; Still need to hook up with customized context 377 | 378 | (representation/register-representation 379 | ::copy-entity-control 380 | (fn [app _ pull-data] 381 | (let [pull-data (utils/deref-or-value pull-data)] 382 | ;; TODO Need to figure out the right way to configure the re-com components 383 | [re-com/md-icon-button :md-icon-name "zmdi-copy" 384 | :size :smaller 385 | :style {:margin-right "10px"} 386 | :tooltip "Copy entity" ;; XXX Should make tooltip fn-able 387 | :on-click (fn [] (js/alert "Coming soon to a database application near you"))]))) 388 | 389 | (representation/register-representation 390 | ::edit-entity-control 391 | (fn [app [_ context] pull-data] 392 | (let [pull-data (utils/deref-or-value pull-data)] 393 | [re-com/md-icon-button :md-icon-name "zmdi-edit" 394 | :style {:margin-right "10px"} 395 | :size :smaller 396 | :tooltip "Edit entity" 397 | ;; This assumes the pull has :dat.sync.remote.db/id... automate? 398 | ;; This now just toggles an edit? r/atom passed down by the parent, so the parent is responsible for rendering. 399 | :on-click (fn [] (swap! (::edit? context) not))]))) 400 | ;; Should be possible to specify the callback here so you could do the old behavior of routing to a form as well 401 | ;(router/set-route! app {:handler :edit-entity :route-params {:db/id (:dat.sync.remote.db/id pull-data)}}))]))) 402 | 403 | 404 | 405 | (defn get-remote-eid 406 | [app eid] 407 | @(pull-attr (:conn app) eid :dat.sync.remote.db/id)) 408 | ;(:dat.sync.remote.db/id (d/pull @(:conn app) [:dat.sync.remote.db/id] eid))) 409 | 410 | (defn delete-entity-handler* 411 | [app eid] 412 | (when (js/confirm "Delete entity?") 413 | (log/info "Deleting entity:" eid) 414 | (if-let [remote-eid (get-remote-eid app eid)] 415 | (do 416 | (log/debug "Deleting entity (remote-eid):" remote-eid) 417 | (send-remote-event! app [:dat.sync.remote/tx [[:db.fn/retractEntity remote-eid]]])) 418 | (log/error "Unable to find remote db id for entity" (d/pull @(:conn app) '[*] eid))))) 419 | 420 | (defn ^:dynamic delete-entity-handler 421 | [app eid] 422 | (delete-entity-handler* app eid)) 423 | 424 | (representation/register-representation 425 | ::delete-entity-control 426 | (fn [app _ data] 427 | (let [eid (if (map? data) 428 | (:db/id data) 429 | data)] 430 | [re-com/md-icon-button 431 | :md-icon-name "zmdi-delete" 432 | :size :smaller 433 | :tooltip "Delete entity" 434 | ;; TODO Should be dispatching instead 435 | :on-click (partial delete-entity-handler app eid)]))) 436 | 437 | 438 | 439 | ;; TODO Need a way to figure out which controls are needed for a given component 440 | (defn component-controls 441 | [context] 442 | ;; For now.. 443 | (::controls context)) 444 | 445 | (representation/register-representation 446 | ::control-set 447 | (fn [app [_ context] data] 448 | (let [local-context (:dat.view.context/locals context)] 449 | ;; XXX This was ::pull-view-controls, now ::control-set 450 | [:div (:dom/attrs context) 451 | (for [control-id (distinct (component-controls context))] 452 | ^{:key (hash control-id)} 453 | [represent app [control-id local-context] data])]))) 454 | 455 | ;(defn controls-middleware) 456 | 457 | 458 | ;; TODO Set up defaults ::copy-entity-control ::edit-entity-control 459 | ;(defn default-pull-view-controls 460 | ; [app context pull-data] 461 | ; (let [context [::controls (assoc context ::controls [::copy-entity-control ::edit-entity-control])]] 462 | ; (represent app context pull-data))) 463 | 464 | 465 | ;; Hmm... decided I don't like the [attr-ident value] thing; attr-ident should really be part of the context. 466 | ;; If not present, should just default. 467 | ;; Maybe slightly less than ideal for refs, but still valueable I think. 468 | ;; Attr ident is really just context, which we may or may not need. 469 | ;; Update: Still waffling on this... Went the other way in forms; maybe better to be consistent... 470 | (representation/register-representation 471 | ::value-view 472 | ;; QUESTION Should attr-ident be part of the context-data? 473 | (fn [app [_ context] value] 474 | (let [attr-ident (:db.attr/ident context) 475 | attr-sig @(attr-signature-reaction app attr-ident)] 476 | [:div (:dom/attrs context) 477 | ;[debug "context dom/attrs:" (:dom/attrs context)] 478 | (match [attr-sig] 479 | ;; For now, all refs render the same; May treat component vs non-comp separately later 480 | [{:db/valueType :db.type/ref}] 481 | ;; This is something that will need to be generalized 482 | (let [nested-context (update (:dat.view.context/locals context) ::pull-expr get-nested-pull-expr attr-ident)] 483 | ;; QUESTION: Where should the nsted pull-expr go? 484 | [represent app [::pull-data-view nested-context] value]) 485 | ;; Miscellaneous value 486 | :else 487 | (str value))]))) 488 | 489 | 490 | ;; TODO Need to figure out the signature here 491 | ;(defn value-view 492 | ; [app pull-expr attr-ident value] 493 | 494 | 495 | 496 | ;; Should we have a macro for building these components and dealing with all the state in the context? Did the merge for you? 497 | ;(defn build-view-component) 498 | 499 | (representation/register-representation 500 | ::attr-values-view 501 | (fn [app [_ context] values] 502 | (let [;; Should put all of the collapsed values in something we can serialize, so we always know what's collapsed 503 | collapse-attribute? (r/atom (::collapsed? context)) 504 | local-context (:dat.view.context/locals context)] 505 | (fn [app [_ context] values] 506 | (let [collapsable? (::collapsable? context)] 507 | [:div (:dom/attrs context) 508 | (when collapsable? 509 | [collapse-button collapse-attribute?]) 510 | (when @collapse-attribute? 511 | [collapse-summary app local-context values]) 512 | ;(defn pull-summary-view [app pull-expr pull-data] 513 | (when (or (not collapsable?) (and collapsable? (not @collapse-attribute?))) 514 | (for [value (utils/deref-or-value values)] 515 | ^{:key (hash value)} 516 | [represent app [::value-view local-context] value]))]))))) 517 | 518 | 519 | ;(defn attr-values-view 520 | ; [app context attr-ident values]) 521 | 522 | 523 | ;; Can add matches to this to get different attr-idents to match differently; Sould do multimethod? 524 | ;; Cardinality many ref attributes should have an :attribute.ref/order-by attribute, and maybe a desc option 525 | ;; as well 526 | (defn sorted-values 527 | [app attr-ident values] 528 | (if-let [sort-by-attr (:attribute/sort-by @(attr-signature-reaction app attr-ident))] 529 | (sort-by sort-by-attr values) 530 | values)) 531 | 532 | 533 | ;; Need to have controls etc here 534 | (representation/register-representation 535 | ::attr-view 536 | ;; XXX Should be passing through [e :attr-ident values] just like in forms 537 | (fn [app [_ context] values] 538 | (let [attr-ident (:db.attr/ident context) 539 | attr-signature @(attr-signature-reaction app attr-ident) 540 | local-context (:dat.view.context/locals context) 541 | child-context (merge local-context (get-in local-context [::ref-attrs attr-ident])) 542 | values (sorted-values app attr-ident values)] 543 | [:div (:dom/attrs context) 544 | [:div {:style (merge dat.view/v-box-styles)} 545 | [represent app [::label-view (assoc child-context ::attr-signature attr-signature)] attr-ident] 546 | [represent app [::control-set (assoc child-context ::controls (::controls context))] values]] 547 | (match [attr-signature] 548 | [{:db/cardinality :db.cardinality/many}] 549 | [represent app [::attr-values-view child-context] values] 550 | :else 551 | [represent app [::value-view child-context] values])]))) 552 | 553 | 554 | ;(defn attr-view 555 | ; [app pull-expr attr-ident values]) 556 | 557 | 558 | ;; All rendering modes should be controllable via registered toggles or fn assignments 559 | ;; registration modules for plugins 560 | ;; * middleware? 561 | 562 | 563 | (defn attr-entity-order 564 | ;; This is terrible assumption; This thing should be querying for it's own data, ideally, which should be okay if we're caching 565 | ;; In particular, we shouldn't need to do `:db.type/ref?` here... 566 | [attr-data] 567 | (or (:e/order attr-data) 568 | (cond 569 | (:db/isComponent attr-data) 10 570 | (:db.type/ref? attr-data) 5 571 | :else 0))) 572 | 573 | (def attr-order 574 | (memoize 575 | (fn [app attr] 576 | (reaction 577 | (cond 578 | (keyword? attr) 579 | (attr-entity-order 580 | @(attr-signature-reaction app attr)) 581 | (map? attr) 582 | (attr-entity-order attr)))))) 583 | 584 | 585 | (defn pull-attributes 586 | ([pull-expr pull-data] 587 | (-> pull-expr 588 | deref-or-value 589 | (->> (map (fn [attr-spec] 590 | (cond 591 | (keyword? attr-spec) attr-spec 592 | (map? attr-spec) (keys attr-spec) 593 | (symbol? attr-spec) 594 | (case attr-spec 595 | '* (filter 596 | (set (pull-attributes (remove #{'*} pull-expr) [])) 597 | (keys (utils/deref-or-value pull-data)))))))) 598 | flatten 599 | (concat (keys pull-data)) 600 | distinct)) 601 | ([pull-expr] 602 | (pull-attributes pull-expr []))) 603 | 604 | 605 | (representation/register-representation 606 | ::pull-data-view 607 | (fn [app [_ context] pull-data] 608 | ;; Annoying to have to do this 609 | (let [;; TODO Ignoring the component context 610 | ;; TODO Insert collapse here 611 | ;; here we go on collapse 612 | collapse-attribute? (r/atom (::collapsed? context)) 613 | edit? (r/atom nil) 614 | copy? (r/atom nil) 615 | copy (r/atom nil)] 616 | (fn [app [_ context] pull-data] 617 | (let [local-context (:dat.view.context/locals context) 618 | collapsable? (::collapsable? context) 619 | pull-expr (::pull-expr context) 620 | pull-data (utils/deref-or-value pull-data)] 621 | [:div {:style h-box-styles} 622 | (when collapsable? 623 | [collapse-button collapse-attribute?]) 624 | (when @collapse-attribute? 625 | [collapse-summary app context pull-data]) 626 | ;(defn pull-summary-view [app pull-expr pull-data] 627 | (when (or (not collapsable?) (and collapsable? (not @collapse-attribute?))) 628 | [:div (:dom/attrs context) 629 | [:div {:style (merge v-box-styles)} 630 | [represent app [::pull-summary-view local-context] pull-data] 631 | (let [local-context (assoc local-context 632 | ::controls (::controls context) 633 | ::edit? edit? 634 | ::copy? copy? 635 | ::copy copy)] 636 | [represent app [::control-set local-context] pull-data])] 637 | ;; XXX TODO Questions: 638 | ;; Need a react-id function that lets us repeat attrs when needed 639 | (for [attr-ident (sort-by (comp deref (partial attr-order app)) 640 | (pull-attributes pull-expr pull-data))] 641 | (when-let [values (get pull-data attr-ident)] 642 | ^{:key (hash attr-ident)} 643 | [represent app [::attr-view (assoc local-context :db.attr/ident attr-ident)] values])) 644 | ;; Part of clever trick to avoid having to rerender form when toggling 645 | (when-not (nil? @edit?) 646 | [:div {:style (merge h-box-styles 647 | {:padding "15px" 648 | :width "100%"} 649 | ;; Part of clever trick to avoid having to rerender form when toggling 650 | (when-not @edit? {:display "none"}))} 651 | [:h3 "Editing"] 652 | [represent app [::pull-form local-context] pull-data]]) 653 | (when-not (nil? @copy?) 654 | [:div {:style (merge h-box-styles 655 | {:padding "15px"} 656 | ;; Part of clever trick to avoid having to rerender form when toggling 657 | (when-not @copy? {:display "none"}))} 658 | [:h3 "Copying"] 659 | [represent app [::pull-form local-context] pull-data]])])]))))) 660 | 661 | 662 | ;; See definition below 663 | (declare meta-context) 664 | (declare entity-pull) 665 | 666 | ;; Note that here we extract the meta-context from the pull-expr 667 | 668 | (representation/register-representation 669 | ::pull-view 670 | (fn [app [_ context] [pull-expr eid]] 671 | ;; QUESTION Should this pull-expr computation be a function for reuse? 672 | (let [;pull-expr (or pull-expr (::pull-expr context) @(entity-pull app eid) base-pull) 673 | pull-expr @(entity-pull app eid (::pull-summary-attrs context)) 674 | pull-data (posh/pull (:conn app) pull-expr eid) 675 | child-context (-> (:dat.view.context/locals context) 676 | ;; !!! Extract and merge the metadata context from the pull expression 677 | (merge (meta-context pull-expr)) 678 | (assoc ::pull-expr pull-expr))] 679 | ;; TODO We are also associng in the pull expr above somewhere; Should make these play nice together and decide on precedence 680 | [:div 681 | [represent app [::pull-data-view child-context] pull-data]]))) 682 | 683 | 684 | (defn pull-data-view 685 | "Given a DS connection, a app pull-expression and data from that pull expression (possibly as a reaction), 686 | render the UI subject to the pull-expr metadata." 687 | ;; Should be able to bind the data to the type dictated by pull expr 688 | ([app context pull-data] 689 | [represent app [::pull-data-view context] pull-data]) 690 | ([app pull-data] 691 | (pull-data-view app {} pull-data))) 692 | 693 | (defn pull-view 694 | ([app eid] 695 | [pull-view app @(entity-pull app eid) eid]) 696 | ([app pull-expr eid] 697 | (let [pull-expr (deref-or-value pull-expr)] 698 | [pull-view app (meta-context pull-expr) pull-expr eid])) 699 | ([app context pull-expr eid] 700 | [represent app [::pull-view context] [pull-expr eid]])) 701 | 702 | ;; General purpose sortable collections in datomic/ds? 703 | ;; Should use :attribute/sort-by; default :db/id? 704 | 705 | 706 | 707 | 708 | 709 | ;; ## Forms!! 710 | 711 | 712 | ;; I've decide to move everything over here, since it will now be assumed that if you want datview, you want it's form functionality 713 | ;; Not sure if this makes sense or not yet, but it's my running design. 714 | 715 | ;; Holy shit... there's gonna be a lot of work to do here... 716 | ;; Need to rewrite everything in terms of represent 717 | 718 | 719 | (declare pull-form) 720 | 721 | (defn cast-value-type 722 | [value-type-ident str-value] 723 | (case value-type-ident 724 | (:db.type/double :db.type/float) (js/parseFloat str-value) 725 | (:db.type/long :db.type/integer) (js/parseInt str-value) 726 | str-value)) 727 | 728 | 729 | ;; TODO Rewrite in terms of event registration 730 | (defn make-change-handler 731 | "Takes an app, an eid attr-ident and an old value, and builds a change handler for that value" 732 | [app eid attr-ident old-value] 733 | ;; This whole business with the atom here is sloppy as hell... Will have to clean up with smarter delta 734 | ;; tracking in database... But for now... 735 | (let [current-value (r/atom old-value) 736 | value-type-ident (d/q '[:find ?value-type-ident . 737 | :in $ % ?attr-ident 738 | :where (attr-ident-value-type-ident ?attr-ident ?value-type-ident)] 739 | @(:conn app) 740 | query/rules 741 | attr-ident)] 742 | (fn [new-value] 743 | (let [old-value @current-value 744 | new-value (cast-value-type value-type-ident new-value)] 745 | (when (not= old-value new-value) 746 | ;; This isn't as atomic as I'd like XXX 747 | (reset! current-value new-value) 748 | (send-tx! 749 | app 750 | (concat 751 | (when old-value [[:db/retract eid attr-ident old-value]]) 752 | ;; Probably need to cast, since this is in general a string so far 753 | [[:db/add eid attr-ident new-value]]))))))) 754 | 755 | 756 | (defn apply-reference-change! 757 | ([app eid attr-ident new-value] 758 | (apply-reference-change! app eid attr-ident nil new-value)) 759 | ([app eid attr-ident old-value new-value] 760 | (let [old-value (match [old-value] 761 | [{:db/id id}] id 762 | [id] id) 763 | {new-value-id :dat.sync.remote.db/id new-value-ident :db/ident} (d/pull @(:conn app) '[:dat.sync.remote.db/id :db/ident] new-value) 764 | {old-value-id :dat.sync.remote.db/id old-value-ident :db/ident} (d/pull @(:conn app) '[:dat.sync.remote.db/id :db/ident] old-value) 765 | new-value (or new-value-id new-value-ident new-value) 766 | old-value (or old-value-id old-value-ident old-value)] 767 | (send-tx! app 768 | (concat (when-not (nil? new-value) 769 | [[:db/add eid attr-ident new-value]]) 770 | (when-not (nil? old-value) 771 | [[:db/retract eid attr-ident old-value]])))))) 772 | 773 | 774 | ;; this is doing strange things with options when we memoize it, so leaving that out for now... 775 | ;(def ref-attr-options nil) 776 | 777 | 778 | (def ref-attr-options 779 | (memoize 780 | (fn 781 | ([app attr-ident] 782 | (ref-attr-options app attr-ident nil)) 783 | ([app attr-ident sort-key] 784 | (ref-attr-options app attr-ident sort-key {})) 785 | ([app attr-ident sort-key posh-options] 786 | (let [posh-options (merge {:cache :forever} posh-options) 787 | sort-key (or sort-key :db/id)] 788 | (reaction 789 | (log/debug "CALLING REF_ATTR_OPTIONS!!!" attr-ident "with posh options" posh-options) 790 | (let [options 791 | (or (seq (:attribute.ref/options 792 | @(posh/pull 793 | (:conn app) 794 | '[{:attribute.ref/options [:db/id :db/ident * {:e/type [*]}]}] 795 | [:db/ident attr-ident] 796 | posh-options))) 797 | (let [eids 798 | ;@(posh/q '[:find [(pull ?e [:db/id :db/ident * {:e/type [*]}]) ...]]) 799 | @(posh/q '[:find [?e ...] 800 | :in $ ?attr 801 | :where [?attr :attribute.ref/types ?type] 802 | [?e :e/type ?type]] 803 | (:conn app) 804 | [:db/ident attr-ident] 805 | posh-options)] 806 | ;; NOTE This appears to be quite a bit slower than the pull-many below, maybe because 807 | ;; of having to parse/preprocess the same pull expression over and over; 808 | ;; TODO Should be fixed in posh ultimately, maybe with a posh/pull-many 809 | ;(mapv (comp deref (partial posh/pull (:conn app) '[* {:e/type [*]}])) 810 | ;eids)))] 811 | (d/pull-many @(:conn app) '[* {:e/type [*]}] eids)))] 812 | ;@(posh/q '[:find [(pull ?e [:db/id :db/ident * {:e/type [*]}]) ...] 813 | ; :in $ % ?attr 814 | ; :where [?attr :attribute.ref/types ?type] 815 | ; (type-instance ?type ?e)] 816 | ; (:conn app) 817 | ; query/rules 818 | ; [:db/ident attr-ident] 819 | ; posh-options))] 820 | (->> options 821 | (sort-by sort-key) 822 | vec)))))))) 823 | 824 | ;; TODO Need constext here for a better sort-by specification; switch to representation 825 | (defn select-entity-input 826 | ([app context eid attr-ident value] 827 | ;; XXX value arg should be safe as a reaction here 828 | (let [options (deref-or-value 829 | (or (:dat.view/options context) 830 | (ref-attr-options app attr-ident (:dat.view.options/sort-by context))))] 831 | [select-entity-input app context eid attr-ident value options])) 832 | ([app context eid attr-ident value options] 833 | (let [value (utils/deref-or-value value) 834 | ;; TODO We need to be able to switch between these for remote vs local 835 | id-fn (or (::id-fn context) :db/id) 836 | ;id-fn (or (::id-fn context) :dat.sync.remote.db/id) 837 | value (or (id-fn value) 838 | (and (vector? value) @(pull-attr (:conn app) value id-fn)) 839 | value)] 840 | [:div {:style h-box-styles} 841 | [re-com/single-dropdown 842 | :style {:min-width "150px"} 843 | :filter-box? true 844 | :choices options 845 | ;; TODO Not sure if this will break things or not; have to test 846 | ;:model (:db/id value) 847 | :id-fn id-fn 848 | ;; For now hard coding this... For some reason using the summary function here is messing everything up 849 | :label-fn (or (::label-fn context) pull-summary-string) 850 | :model value 851 | :on-change (partial apply-reference-change! app eid attr-ident value)] 852 | (when-not (nil? value) 853 | [re-com/md-icon-button :md-icon-name "zmdi-close-circle" 854 | :size :smaller 855 | :style {:margin "3px 7px"} 856 | :tooltip "Retract" 857 | :on-click #(apply-reference-change! app eid attr-ident value nil)])]))) 858 | 859 | 860 | ;; Simple md (markdown) component; Not sure if we really need to include this in dat.view or not... 861 | (defn md 862 | [md-string] 863 | [re-com/v-box 864 | :children 865 | [[:div {:dangerouslySetInnerHTML {:__html (md/md->html md-string)}}]]]) 866 | 867 | 868 | ;; ### Datetimes... 869 | 870 | (defn datetime-with-time-int [datetime time-int] 871 | (let [dt (cljs-time/to-default-time-zone datetime) 872 | dt-with-time (cljs-time/local-date-time 873 | (cljs-time/year dt) 874 | (cljs-time/month dt) 875 | (cljs-time/day dt) 876 | (time->hrs time-int) 877 | (time->mins time-int) 878 | (cljs-time/second dt) 879 | (cljs-time/milli dt)) 880 | ;; FIXME: 2400 + second & milli does not exist 881 | dt-utc (cljs-time.coerce/to-date-time dt-with-time)] 882 | dt-utc)) 883 | 884 | (defn datetime-with-date [dt date] 885 | (log/info "date-val" date) 886 | (cljs-time/date-time (cljs-time/year date) (cljs-time/month date) (cljs-time/day date) (cljs-time/hour dt) (cljs-time/minute dt) (cljs-time/second dt) (cljs-time/milli dt))) 887 | 888 | (defn datetime-change-handler 889 | [app datetime-mask-fn eid attr-ident current-value new-partial-value] 890 | (let [old-value @current-value 891 | new-value (datetime-mask-fn old-value new-partial-value)] 892 | (reset! current-value new-value) 893 | (send-tx! app 894 | (concat (when old-value 895 | [[:db/retract eid attr-ident (cljs-time.coerce/to-date old-value)]]) 896 | [[:db/add eid attr-ident (cljs-time.coerce/to-date new-value)]])))) 897 | 898 | (defn datetime-date-change-handler 899 | [app eid attr-ident current-value new-date-value] 900 | (datetime-change-handler app datetime-with-date eid attr-ident current-value new-date-value)) 901 | 902 | (defn datetime-time-int-change-handler 903 | [app eid attr-ident current-value new-time-value] 904 | (datetime-change-handler app datetime-with-time-int eid attr-ident current-value new-time-value)) 905 | 906 | (defn datetime->time-int [datetime] 907 | (let [dt (cljs-time/to-default-time-zone datetime)] 908 | (+ (* 100 (cljs-time/hour dt)) 909 | (cljs-time/minute dt)))) 910 | 911 | (representation/register-representation 912 | ::datetime-selector 913 | (fn [app [_ context] [eid attr-ident value]] 914 | (let [current-utc-datetime (r/atom (or (cljs-time.coerce/from-date value) (cljs-time/now)))] 915 | ;;current-time-int (ratom/make-reaction (fn [] )) 916 | (fn [app [_ context] [eid attr-ident value]] 917 | [re-com/h-box 918 | :children 919 | [[re-com/datepicker-dropdown :model @current-utc-datetime 920 | :on-change (partial datetime-date-change-handler app eid attr-ident current-utc-datetime)] 921 | [re-com/input-time :model (datetime->time-int @current-utc-datetime) 922 | :on-change (partial datetime-time-int-change-handler app eid attr-ident current-utc-datetime)]]])))) 923 | 924 | (defn datetime-selector 925 | [app eid attr-ident value] 926 | [represent app [::datetime-selector {}] [eid attr-ident value]]) 927 | 928 | 929 | 930 | (defn boolean-selector 931 | [app eid attr-ident value] 932 | (let [current-value (atom value)] 933 | (fn [] 934 | [re-com/checkbox :model @current-value 935 | :on-change (fn [new-value] 936 | (let [old-value @current-value] 937 | (reset! current-value new-value) 938 | (send-tx! app 939 | (concat 940 | (when-not (nil? old-value) 941 | [[:db/retract eid attr-ident old-value]]) 942 | [[:db/add eid attr-ident new-value]]))))]))) 943 | 944 | 945 | ;; XXX Having to do a bunch of work it seems to make sure that the e.type/attributes properties are set up for views to render properly; 946 | ;; We're not getting time entries showing up on ui; 947 | ;; Not sure if not making the circuit or if something weird is going on. 948 | 949 | ;; XXX Also, it seems like right now we need the :db/id in the pull expressions; Need to find a way of requesting for other data when needed 950 | 951 | ;; XXX Should have option for collapse that would let you collapse all instances of some attribute, versus just one particular entity/attribute combo 952 | 953 | ;; Should have this effectively mutlitmethod dispatch using the dat.view customization functionality 954 | (defn input-for 955 | [app context [eid attr-ident value]] 956 | 957 | ;; This was in the old input-for function, which used to be defined in terms of the representation, not the 958 | ;; other way around as it is now. Not sure why this was necessary or if it was actually being used 959 | ;; anwhere or if we need it still 960 | ;(let [child-context (assoc (:dat.view.context/locals context) 961 | ;::pull-expr pull-expr)] 962 | ;[represent app [::input-for child-context] [eid attr-ident value]] 963 | 964 | ;; TODO Need to rewrite in terms of representations 965 | (let [attr @(attr-signature-reaction app attr-ident) 966 | pull-expr (::pull-expr context) 967 | local-context (:dat.view.context/locals context)] 968 | [:div (:dom/attrs context) 969 | ;; TODO This crap should be taken care of by middleware 970 | (let [control-context (assoc local-context ::controls (::controls context))] 971 | [represent app [::control-set control-context] [eid attr-ident value]]) 972 | (match [attr] 973 | ;; The first two forms here have to be compbined and the decision about whether to do a dropdown 974 | ;; left as a matter of the context (at least for customization); For now leaving though... XXX 975 | ;; We have an isComponent ref; do nested form 976 | ;; Should this clause just be polymorphic on whether value is a map or not? 977 | [{:db/valueType :db.type/ref :db/isComponent true}] 978 | ;; Need to assoc in the root node context here 979 | (let [sub-expr (some #(get % attr-ident) pull-expr) ;; XXX This may not handle a ref not in {} 980 | ;; Need to handle situation of a recur point ('...) as a specification; Should be the context pull root, or the passed in expr, if needed 981 | sub-expr (if (= sub-expr '...) (or (:dat.view/root-pull-expr context) pull-expr) sub-expr) 982 | local-context (assoc local-context ::pull-expr sub-expr) 983 | local-context (if (:dat.view/root-pull-expr context) 984 | local-context 985 | (assoc local-context :dat.view/root-pull-expr pull-expr))] 986 | ;(when-not (= (:db/cardinality attr) :db.cardinality/many) 987 | ;;(nil? value)) 988 | [pull-form app local-context sub-expr value]) 989 | ;; This is where we can insert something that catches certain things and handles them separately, depending on context 990 | ;[{:db/valueType :db.type/ref} {:dat.view.level/attr {?}}] 991 | ;[pull-form app context-data (get pull-expr value)] 992 | ;; TODO Need to redo all the below as representations 993 | ;; Non component entity; Do dropdown select... 994 | [{:db/valueType :db.type/ref}] 995 | [select-entity-input app context eid attr-ident value] 996 | ;; Need separate handling of datetimes 997 | [{:db/valueType :db.type/instant}] 998 | [datetime-selector app eid attr-ident value] 999 | ;; Booleans should be check boxes 1000 | [{:db/valueType :db.type/boolean}] 1001 | [boolean-selector app eid attr-ident value] 1002 | ;; For numeric inputs, want to style a little differently 1003 | [{:db/valueType (:or :db.type/float :db.type/double :db.type/integer :db.type/long)}] 1004 | (vec (concat [(if (::text-rows context) re-com/input-textarea re-com/input-text) 1005 | :model (str value) ;; just to make sure... 1006 | :style (::input-style context) ;; TODO Get input-style passed along through everywhere else 1007 | :width (-> context ::input-style :width) 1008 | :on-change (make-change-handler app eid attr-ident value)] 1009 | (when-let [placeholder (::placeholder context)] 1010 | [:placeholder placeholder]) 1011 | (when-let [rows (::text-rows context)] 1012 | [:rows rows]))) 1013 | ;; Misc; Simple input, but maybe do a dynamic type dispatch as well for customization... 1014 | :else 1015 | (vec (concat [(if (::text-rows context) re-com/input-textarea re-com/input-text) 1016 | :model (str value) ;; just to make sure... 1017 | :style (::input-style context) 1018 | :width (-> context ::input-style :width) 1019 | :on-change (make-change-handler app eid attr-ident value)] 1020 | (when-let [placeholder (::placeholder context)] 1021 | [:placeholder placeholder]) 1022 | (when-let [rows (::text-rows context)] 1023 | [:rows rows]))))])) 1024 | 1025 | 1026 | (representation/register-representation 1027 | ::input-for 1028 | (fn [app [_ context] [eid attr-ident value]] 1029 | (input-for app context [eid attr-ident value]))) 1030 | 1031 | 1032 | ;; TODO Need to have some way of wrapping or overriding this in certain cases; How do we make this part of more default controls orthogonal? 1033 | ;; For right now putting the main functionality inside a star function, then wrapping it in a dynamic var so you can override it, while still referring to the default functionality 1034 | (defn create-type-reference* 1035 | [app eid attr-ident type-ident] 1036 | (send-tx! 1037 | app 1038 | ;; Right now this also only works for isComponent :db.cardinality/many attributes. Should 1039 | ;; generalize for :db/isComponent false so you could add a non-ref attribute on the fly XXX 1040 | ;; This also may not work if you try to transact it locally, since type-ident doesn't resolve to the entity in DS (idents aren't really supported) XXX 1041 | ;; Could maybe work with a ref [:db/ident type-ident], but I don't know if these are supported in tx 1042 | [{:db/id -1 :e/type type-ident} 1043 | [:db/add eid attr-ident -1]])) 1044 | 1045 | (defn ^:dynamic create-type-reference 1046 | [app eid attr-ident type-ident] 1047 | (create-type-reference* app eid attr-ident type-ident)) 1048 | 1049 | 1050 | ;; TODO Need to rewrite in terms of representations 1051 | (defn attr-type-selector 1052 | [type-idents selected-type ok-fn cancel-fn] 1053 | ;; Right now only supports one; need to make a popover or something that asks you what type you want to 1054 | ;; create if there are many possible... XXX 1055 | [re-com/v-box 1056 | ;:style {:width "500px" :height "300px"} 1057 | :children 1058 | [[re-com/title :label "Please select an entity type"] 1059 | [re-com/single-dropdown 1060 | :choices (mapv (fn [x] {:id x :label (pr-str x)}) type-idents) 1061 | :model selected-type 1062 | :style {:width "300px"} 1063 | :on-change (fn [x] (reset! selected-type x))] 1064 | [re-com/h-box 1065 | :children 1066 | [[re-com/md-icon-button :md-icon-name "zmdi-check" 1067 | :size :larger 1068 | :style {:margin "10px"} 1069 | :tooltip "add selected entity" 1070 | :on-click ok-fn] 1071 | [re-com/md-icon-button :md-icon-name "zmdi-close-circle" 1072 | :size :larger 1073 | :style {:margin "10px"} 1074 | :tooltip "Cancel" 1075 | :on-click cancel-fn]]]]]) 1076 | 1077 | 1078 | ;; All this skeleton stuff is a bit anoying; these things are what the user should be specifying, not the 1079 | ;; other way around 1080 | ;; Should strip down and simplify field-for-skeleton; Doesn't need to be this complex XXX 1081 | ;; TODO Need to rewrite in terms of representations, or write this one in terms of a layout, if that becomes a separate notion 1082 | (defn field-for-skeleton 1083 | [app attr-ident controls inputs] 1084 | [re-com/v-box 1085 | :style {:flex-flow "column wrap"} 1086 | :padding "10px" 1087 | :children 1088 | [;; First the label view, and any label controls that might be needed 1089 | [re-com/h-box 1090 | :style {:flex-flow "row wrap"} 1091 | :children 1092 | [[label-view app attr-ident] 1093 | [re-com/h-box :children controls]]] 1094 | ;; Put our inputs in a v-box 1095 | [re-com/v-box 1096 | :style {:flex-flow "column wrap"} 1097 | :children inputs]]]) 1098 | 1099 | ;; TODO Need to rewrite in terms of control represetnations (and make more abstract and ref attr-type based) 1100 | ;; needs to be a control on the attr-view 1101 | (defn add-reference-button 1102 | "Simple add reference button" 1103 | ([tooltip on-click-fn] 1104 | [re-com/md-icon-button 1105 | :md-icon-name "zmdi-plus" 1106 | :size :smaller 1107 | :on-click on-click-fn 1108 | :tooltip tooltip]) 1109 | ([on-click-fn] 1110 | (add-reference-button "Add entity" on-click-fn))) 1111 | 1112 | 1113 | 1114 | ;; Similarly, should have another function for doing the main simple operation here XXX 1115 | (defn add-reference-for-type-button 1116 | "Simply add a reference for a given type (TODO...)" 1117 | [tooltip type-ident]) 1118 | 1119 | ;; We should rewrite the main use case below to use this function istead of the one above; reduce complexity 1120 | ;; TODO Need to rewrite in terms of representation 1121 | (defn add-reference-button-modal 1122 | "An add reference button that pops up a modal form with a submit button. 1123 | modal-popup arg should be a component that takes param: 1124 | * form-activated?: an atom with a bool indicating whether the form should be shown. 1125 | This component should make sure to toggle form-activated? when it's done creating 1126 | the component, or if there is a cancelation." 1127 | ([tooltip modal-popup] 1128 | (let [form-activated? (r/atom false)] 1129 | (fn [tooltip modal-popup] 1130 | [re-com/v-box 1131 | :children 1132 | [[add-reference-button tooltip (fn [] (reset! form-activated? true))] 1133 | (when @form-activated? 1134 | [re-com/modal-panel :child [modal-popup form-activated?]])]]))) 1135 | ([modal-popup] 1136 | (add-reference-button "Add entity" modal-popup))) 1137 | 1138 | 1139 | ;(defn with-controls 1140 | ; [representation-fn] 1141 | ; (fn [app [representation-id context-data] data] 1142 | ; (if-let [controls (::controls context-data)] 1143 | ; [:div {:style h-box-styles} 1144 | ; [represent app [::control-set (assoc context-data ::controls controls)] data] 1145 | ; [representation-fn app [representation-id (dissoc context-data :dat.view/controls)] data]]))) 1146 | 1147 | 1148 | ;; Again; need to think about the right way to pass through the attribute data here 1149 | 1150 | ;; XXX comments here thinking about how we semantically break down what's going on here for datview layers 1151 | (representation/register-representation 1152 | ::add-reference-button 1153 | (fn [app [_ context] [eid attr-ident values]] 1154 | (let [;; subscriptions 1155 | attr-sig @(context/attr-signature-reaction app attr-ident) 1156 | activate-type-selector? (r/atom false) 1157 | ;; control state (move as much as possible to conn, and just subscribe, but should be possible to insert temp state as well) 1158 | selected-type (r/atom nil) 1159 | cancel-fn (fn [] 1160 | (reset! activate-type-selector? false) 1161 | (reset! selected-type nil) 1162 | false) 1163 | ok-fn (fn [] 1164 | (reset! activate-type-selector? false) 1165 | (create-type-reference app eid attr-ident @selected-type) 1166 | (reset! selected-type nil) 1167 | false)] 1168 | (fn [app [_ context] [eid attr-ident _]] 1169 | (let [type-idents (:attribute.ref/types attr-sig)] 1170 | [:div 1171 | [add-reference-button (fn [] 1172 | (cond 1173 | (> (count type-idents) 1) 1174 | (reset! activate-type-selector? true) 1175 | ;; Should specifically catch this and let user select from any possible type; or maybe a defaults? context? 1176 | (= (count type-idents) 0) 1177 | (js/alert "No types associated with this attribute; This will be allowed in the future, till then please find/file a GH issue to show interest.") 1178 | :else 1179 | (create-type-reference app eid attr-ident (first type-idents))))] 1180 | ;; Need a flexible way of specifying which attributes need special functions associated in form 1181 | (when @activate-type-selector? 1182 | [re-com/modal-panel 1183 | :child [attr-type-selector type-idents selected-type ok-fn cancel-fn]])]))))) 1184 | 1185 | (representation/register-representation 1186 | ::fields-for 1187 | ;[with-controls] 1188 | ;; So first we get attr-signature and config 1189 | ;; TODO Should make this also ok with not passing in the value(s) so that it can pull for you... 1190 | (fn [app [_ context] [eid attr-ident value]] 1191 | (let [] 1192 | ;; TODO Need to add sorting functionality here... 1193 | (fn [app [_ context] [eid attr-ident value]] 1194 | (let [pull-expr (::pull-expr context) 1195 | conn (:conn app) 1196 | ;eid (d/entid (:conn app) eid) 1197 | value (or value (get @(posh/pull conn [attr-ident] eid) attr-ident)) 1198 | local-context (:dat.view.context/locals context)] 1199 | ;; Ug... can't get around having to duplicate :field and label-view 1200 | (when (and eid 1201 | (not (or (:attribute/hidden? context) (#{:db/id :db/ident} attr-ident)))) 1202 | ;; Are controls still separated this way? Should they be? 1203 | ;[:div {:style h-box-styles} 1204 | [:div (:dom/attrs context) 1205 | [:div {:style h-box-styles} 1206 | [label-view app attr-ident] 1207 | (let [control-context (assoc local-context ::controls (::controls context))] 1208 | [represent app [::control-set control-context] [eid attr-ident value]])] 1209 | (for [value (let [value (utils/deref-or-value value)] 1210 | (sorted-values app attr-ident 1211 | (or 1212 | (when (sequential? value) (seq value)) 1213 | (when value [value]) 1214 | [nil])))] 1215 | ^{:key (hash {:component :fields-for :eid eid :attr-ident attr-ident :value value})} 1216 | [represent app [::input-for local-context] [eid attr-ident value]])])))))) 1217 | ;[input-for app context-data pull-expr eid attr-ident value])]]))))))) 1218 | 1219 | ;; TODO Need to rewrite with saner arity 1220 | (defn fields-for 1221 | [app context eid attr-ident value] 1222 | [represent app [::fields-for context] [eid attr-ident value]]) 1223 | 1224 | ;(defn pull-expression-context 1225 | ; [pull-expr] 1226 | ; ;; Have to get this to recursively pull out metadata from reference attributes, and nest it according to context schema XXX 1227 | ; (meta pull-expr)) 1228 | 1229 | (defn rest-attributes 1230 | "Grabs attributes corresponding to * pulls, not otherwise fetched at the top level of a pull-expr" 1231 | ;; Is this something we should cache? 1232 | [pull-expr pull-data] 1233 | (->> pull-expr 1234 | (map (fn [attr-spec] 1235 | (if (map? attr-spec) 1236 | (keys attr-spec) 1237 | attr-spec))) 1238 | flatten 1239 | (remove (keys pull-data)))) 1240 | 1241 | 1242 | ;; The following three functions are currently not being used, and I'm not sure if they need to be. They overlap with 1243 | ;; the `pull-attributes` function. 1244 | 1245 | ;(defn pull-expr-attributes 1246 | ; ;; TODO Take into account hidden 1247 | ; [app pull-expr] 1248 | ; (->> pull-expr 1249 | ; (map (fn [x] (if (map? x) (keys x) x))) 1250 | ; ;; If we keep this... 1251 | ; ;(remove #{'*}) 1252 | ; flatten 1253 | ; distinct)) 1254 | ; 1255 | ; 1256 | ;(defn pull-with-extra-fields 1257 | ; ([pull-expr extra-fields] 1258 | ; (distinct 1259 | ; (concat 1260 | ; (map 1261 | ; (fn [attr-spec] (if (map? attr-spec) 1262 | ; (into {} (map (fn [k pull-expr'] 1263 | ; [k (pull-with-extra-fields pull-expr' extra-fields)]))))) 1264 | ; pull-expr) 1265 | ; extra-fields))) 1266 | ; ([pull-expr] 1267 | ; ;; Need to be able to nest in type ident... 1268 | ; (pull-with-extra-fields pull-expr [:db/id :db/ident :e/type]))) 1269 | ; 1270 | ; 1271 | ;(defn pull-attr-values 1272 | ; [app pull-expr pull-data] 1273 | ; (->> (pull-expr-attributes app pull-expr) 1274 | ; (concat (keys pull-data)) 1275 | ; (distinct) 1276 | ; (map (fn [attr-ident] [attr-ident (get pull-data attr-ident)])) 1277 | ; (into {}))) 1278 | 1279 | 1280 | (declare type-pull) 1281 | (declare entity-pull) 1282 | 1283 | ;(defn pull-merge 1284 | ; [pull1 pull2] 1285 | ; (let [maps (filter map? pull1)] 1286 | ; (concat pull1 pull2))) 1287 | 1288 | 1289 | ;; TODO Oy... this (and all it's uses) need to be totally rewritten; We can't pass through pull-expr, since we can't always know it a priori (if you have subtypes, you can't know which fields you should have till you know which type it is) 1290 | ;; Got too agressive on trying to optimize by minizing pull queries 1291 | ;; TODO Also need to pass down information here about what types are acceptable in the type selector field 1292 | (representation/register-representation 1293 | ::pull-form 1294 | ;; TODO Hmm... because we would like pull-expr to supply context when context is nil, it would be nice to add this bit of logic as a context resolution extension 1295 | (fn [app [_ context] pull-data-or-id] 1296 | ;; Supplying nil to pull expr leaves it inferred via context, dat.view/entity-pull, and dat.view/base-pull, in that order 1297 | (let [pull-expr (deref-or-value 1298 | ;(or 1299 | ;(when-let [type-ident (:db/ident (:e/type (deref-or-value pull-data-or-id)))] 1300 | ; (type-pull app type-ident) 1301 | (entity-pull app pull-data-or-id)) 1302 | ;pull-expr 1303 | ;(::pull-expr context) 1304 | ;;(entity-pull app pull-data-or-id) 1305 | ;base-pull)) 1306 | pull-data-or-id (deref-or-value pull-data-or-id) 1307 | local-context (:dat.view.context/locals context) 1308 | eid (cond 1309 | ;; id or lookup ref 1310 | ((some-fn integer? vector?) pull-data-or-id) pull-data-or-id 1311 | ;; presumably, data returned from said query 1312 | (map? pull-data-or-id) (:db/id pull-data-or-id)) 1313 | pull-data @(posh/pull (:conn app) pull-expr eid)] 1314 | ;(cond 1315 | ; again, id or lookup ref 1316 | ;((some-fn integer? vector?) pull-data-or-id) 1317 | ;(let [pull-data (posh/pull (:conn app) pull-expr pull-data-or-id)] 1318 | ; [represent app [::pull-form local-context] [pull-expr pull-data]]) 1319 | ; again, id or lookup ref 1320 | [:div (:dom/attrs context) 1321 | (let [control-context (assoc local-context ::controls (::controls context))] 1322 | [represent app [::control-set control-context] pull-data]) 1323 | ;(for [[attr-ident values] (pull-attr-values app pull-expr pull-data-or-id)] 1324 | (for [attr-ident (sort-by (comp deref (partial attr-order app)) 1325 | (pull-attributes pull-expr pull-data))] 1326 | (let [values (get pull-data-or-id attr-ident)] 1327 | ^{:key (hash attr-ident)} 1328 | ;; Need to assoc in the attr-ident to context as well, so the correct context can be prepared for the child representation 1329 | [represent app [::fields-for (assoc local-context :db.attr/ident attr-ident)] [eid attr-ident values]]))]))) 1330 | 1331 | (defn pull-form 1332 | "Renders a form with defaults from pull data, or for an existing entity, subject to optional specification of a 1333 | pull expression (possibly annotated with context metadata; or nil, if pull-expr should be inferred), a context map 1334 | (which itself may contain a `:dat.view/pull-expr`), and either pull data, or a lookup ref or eid corresponding to data which should be pulled." 1335 | ([app pull-data-or-id] 1336 | [pull-form app nil pull-data-or-id]) 1337 | ;; QUESTION Should really decide whether we want the 3-arity to be `[app context data]` or `[app pull-expr data]`. 1338 | ([app pull-expr pull-data-or-id] 1339 | [pull-form app nil pull-expr pull-data-or-id]) 1340 | ([app context pull-expr pull-data-or-id] 1341 | (when pull-data-or-id 1342 | ;; For now, we'll get around the todo item on ::pull-form relating to context from pull-expr by using this little piece of logic here. 1343 | ;; Would be nice to move into rep though, as discussed there... 1344 | (let [context (if (and pull-expr (not context)) 1345 | (merge context (meta-context pull-expr)) 1346 | context) 1347 | context (assoc context ::pull-expr pull-expr)] 1348 | [represent app [::pull-form (or context {})] pull-data-or-id])))) 1349 | 1350 | (representation/register-representation 1351 | ::edit-entity-form 1352 | (fn [app [_ context] eid] 1353 | (if-let [eid @(pull-attr (:conn app) eid :db/id)] 1354 | [:div v-box-styles 1355 | ;; QUESTION TODO How do we add from our ::pull-summary-attributes to base-pull here? Do we need another option? Use type? 1356 | [:h3 "Editing entity"]; [pull-summary-string @(posh/pull (:conn app) base-pull eid)]] ; QUESTION why doesn't this work? 1357 | [pull-form app context nil eid] 1358 | (when (:dat.view.edit/preview context) 1359 | [:div v-box-styles 1360 | [:h4 "Preview:"] 1361 | [pull-view app context nil eid]])] 1362 | [loading-notification "Please wait; form data is loading."]))) 1363 | 1364 | (defn edit-entity-form 1365 | "This is a somewhat higher level representation/control than ::pull-form. It is meant to be used as the outer most layer." 1366 | [app context eid] 1367 | [represent app [::edit-entity-form context] eid]) 1368 | 1369 | 1370 | ;; These are our new goals 1371 | 1372 | ;(defn pull-data-form 1373 | ; [app pull-expr eid] 1374 | ; (if-let [current-data @(posh/pull (:conn app) pull-expr eid)] 1375 | ; [re-com/v-box :children [[pull-form app pull-expr eid]]] 1376 | ; [loading-notification "Please wait; loading data."])) 1377 | 1378 | ;(defn pull-form 1379 | ;[app pull-expr eid]) 1380 | 1381 | 1382 | 1383 | ;; ## Constructing queries with metadata annotations 1384 | 1385 | 1386 | (def type-data 1387 | ^{:arglist '([app base-type])} 1388 | (memoize 1389 | (fn [app base-type] 1390 | (posh/pull 1391 | (:conn app) 1392 | '[:db/id :db/ident :db/isComponent 1393 | {:e/type ... 1394 | :e.type/isa ... 1395 | :e.type/attributes ... 1396 | :db/valueType ... 1397 | :attribute.ref/types ...}] 1398 | base-type 1399 | {:cache :forever})))) 1400 | 1401 | 1402 | ;; XXX Note; cyclic recursive isComponent attribute relations break this 1403 | ;; BIG TODO QUESTION Figure out how we deal with the different needs of base-pull between view and control contexts; Don't always want forms for things we might just pull along for ride on view, & vice versa 1404 | ;; Ughh... we don't want to be memoizing this for context which could change a ton, only for the pull-summary-attrs 1405 | ;(def type-pull nil) 1406 | (def type-pull 1407 | (memoize 1408 | (fn type-pull* 1409 | ([app base-type] 1410 | (type-pull* app base-type {})) 1411 | ([app base-type pull-summary-attrs] 1412 | (reaction 1413 | (let [type-data @(type-data app base-type)] 1414 | (walk/postwalk 1415 | (fn [data] 1416 | (cond 1417 | ;; For types 1418 | (= (:db/ident (:e/type data)) :e.type/Type) 1419 | (->> ;; Gather type attributes 1420 | (:e.type/attributes data) 1421 | ;; Assoc in a virtual attribute about whether a ref or not 1422 | (map (fn [attr] (assoc attr :db.type/ref? (-> attr :db/valueType :db/ident #{:db.type/ref})))) 1423 | ;; Mocking in :db/id, :db/ident and :e/type, since want for everything 1424 | (concat [{:db/ident :db/id} 1425 | ;; TODO Should hide ident if not needed 1426 | {:db/ident :db/ident} 1427 | {:db/ident :e/type 1428 | :db.type/ref? true 1429 | :attribute.ref/types [{:db/ident :e.type/Type 1430 | :e.type/attributes [{:db/ident :db/id} 1431 | {:db/ident :db/ident}]}]}]) 1432 | (sort-by attr-entity-order) 1433 | (map (fn [attr] 1434 | (if (:db.type/ref? attr) 1435 | (if (:db/isComponent attr) 1436 | {(:db/ident attr) 1437 | (with-meta 1438 | (->> (:attribute.ref/types attr) 1439 | flatten 1440 | (remove nil?) 1441 | ;; Note; I guess we don't need pull extras here since * 1442 | (concat ['*]) 1443 | vec) 1444 | {:ref true})} 1445 | {(:db/ident attr) 1446 | ;; TODO Handle these 1447 | (-> (get pull-summary-attrs (:db/ident attr)) 1448 | (concat [:e/name :e/description :db/ident {:e/type [:db/id :db/ident]}]) 1449 | vec 1450 | (with-meta {;::representation ::pull-summary-view 1451 | ::collapsed? true ::collapsable? true}))}) 1452 | (:db/ident attr)))) 1453 | ;; Concat with supertype pull expressions 1454 | (concat 1455 | (when-let [supertypes (:e.type/isa data)] 1456 | ;; supertypes have already been (postwalk) transformed to their respective pulls 1457 | (apply concat supertypes))) 1458 | ;; Oh... shouldn't need this. This was probably because of the component refs? 1459 | (remove nil?) 1460 | distinct 1461 | vec 1462 | (#(with-meta % (merge (meta %) {;:e/type data 1463 | :e/type-ident (:db/ident data)})))) 1464 | :else data)) 1465 | type-data))))))) 1466 | 1467 | ;(def entity-pull nil) 1468 | (def entity-pull 1469 | (memoize 1470 | (fn entity-pull* 1471 | ([app entity-or-eid] 1472 | (entity-pull* app entity-or-eid {})) 1473 | ([app entity-or-eid pull-summary-attrs] 1474 | (cond 1475 | ;; If derefable, deref first 1476 | (implements? IDeref entity-or-eid) 1477 | (entity-pull* app @entity-or-eid pull-summary-attrs) 1478 | ;; If a map, use id to defer to else case TODO could look here for type ids first... 1479 | (map? entity-or-eid) 1480 | (if-let [type (:db/id (:e/type entity-or-eid))] 1481 | (type-pull app type pull-summary-attrs) 1482 | (entity-pull* app (:db/id entity-or-eid) pull-summary-attrs)) 1483 | ;; This is where all the real logic is: 1484 | :else ;; assume eid 1485 | (let [type-id-rx (pull-path (:conn app) entity-or-eid [:e/type :db/id])] 1486 | (reaction 1487 | (if-let [type-id @type-id-rx] 1488 | @(type-pull app type-id pull-summary-attrs) 1489 | (do 1490 | (log/warn "Bad type id for entity-or-eid: " entity-or-eid) 1491 | base-pull))))))))) 1492 | 1493 | 1494 | ;; This is effectively our metadata model 1495 | 1496 | ;(s/def ::pull-kv 1497 | ; ;; Should make this a recursive thing that fully specs... 1498 | ; (s/cat :reference keyword? :pull-expr vector?)) 1499 | 1500 | ;(s/def ::pull-expr 1501 | ; (s/* (s/or keyword? map? symbol?))) 1502 | 1503 | (defn meta-context 1504 | [pull-expr] 1505 | (let [ref-attrs (filter map? pull-expr) 1506 | non-ref-attrs (remove map? pull-expr)] 1507 | (assoc 1508 | (meta pull-expr) 1509 | ::pull-expr pull-expr 1510 | ::ref-attrs 1511 | (->> ref-attrs 1512 | (apply merge) 1513 | (map 1514 | (fn [[attr-ident attr-pull-expr]] 1515 | [attr-ident (meta-context attr-pull-expr)])) 1516 | (into {})) 1517 | ::non-ref-attrs non-ref-attrs))) 1518 | 1519 | 1520 | ;; TODO Need a clear-metadata function as well, for clearing out the extracted metadata 1521 | 1522 | 1523 | ;; Setting default context; Comes in precedence even before the DS context 1524 | ;; But should this be config technically? 1525 | 1526 | ;; TODO A datalog model for context?: (would be nice to move towards this) 1527 | 1528 | ;; :e/type 1529 | ;; :e.type/Context 1530 | ;; ::context 1531 | ;; ::ident (:dat.view/context-id?) 1532 | ;; :context-id / whatevs 1533 | ;; :dat.view.context/level 1534 | ;; :dat.view.context.level/entity 1535 | ;; :dat.view.context.level/attribute 1536 | ;; :dat.view.context/attribute 1537 | ;; :dat.view.context/type 1538 | ;; :dat.view.context/type 1539 | 1540 | ;; :dom/attrs 1541 | ;; ::controls 1542 | ;; ::middleware 1543 | ;; ::delegate-to 1544 | 1545 | 1546 | (swap! context/default-base-context 1547 | utils/deep-merge 1548 | ;; Top level just says that this is our configuration? Or is that not necessary? 1549 | { 1550 | ;; QUESTION These should be be renamed representation-context etc? 1551 | ::base-config 1552 | {; don't need this if we have base-context 1553 | ::pull-form 1554 | {:dom/attrs {:style bordered-box-style} 1555 | ::controls [::delete-entity-control]} 1556 | ::attr-values-view 1557 | {:dom/attrs {:style h-box-styles} 1558 | ;; Right now only cardinality many attributes are collapsable; Should be able to set any? Then set for cardinality many as a default? XXX 1559 | ::collapsable? true 1560 | ::collapsed? true} ;; Default; everything is collapsed 1561 | ::value-view 1562 | {:dom/attrs {:style (merge h-box-styles 1563 | {:padding "3px"})}} 1564 | ::attr-view 1565 | {:dom/attrs {:style (merge v-box-styles 1566 | {:padding "5px 12px"})}} 1567 | ::label-view 1568 | {:dom/attrs {:style {:font-size "14px" 1569 | :font-weight "bold"}}} 1570 | ::pull-data-view 1571 | {:dom/attrs {:style (merge h-box-styles 1572 | bordered-box-style 1573 | {:padding "8px 15px" 1574 | :width "100%"})} 1575 | ::controls [::copy-entity-control ::edit-entity-control ::delete-entity-control]} 1576 | ;; XXX This should change shortly... 1577 | ::pull-view-controls 1578 | {:dom/attrs {:style (merge h-box-styles 1579 | {:padding "5px"})}} 1580 | ;:background "#DADADA"})} 1581 | ;;; Check if these actually make sense 1582 | ;:justify-content "flex-end"})}} 1583 | ;:gap "10px" 1584 | ;::component default-pull-view-controls} 1585 | ::pull-summary-view 1586 | {:dom/attrs {:style (merge v-box-styles 1587 | {:padding "15px" 1588 | :font-size "12px" 1589 | :font-weight "bold"})}} 1590 | ; saved from inline 1591 | ;{:style {:font-weight "bold" :padding "5px" :align-self "end"}}} 1592 | ;::component pull-summary-view} 1593 | ::fields-for 1594 | {:dom/attrs {:style (merge v-box-styles 1595 | {:padding "7px"})}}} 1596 | ;::input-for 1597 | ;{:dom/attrs {:style {:padding "4px"}}}} 1598 | ;; Specifications merged in for any config with a certain cardinality 1599 | ::card-config {:db.cardinality/many {::fields-for {::controls [::add-reference-button]}}} 1600 | ;; Specifications merged in for any value type 1601 | ::value-type-config {:db.type/string {::input-for {::input-style {:width "200px"}}} 1602 | :db.type/float {::input-for {::input-style {:width "130px"}}} 1603 | :db.type/double {::input-for {::input-style {:width "130px"}}} 1604 | :db.type/integer {::input-for {::input-style {:width "100px"}}} 1605 | :db.type/long {::input-for {::input-style {:width "100px"}}}} 1606 | ;:width (if (= attr-ident :db/doc) "350px" "200px") 1607 | ::attr-config {:db/id {::fields-for {:attribute/hidden? true 1608 | :dom/attrs {:style {:display "none"}}}} 1609 | :db/ident {::fields-for {:attribute/hidden? true 1610 | :dom/attrs {:style {:display "none"}}}} 1611 | :comment/body {::input-for {::input-style {:width "500px"} 1612 | ::text-rows 10}} 1613 | :db/doc {::input-for {::input-style {:width "500px"} 1614 | ::text-rows 10}}}}) 1615 | ;; Will add the ability to add mappings at the entity level; And perhaps specifically at the type level. 1616 | ;; Use the patterns of OO/types with pure data; Dynamic 1617 | 1618 | ;; ## History & Routing 1619 | ;; ==================== 1620 | 1621 | ;; Realy need to set this one up as a component, but for now... 1622 | 1623 | ;; Start watching history and on changes, set the :dat.view/route attribute of the conn db 1624 | (comment 1625 | (defonce history 1626 | (let [conn (-> system :app :conn) ;; Should probably base this off app directly once component 1627 | history-obj (doto (router/make-history) 1628 | (router/attach-history-handler! (router/make-handler-fn conn)))] 1629 | (settings/update-setting conn :dat.view/history-obj history-obj) 1630 | ;; Initialize route, really; we don't have a :dat.view/route set in the db yet, so need to instantiate 1631 | (router/update-route! conn)))) 1632 | 1633 | 1634 | 1635 | ;; Here's where everything comes together 1636 | ;; Datview record instances are what we pass along to our Datview component functions as the first argument. 1637 | ;; Abstractly, they are just a container for your database and communications functionality (via attributes :conn and :config). 1638 | ;; But in reality, they are actually Stuart Sierra components, with start and stop methods. 1639 | ;; You can either use these components standalone, by creating your app instance with `(new-datview ...)`, and starting it with the `start` function (both defined below). 1640 | ;; Convention is to call datview instances either app or datview. 1641 | ;; But you should be thinking about them as the application object of your program. 1642 | 1643 | ;; Should make this derefable 1644 | 1645 | (defrecord Datview 1646 | ;; The public API: these two attributes 1647 | [conn ;; You can access this for your posh queries; based on reactor unless otherwise specified 1648 | config ;; How you control the instantiation of Datview; options: 1649 | routes ;; Bidi routes data (will abstract more eventually) 1650 | ;; * :datascript/schema 1651 | ;; * :dat.view/conn 1652 | ;; Other (semi-)optional dependencies 1653 | remote ;; Something implementing the dat.remote protocols; If not specified as a dependency, fetches from reactor 1654 | dispatcher ;; Something implementing the dispatcher protocols 1655 | main] ;; Need to make this a clear requirement 1656 | component/Lifecycle 1657 | (start [component] 1658 | (try 1659 | (log/info "Starting Datview") 1660 | ;; TODO Ugg... need to have a way for Datsync to register its default schema 1661 | (let [base-schema (utils/deep-merge {:db/ident {:db/ident :db/ident :db/unique :db.unique/identity} 1662 | :dat.sync.remote.db/id {:db/unique :db.unique/identity}} 1663 | (:datascript/schema config)) 1664 | ;; Should try switching to r/atom 1665 | conn (or conn (::conn config) (d/create-conn base-schema)) 1666 | routes (or routes (::routes config) routes/routes) ;; base routes 1667 | main (or main (::main config)) 1668 | history (router/make-history) 1669 | component (assoc component :conn conn :base-conn conn :main main :history history :routes routes)] 1670 | ;; Transact default settings to db 1671 | (d/transact! conn default-settings) 1672 | ;; Start posh 1673 | (posh/posh! conn) 1674 | ;; Install settings entity 1675 | (settings/init! component) 1676 | ;; TODO Fire off the router handlers 1677 | (router/attach-history-handler! history (router/make-handler-fn component)) 1678 | component) 1679 | (catch :default e 1680 | (log/error "Error starting Datview:" e) 1681 | (println (.-stack e)) 1682 | component))) 1683 | (stop [component] 1684 | (assoc component 1685 | :reactor nil 1686 | :conn nil))) 1687 | 1688 | 1689 | 1690 | ;; Should have a way of telling components what config options they need 1691 | (defn new-datview 1692 | "Creates a new instance of datview, to be passed around in your application code as either 1693 | `app` or `datview` (the latter, following from typical System Component naming conventions, 1694 | and the fact that this will be a Datview object)" 1695 | ([{:as config 1696 | :keys [datascript/schema ;; Base schema 1697 | dat.view/conn 1698 | dat.view/base-context] 1699 | :or {dat.view/base-context default-base-context}}] ;; Need to actually plug this in as an atom 1700 | (map->Datview {:config config})) 1701 | ([] 1702 | (new-datview {}))) 1703 | 1704 | 1705 | -------------------------------------------------------------------------------- /src/dat/view/context.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view.context 2 | (:require-macros 3 | [reagent.ratom :refer [reaction]] 4 | [cljs.core.async.macros :as async-macros :refer [go go-loop]]) 5 | (:require 6 | [dat.view.utils :as utils] 7 | [posh.reagent :as posh] 8 | [dat.reactor :as reactor] 9 | [reagent.core :as r] 10 | [reagent.ratom :as ratom] 11 | [datascript.core :as d] 12 | [taoensso.timbre :as log :include-macros true])) 13 | 14 | 15 | ;; ## Context 16 | 17 | ;; We're going to be re-describing things in terms of context. 18 | ;; Context includes configuration and contextual information about where things are. 19 | ;; But it is extensible, so we can pass through whatever information we might like about how to render things. 20 | 21 | ;; All of these should be checked for their semantics on :dat.view.base-context/value etc; Is this the right way to represent these things? 22 | 23 | ;; Should probably move all of these out to reactions or some such, except for anything that's considered public 24 | 25 | (defonce default-base-context (r/atom {})) 26 | 27 | (def base-context 28 | ;; Not sure if this memoize will do what I'm hoping it does (:staying-alive true, effectively) 29 | (memoize 30 | (fn [app] 31 | ;; Hmm... should we just serialize the structure fully? 32 | ;; Adds complexity around wanting to have namespaced attribute names for everything 33 | (reaction 34 | (try 35 | (:dat.view.base-context/value 36 | @(posh/pull (:conn app) '[*] [:db/ident :dat.view/base-context] {:cache :forever})) 37 | ;; Easter egg: 38 | ;; A self installing config entity :-) Good pattern? 39 | (catch :default e 40 | (log/warn "You don't yet have a :dat.view/base-context setting defined. Creating one.") 41 | (reactor/dispatch! app [:dat.reactor/local-tx [{:db/ident :dat.view/base-context}]]))))))) 42 | 43 | (defn update-base-context! 44 | [app f & args] 45 | (letfn [(txf [db] 46 | (apply update 47 | (d/pull db '[*] [:db/ident :dat.view/base-context]) 48 | :dat.view.base-context/value 49 | f 50 | args))] 51 | (d/transact! (:conn app) [[:db.fn/call txf]]))) 52 | 53 | (defn set-base-context! 54 | [app context] 55 | (update-base-context! app (constantly context))) 56 | 57 | 58 | ;(defn meta-sig 59 | ; [args-vec] 60 | ; (mapv #(vector % (meta %)) args-vec)) 61 | ; 62 | ;(defn meta-memoize 63 | ; ([f] 64 | ; ;; Don't know if this actually has to be an r/atom; may be more performant for it not to be 65 | ; (meta-memoize f (r/atom {}))) 66 | ; ([f cache] 67 | ; (fn [& args] 68 | ; (if-let [cached-val (get @cache (meta-sig args))] 69 | ; cached-val 70 | ; (let [new-val (apply f args)] 71 | ; (swap! cache assoc (meta-sig args) new-val) 72 | ; new-val))))) 73 | 74 | ;; ### Attribute metadata reactions 75 | 76 | ;; Hmmm... not sure why these are in context. These should probably be in subscriptions or queries or something. 77 | 78 | (def attribute-schema-reaction 79 | "Returns the corresponding attr-ident entry from the Datomic schema. Returns full entity ref-attr; Have to path for idents." 80 | (memoize 81 | (fn [app attr-ident] 82 | (if (= attr-ident :db/id) 83 | (reaction {:db/id nil}) 84 | (posh/pull (:conn app) 85 | '[* {:db/valueType [:db/ident] 86 | :db/cardinality [:db/ident] 87 | :db/unique [:db/ident] 88 | :attribute.ref/types [:db/ident] 89 | :attribute/sort-by [:db/ident]}] 90 | [:db/ident attr-ident] 91 | {:cache :forever}))))) 92 | ;(reaction 93 | ; (log/debug "Having to recompute schema reaction") 94 | ; @(posh/pull (:conn app) 95 | ; '[* {:db/valueType [:db/ident] 96 | ; :db/cardinality [:db/ident] 97 | ; :db/unique [:db/ident] 98 | ; :attribute.ref/types [:db/ident]}] 99 | ; [:db/ident attr-ident]))))) 100 | 101 | ;; Another function gives us a version of this that maps properly to idents 102 | (def attr-signature-reaction 103 | "Reaction of the pull of a schema attribute, where any ref-attrs to something with any ident entity 104 | have been replaced by that ident keyword." 105 | (memoize 106 | (fn [app attr-ident] 107 | (let [schema-rx (attribute-schema-reaction app attr-ident)] 108 | (reaction 109 | (into {} 110 | (letfn [(mapper [x] 111 | (or (:db/ident x) 112 | (and (sequential? x) (map mapper x)) 113 | x))] 114 | (map (fn [[k v]] [k (mapper v)]) 115 | @schema-rx)))))))) 116 | 117 | 118 | 119 | ;; This is what does all the work of computing our context for each component 120 | ;; XXX Need to think about this a bit more; The way things are going with the context resolution now, this may become more orthogonal 121 | ;(def component-context nil) 122 | (def component-context 123 | "This function returns the component configuration (base-context; should rename) for either an entire render network, 124 | abstractly, or for a specific component based on a component id (namespaced keyword matching the function to be called)." 125 | ;(memoize 126 | (fn component-context* 127 | ([app] 128 | (reaction 129 | ;; Don't need this arity if we drop the distinction between base-context and default-base-context 130 | (utils/deep-merge 131 | @default-base-context 132 | @(base-context app)))) 133 | ([app representation-id] 134 | (component-context* app representation-id {})) 135 | ([app representation-id {;; Options, in order of precedence in consequent merging 136 | :as local-context 137 | :keys [;; When the component is in a scope closed over by some particular attribute: 138 | db.attr/ident 139 | dat.view.context/globals]}] 140 | ;; db/ident of the attribute; precedence below 141 | (reaction 142 | (try 143 | (let [base-context @(component-context app)] 144 | (merge 145 | (get-in base-context [:dat.view/base-config representation-id]) 146 | (when ident 147 | (let [attr-sig @(attr-signature-reaction app ident)] 148 | (merge 149 | (get-in base-context [:dat.view/card-config (:db/cardinality attr-sig) representation-id]) 150 | (get-in base-context [:dat.view/value-type-config (:db/valueType attr-sig) representation-id]) 151 | (get-in base-context [:dat.view/attr-config ident representation-id])))) 152 | ;; Need to also get the value type and card config by the attr-config if that's all that's present; Shouldn't ever 153 | ;; really need to pass in manually XXX 154 | globals 155 | local-context 156 | {::locals local-context 157 | ::globals globals})) 158 | (catch :default e 159 | (log/error e "Unable to build component context for local-context:" local-context "representation-id" representation-id))))))) 160 | 161 | 162 | -------------------------------------------------------------------------------- /src/dat/view/forms.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view.forms 2 | "# Datview forms" 3 | (:require-macros [reagent.ratom :refer [reaction]]) 4 | (:require [dat.view.router :as router] 5 | [dat.view.query :as query] 6 | ;; Need to switch to datview XXX 7 | [dat.view] 8 | [dat.view.utils :as utils] 9 | [datascript.core :as d] 10 | [posh.core :as posh] 11 | [reagent.core :as r] 12 | [re-com.core :as re-com] 13 | [goog.date.Date] 14 | [cljs-time.core :as cljs-time] 15 | [cljs-time.format] 16 | [cljs-time.coerce] 17 | [cljs.pprint :as pp] 18 | [cljs.core.match :as match :refer-macros [match]])) 19 | 20 | ;; # This namespace has been deprecated; All forms have been removed 21 | 22 | -------------------------------------------------------------------------------- /src/dat/view/query.cljc: -------------------------------------------------------------------------------- 1 | (ns dat.view.query) 2 | 3 | (def rules 4 | '[[(attr-ident-value-type-ident ?attr-ident ?value-type-ident) 5 | [?attr :db/ident ?attr-ident] 6 | [?attr :db/valueType ?value-type] 7 | [?value-type :db/ident ?value-type-ident]] 8 | ;; Recursive subtype definition 9 | [(isa ?subtype ?type) 10 | [(= ?subtype ?type)]] 11 | [(isa ?subtype ?type) 12 | [?subtype :e.type/isa ?type]] 13 | [(isa ?subtype ?type) 14 | [?subtype :e.type/isa ?type2] 15 | (isa ?type2 ?type)] 16 | ;; Type instances 17 | [(type-instance ?type ?e) 18 | [?e :e/type ?type]] 19 | [(type-instance ?type ?e) 20 | [?e :e/type ?subtype] 21 | (isa ?subtype ?type)]]) 22 | ; Type attributes 23 | ;[(type-attr ?type ?attr) 24 | ; [?type :e.type/attributes ?attr]] 25 | ;[(type-attr ?type ?attr) 26 | ; [?supertype :e.type/attributes ?attr] 27 | ; (isa ?type ?supertype)]]) 28 | 29 | 30 | -------------------------------------------------------------------------------- /src/dat/view/representation.cljc: -------------------------------------------------------------------------------- 1 | (ns dat.view.representation 2 | (:require 3 | #?(:cljs [reagent.core :as r]) 4 | #?(:cljs [reagent.ratom :refer-macros [reaction]]) 5 | [#?(:clj clojure.pprint :cljs cljs.pprint) :as pprint] 6 | [taoensso.timbre :as log] 7 | [dat.view.styles :as styles] 8 | #?(:cljs [dat.view.context :as context]))) 9 | 10 | 11 | (defn cljc-atom [init-value] 12 | (#?(:cljs r/atom :clj atom) 13 | init-value)) 14 | 15 | ;(def represent* nil) 16 | (defmulti represent* 17 | "Reprsent some data given a representation specification" 18 | (fn [_ representation _] 19 | (try 20 | (first representation) 21 | (catch #?(:clj Exception :cljs :default) e 22 | (log/error "Could not dispatch on malformed representation:" representation))))) 23 | 24 | 25 | (defn represent 26 | [app representation data] 27 | #?(:cljs (r/create-class 28 | {:display-name (str "representation " (try (first representation) (catch :default _ "?"))) 29 | :reagent-render 30 | (fn [app representation data] 31 | [represent* app representation data])}) 32 | :clj [represent* app representation data])) 33 | 34 | ;; TODO Replace evil global mutable state with local values! 35 | (defonce registrations 36 | (cljc-atom {})) 37 | 38 | (defn reactively-register 39 | "Representation middleware: *Should* make it so that when we update representations on the client, they update in the views." 40 | [representation-id representation-fn] 41 | (swap! registrations assoc representation-id representation-fn) 42 | (let [registration-reaction #?(:cljs (reaction (get @registrations representation-id)) 43 | :clj registrations)] 44 | (fn [app representation data] 45 | ;; Goal: This should only update if we have changed the representation (in cljs); We'll see :-) 46 | ;; If we defined reaction in clj, we could actually _use_ the defer value to compute the new function 47 | @registration-reaction 48 | (representation-fn app representation data)))) 49 | 50 | (defn handle-errors 51 | "Representation middleware: *Should* make it so that when we update representations on the client, they update in the views." 52 | [representation-id representation-fn] 53 | (fn [app representation data] 54 | ;; Goal: This should only update if we have changed the representation (in cljs); We'll see :-) 55 | ;; If we defined reaction in clj, we could actually _use_ the defer value to compute the new function 56 | (try 57 | (representation-fn app representation data) 58 | (catch #?(:clj Exception :cljs :default) e 59 | (let [collapse? (cljc-atom true) 60 | rep-collapse? (cljc-atom true) 61 | data-collapse? (cljc-atom true)] 62 | (fn [app representation data] 63 | (log/error e (str "Exception raised for representation: " representation-id)) 64 | [:div.error {:style {:border-style "solid" :border-color "red" :padding "8px 12px" :margin "15px 3px"}} 65 | [:p [:strong "Error rendering component " (str representation-id)]] 66 | [:p [:a {:on-click (fn [& args] (swap! collapse? not))} "See more/less"]] 67 | (when-not @collapse? 68 | [:div 69 | [:p "Error"] 70 | [:pre (pr-str e) 71 | #?(:cljs (try (.-stack e) (catch :default e "!!!Unable to print stack trace!!!")))] 72 | [:p "representation:"] 73 | [:pre (pr-str representation)] 74 | [:p [:a {:on-click (fn [& args] (swap! rep-collapse? not))} "Show pprint"]] 75 | (when-not @rep-collapse? 76 | [:pre (with-out-str (pprint/pprint representation))]) 77 | [:p "Data:"] 78 | [:pre (pr-str data)] 79 | [:p [:a {:on-click (fn [& args] (swap! data-collapse? not))} "Show pprint"]] 80 | (when-not @data-collapse? 81 | [:pre (with-out-str (pprint/pprint data))])])])))))) 82 | 83 | 84 | (defn representation-override 85 | [representation-fn] 86 | (fn [app [representation-id context-data] data] 87 | (if-let [representation-id (:dat.view/representation-id context-data)] 88 | [represent app [representation-id (dissoc context-data :dat.view/representation-id)] data] 89 | [representation-fn app [representation-id context-data] data]))) 90 | 91 | 92 | ;(def resolve-context* nil) 93 | (defmulti resolve-context* 94 | (fn [app representation] 95 | (first representation))) 96 | 97 | (defmethod resolve-context* :default 98 | [app representation] 99 | (second representation)) 100 | 101 | #?(:cljs 102 | (defn resolve-context [app [representation-id local-context]] 103 | ;(log/debug "Resolving context for: " [representation-id local-context]) 104 | (let [context @(context/component-context app representation-id local-context)] 105 | (resolve-context* app [representation-id context])))) 106 | 107 | 108 | (defn register-context-resolution 109 | [representation-id middleware resolution-fn] 110 | (defmethod resolve-context* representation-id 111 | [app representation representation-id] 112 | (let [middleware-fn (apply comp middleware) 113 | resolution-fn (middleware-fn resolution-fn)] 114 | (resolution-fn app representation representation-id)))) 115 | 116 | #?(:cljs 117 | (defn resolve-context-ware 118 | [representation-fn] 119 | (fn [app representation data] 120 | ;(log/debug "rsolving rep" (pr-str representation)) 121 | (representation-fn 122 | app 123 | [(first representation) (resolve-context app representation)] 124 | data))) 125 | :clj 126 | ;; TODO For now... 127 | (def resolve-context-ware identity)) 128 | 129 | (defn apply-form2-middleware 130 | [middleware representation-fn] 131 | (fn [app representation data] 132 | (let [return-val (representation-fn app representation data)] 133 | (if (fn? return-val) 134 | ;; Then form2 component 135 | ((apply comp middleware) return-val) 136 | ;; then hiccup; return directly 137 | return-val)))) 138 | 139 | (defn register-representation 140 | ([representation-id middleware representation-fn] 141 | (let [base-middleware [resolve-context-ware 142 | (partial reactively-register representation-id) 143 | (partial handle-errors representation-id)] 144 | outer-middleware (concat middleware base-middleware) 145 | middleware (concat middleware 146 | [(partial apply-form2-middleware outer-middleware)] 147 | base-middleware) 148 | middleware-fn (apply comp middleware) 149 | representation-fn' (middleware-fn representation-fn)] 150 | (swap! registrations assoc representation-id representation-fn') 151 | (defmethod represent* representation-id 152 | [app context data] 153 | (representation-fn' app context data)))) 154 | ([representation-id representation-fn] 155 | (register-representation representation-id [] representation-fn))) 156 | 157 | 158 | -------------------------------------------------------------------------------- /src/dat/view/router.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view.router 2 | (:require [bidi.bidi :as bidi] 3 | [dat.view.settings :as settings] 4 | [dat.reactor.dispatcher :as dispatcher] 5 | [dat.view.routes :as routes] 6 | [datascript.core :as d] 7 | [reagent.ratom :refer-macros [reaction]] 8 | [goog.events] 9 | [dat.reactor :as reactor] 10 | [dat.view.utils :as utils] 11 | [taoensso.timbre :as log]) 12 | (:import [goog.history Html5History EventType])) 13 | 14 | 15 | ;(defprotocol Router 16 | ;(route)) 17 | 18 | 19 | ;; Now we define how to instatiate the history object. 20 | 21 | ;; TODO Need to make a system component out of this thing 22 | 23 | (defn make-history [] 24 | (doto (Html5History.) 25 | (.setPathPrefix (str js/window.location.protocol 26 | "//" 27 | js/window.location.host)) 28 | (.setUseFragment false))) 29 | 30 | 31 | ;; Now we set up our global history object. We use defonce so we can hot reload the code. 32 | 33 | ;; We should maybe be moving this into a constructor or something so that this state can be in the main app ns 34 | 35 | (defn attach-history-handler! 36 | [history handler-fn] 37 | (doto history 38 | (goog.events/listen EventType.NAVIGATE 39 | ;; wrap in a fn to allow live reloading 40 | #(handler-fn %)) 41 | (.setEnabled true))) 42 | 43 | 44 | (defn update-route! 45 | [app] 46 | ;; If we put this in here, for the API we have to somenow let you add your own route customizations... XXX 47 | (dispatcher/dispatch! (:dispatcher app) [::path-change js/window.location.pathname])) 48 | 49 | 50 | (reactor/register-handler ::path-change 51 | (fn [app db [_ new-path]] 52 | (log/debug "Routing path change" new-path) 53 | (reactor/resolve-to app db [[:dat.view.settings/update [::current-path new-path]]]))) 54 | 55 | 56 | (defn make-handler-fn 57 | [app] 58 | (fn [_] 59 | ;; Ideally, we'd be albe to extract the new route from the event... 60 | (update-route! app))) 61 | 62 | ;; Should rewrite these from app 63 | (def current-route 64 | (memoize 65 | (fn [app] 66 | (reaction 67 | ;; Actually... :dat.sync/route should maybe just be its own ident... 68 | (bidi/match-route (utils/deref-or-value (:routes app)) 69 | (or @(settings/get-setting app ::current-path) "/")))))) 70 | 71 | 72 | ;; XXX Should probably handle this through a handler... but for now... 73 | (defn set-route! 74 | [app {:as route :keys [handler route-params]}] 75 | (log/info "set-route! to route:" route) 76 | (let [flattened-params (-> route-params seq flatten vec) 77 | _ (log/debug "flattened-params:" flattened-params) 78 | path-for-route (apply bidi/path-for 79 | (utils/deref-or-value (or (:routes app) routes/routes)) 80 | handler 81 | flattened-params)] 82 | (if-not path-for-route 83 | (do 84 | (log/error "Hit bad route with params:" (with-out-str (pr-str flattened-params))) 85 | (log/error "Bad route path:" path-for-route) 86 | (js/alert "Hit a bad route: " (pr-str route-params))) 87 | (.setToken (:history app) 88 | path-for-route)))) 89 | 90 | 91 | -------------------------------------------------------------------------------- /src/dat/view/routes.cljc: -------------------------------------------------------------------------------- 1 | (ns dat.view.routes 2 | #?(:cljs (:require [reagent.core :as r]))) 3 | 4 | 5 | ;; Defining routes, and any client vs server agnostic functionality 6 | 7 | ;; Should have some way of pulling routes out of this scenario 8 | 9 | 10 | (def routes 11 | ["/" {"" :index 12 | ;; uber generix 13 | ["entity/" [#"\d+" :db/id]] {"/view" :view-entity 14 | "/edit" :edit-entity} 15 | ;; Should be able to add guard here, but wasn't able... Need to try again 16 | ;["entity/create/" [#"[\d[a-zA-Z]\-]*" :datview.creation/token]] :create-entity 17 | ["entity/create/" :dat.view.creation/token] :create-entity 18 | ;; Create an entity with a given type 19 | ;; (not sure why keyword isn't working here.. should; if not need to write workarounds... 20 | ;["create/" [keyword :e/type]] :create-entity 21 | ;; Need to add schema controls still... 22 | "schema/" :schema}]) 23 | 24 | 25 | -------------------------------------------------------------------------------- /src/dat/view/settings.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view.settings 2 | (:require [datascript.core :as d] 3 | [reagent.core :as r] 4 | [reagent.ratom :refer-macros [reaction]] 5 | [dat.reactor :as reactor] 6 | [dat.reactor.dispatcher :as dispatcher] 7 | [taoensso.timbre :as log] 8 | [posh.reagent :as posh])) 9 | 10 | 11 | ;; Should really split these up... 12 | (def schema 13 | ;; How to create singleton entities? 14 | {:db/ident {:db/unique :db.unique/identity} 15 | :dat.view/settings {} 16 | ;; All routing should be based on a routing entity; future XXX 17 | :dat.view.router/current-path {}}) 18 | 19 | 20 | (defn init! 21 | [app] 22 | (let [tx [{:db/id (d/tempid -1) 23 | :db/ident :dat.view/settings 24 | :dat.view.router/current-path js/window.location.pathname}]] 25 | (d/transact! (:conn app) tx))) 26 | 27 | 28 | ;; TODO We should just be registering transaction functions 29 | 30 | (reactor/register-handler ::update 31 | (fn [app db [_ [setting-ident setting-value]]] 32 | (let [tx [{:db/ident :dat.view/settings setting-ident setting-value}]] 33 | (reactor/resolve-to app db [[:dat.reactor/local-tx tx]])))) 34 | 35 | (defn update-setting 36 | [app setting new-value] 37 | (log/debug "update-setting called with" setting new-value) 38 | (dispatcher/dispatch! (:dispatcher app) [::update [setting new-value]])) 39 | 40 | (defn get-setting 41 | ([app setting-ident] 42 | (reaction 43 | (get 44 | @(get-setting app) 45 | setting-ident))) 46 | ([app] 47 | (posh/pull (:conn app) '[*] [:db/ident :dat.view/settings]))) 48 | 49 | ;; TODO Buid out stuff for syncing settings objects for users 50 | 51 | 52 | 53 | 54 | -------------------------------------------------------------------------------- /src/dat/view/styles.cljc: -------------------------------------------------------------------------------- 1 | (ns dat.view.styles) 2 | 3 | (def ^:dynamic box-styles 4 | {:display "inline-flex" 5 | :flex-wrap "wrap"}) 6 | 7 | (def ^:dynamic h-box-styles 8 | (merge box-styles 9 | {:flex-direction "row"})) 10 | 11 | (def ^:dynamic v-box-styles 12 | (merge box-styles 13 | {:flex-direction "column"})) 14 | 15 | (def ^:dynamic bordered-box-style 16 | {:border "2px solid grey" 17 | :margin "3px" 18 | :background-color "#E5FFF6"}) 19 | 20 | (def ^:dynamic error-styles 21 | (merge v-box-styles 22 | {:border "2px solid red" 23 | :margin "3px" 24 | :background-color "#FFE5E5"})) 25 | -------------------------------------------------------------------------------- /src/dat/view/table.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view.table 2 | (:require-macros [reagent.ratom :refer [reaction]] 3 | [cljs.core.async.macros :refer [go go-loop]]) 4 | ;; Need to abstract the ws 5 | (:require 6 | [dat.view :as dat.view] 7 | [dat.view.router :as router] 8 | [dat.view.settings :as settings] 9 | [dat.view.representation :as representation] 10 | [cljs-time.core :as cljs-time] 11 | [cljs-time.format] 12 | [cljs-time.coerce] 13 | [cljs.pprint :as pp] 14 | [cljs.core.match :as match :refer-macros [match]] 15 | [cljs.core.async :as async] 16 | [datascript.core :as d] 17 | [reagent.core :as r] 18 | [re-com.core :as re-com] 19 | [posh.reagent :as posh] 20 | [testdouble.cljs.csv :as csv] 21 | ;; Couldn't get this to work, but would be nice to try again 22 | ;[cljsjs.papaparse :as csv] 23 | [cljs-uuid-utils.core :as uuid] 24 | [goog.date.Date] 25 | [bidi.bidi :as bidi] 26 | [taoensso.timbre :as log] 27 | [datafrisk.core :as frisk])) 28 | 29 | 30 | 31 | ;; ## The model, effectively 32 | 33 | ;; Really, we should be doing this by serializing pull expressions as isComponent entities. 34 | ;; That'll be more correct and extensible. 35 | ;; But I don't have time now to get that right. 36 | 37 | ;(def pull-expr-schema 38 | ; {:dat.type/PullExpression {:e/type :e.type/Type} 39 | ; :dat.sys/pull {:db/valueType :db.type/ref} 40 | ; :dat.sys.pull/attributes {:db/valueType :db.type/ref} 41 | ; ;; This just points to other pull expressions 42 | ; :dat.sys.pull/ref-attributes {:db/valueType :db.type/ref}}) 43 | 44 | 45 | ;; For now,m we'll just be tracking what attributes have been selected or not, and it will recursively pull from all of those. 46 | 47 | ;; As datomic schema, would look roughly like this: But need a better way to transact this stuff in datsync I 48 | ;; think, since we might not want to actually mark it with remote.db/id 49 | 50 | ;(def table-column-selector-schema 51 | ;[{:db/id -1 52 | ;:db/ident ::columns 53 | ;:db/cardinality [:db/ident :db.cardinality/many] 54 | ;:db/valueType [:db/ident :db.type/ref]} 55 | ;{:db/id -2 56 | ;:db/ident ::types 57 | ;:db/cardinality [:db/ident :db.cardinality/many] 58 | ;:db/valueType [:db/ident :db.type/ref]} 59 | 60 | ;; Here's what this looks like as datascript schema: 61 | 62 | (def table-column-selector-schema 63 | {::columns {:db/cardinality :db.cardinality/many 64 | :db/valueType :db.type/ref} 65 | ::base-type {:db/valueType :db.type/ref} 66 | ::types {:db/cardinality :db.cardinality/many 67 | :db/valueType :db.type/ref}}) 68 | 69 | (defn selected-columns 70 | [app column-selector] 71 | (posh/pull (:conn app) '[::columns] column-selector)) 72 | 73 | 74 | ;; This stuff is for representing the type relation tree, on which we organize the checkboxes for which attributes are selected in the column selector. 75 | ;; Really, this should be merged with the idea of serialized (as entities/datoms) pull expressions as the more standard way of doing things. 76 | 77 | (def type-tree-pull-pattern 78 | '[:db/id :e/type :db/ident :e/name ::_types :e.type/_isa 79 | {:e.type/attributes [:db/id :db/ident :attribute/label ::_columns :attribute.ref/types {:db/valueType [:db/ident]}] 80 | :db/valueType [:db/ident]}]) 81 | 82 | (defn type-attribute-tree 83 | "Returns a posh reaction of the recursive pull of types defined by type-tree-pull-pattern" 84 | [db type-id] 85 | (d/pull db type-tree-pull-pattern type-id)) 86 | 87 | (defn type-attribute-tree-reaction 88 | "Returns a posh reaction of the recursive pull of types defined by type-tree-pull-pattern" 89 | [app type-id] 90 | (posh/pull (:conn app) type-tree-pull-pattern type-id)) 91 | 92 | ;; Not sure what the deal is with this; Must have written and then figured I didn't need it 93 | ;(defn selected-column-paths 94 | ; ([app base-type-id] 95 | ; (selected-column-paths app base-type-id [])) 96 | ; ([app base-type-id base-path] 97 | ; (reaction 98 | ; (let [type-entity @(type-attribute-tree-reaction app base-type-id) 99 | ; selected-attributes (filter :table.view.column/_attributes (:e.type/attributes type-entity))])))) 100 | 101 | ;; OK; time to actually construct our table data query. 102 | 103 | ;; This is going to be recursive. 104 | ;; For each type level, we should compute the query needed to get all of the immediately selected attributes. 105 | ;; We then recur over the types pointed to by any selected ref attributes. 106 | ;; As we recur down these types, we hand the recursion the base binding for the entity that it should be bound 107 | ;; to. 108 | ;; The variables we wish to fetch our also kept in a mapping of paths to variable names (or vice versa) so 109 | ;; that we can name columns based on their paths. 110 | ;; We can't go down each branch separately, but have to in series and reduce into an accumulative product. 111 | 112 | ;; Again, this naming system isn't ideal; it leaves room for duplicates. 113 | ;; Ideally we be able to have unique entries, via pull serialization, or some such. 114 | 115 | 116 | ;; Going to eventually reimplement in terms of pull (at least as an option), but for right now, we iteratively build a table 117 | 118 | (defn gen-sym 119 | [attribute-ident] 120 | (symbol (str "?" (name attribute-ident) "-" (rand-int 10000000)))) 121 | 122 | 123 | ;; First some stuff for producing information based on pull data 124 | 125 | ;; Should add a second arity to this so it can return a reaction based on ident or eid 126 | 127 | (defn selected-attribute? 128 | ([attr-pull-data] 129 | (boolean (::_columns attr-pull-data)))) 130 | 131 | (declare apply-type-to-query) 132 | 133 | ;(defn conj-if-not) 134 | ;; Pick up todo: Pull out new find and new where and new path under a single if (-> attr ... :ref?) 135 | ;; Then do the same for where the whole thing gets initialized for removing based eid as well 136 | ;; Could also just do everything after the fact based on paths, but feels somewhat wrong. 137 | ;; Though would include duplicate rows that way, for better or worse 138 | ;; If it's easier I'll do it that way maybe 139 | 140 | (defn apply-attribute-to-query 141 | [db {:as context :keys [query base-path sym-mapping base-sym]} attr-entity] 142 | (let [attr-ident (:db/ident attr-entity) 143 | attr-sym (gen-sym attr-ident) 144 | ref-attr? (-> attr-entity :db/valueType :db/ident (= :db.type/ref)) 145 | [path find-clause] 146 | (if (and ref-attr? (not (::show-ids? context))) 147 | [base-path (:find query)] 148 | [(conj base-path attr-ident) 149 | (conj (:find query) attr-sym)]) 150 | path (conj base-path attr-ident) 151 | sym-mapping (assoc sym-mapping attr-sym path) 152 | new-where-clause (if ref-attr? 153 | [base-sym attr-ident attr-sym] 154 | ;; This does not work... really just need to switch to pull expressions 155 | ;[(list 'get-else '$ base-sym attr-ident 0) attr-sym] 156 | [(list 'get-else '$ base-sym attr-ident "NA") attr-sym]) 157 | new-context (assoc context 158 | :query (-> query 159 | (assoc :find find-clause) 160 | (update :where 161 | conj 162 | new-where-clause)) 163 | ;[base-sym attr-ident attr-sym])) 164 | :base-path path 165 | :sym-mapping sym-mapping 166 | :base-sym attr-sym)] 167 | (if-let [attr-ref-types (seq (:attribute.ref/types attr-entity))] 168 | (reduce 169 | (fn [current-context type-id] 170 | (apply-type-to-query db new-context type-id)) 171 | new-context 172 | (map :db/id attr-ref-types)) 173 | new-context))) 174 | 175 | (defn apply-type-to-query 176 | ([db base-type-id] 177 | (apply-type-to-query db {:base-path [] :sym-mapping {}} base-type-id)) 178 | ([db {:as context :keys [query base-path sym-mapping base-sym]} base-type-id] 179 | (let [type-entity (type-attribute-tree db base-type-id) 180 | base-sym (or base-sym '?eid) 181 | query (or query {:find [base-sym] :in '[$ [?eid ...]] :where '[[?eid]]})] 182 | (reduce 183 | (fn [current-context attr-entity] 184 | (assoc (apply-attribute-to-query db current-context attr-entity) 185 | :base-path base-path 186 | :base-sym base-sym)) 187 | (assoc context :query query :base-sym base-sym) 188 | (filter selected-attribute? (:e.type/attributes type-entity)))))) 189 | 190 | (defn type-query 191 | ([db base-type-id] 192 | (:query (apply-type-to-query db base-type-id)))) 193 | 194 | (defn type-query-reaction 195 | ([conn-reaction base-type-id] 196 | (reaction (dissoc (apply-type-to-query @conn-reaction base-type-id) :base-path :base-sym)))) 197 | 198 | (defn unfolded-types 199 | [app column-selector] 200 | (posh/pull (:conn app) '[* {::types [:db/id]}] column-selector {:cache :forever})) 201 | 202 | (defn r-unfolded-type? 203 | [app column-selector type-id] 204 | (reaction 205 | (let [pull-results @(unfolded-types app column-selector)] 206 | (not 207 | ((->> pull-results ::types (map :db/id) set) 208 | type-id))))) 209 | 210 | (defn collapse-button 211 | "A collapse button for hiding information; arg collapse? should be a bool or an ratom thereof. 212 | If no click handler is specified, toggles the atom." 213 | ([collapse? on-click-fn] 214 | (let [[icon-name tooltip] (if (try @collapse? (catch js/Object e collapse?)) ;; not positive this will work the way I expect 215 | ["zmdi-caret-right" "Expand collection"] 216 | ["zmdi-caret-down" "Hide collection"])] 217 | [re-com/md-icon-button :md-icon-name icon-name 218 | :tooltip tooltip 219 | :on-click on-click-fn])) 220 | ([collapse?] 221 | (collapse-button collapse? (fn [] (swap! collapse? not))))) 222 | 223 | 224 | 225 | (defn type-folder 226 | [app column-selector type-entity] 227 | ;; Could do this as pull, but would only want to if we had hooked up smarter query rendering capabilities 228 | (let [type-id (:db/id type-entity) 229 | unfolded? (r-unfolded-type? app column-selector type-id)] 230 | (fn [app column-selector type-entity] 231 | [re-com/h-box 232 | :gap "3px" 233 | :children [[dat.view/collapse-button 234 | @unfolded? 235 | ;; TODO Rewrite in terms of the dispatch 236 | (fn [] (d/transact! (:conn app) 237 | [[(if @unfolded? :db/add :db/retract) 238 | column-selector 239 | ::types 240 | type-id]]))] 241 | [re-com/label :style {:font-weight "bold"} :label (:e/name type-entity)]]]))) 242 | 243 | ;; What about a compilation step for components to pull out from them all the logic of changing the schema, 244 | ;; since that should only happen infrequently? XXX 245 | 246 | (declare attribute-column-selector-rows) 247 | 248 | ;(defn selected-columns 249 | ; [app column-selector] 250 | ; (posh/pull (:conn app) [::columns] column-selector)) 251 | 252 | (defn column-selected? 253 | [app column-selector attr-eid] 254 | ;; TODO need to generalize attr-eid here to be any id; ok because only usage below is an entity always 255 | (reaction 256 | ((->> @(selected-columns app column-selector) ::columns (map :db/id) set) 257 | attr-eid))) 258 | 259 | (defn attribute-column-selector-row 260 | "The selector for whether a particular attribute should end up in the output data. Seen should be a set of type identities which 261 | have already been seen to avoid infinite recursion with type reference cycles (overcoats)." 262 | ([app column-selector attr-entity seen] 263 | (let [conn (:conn app) 264 | checked? (column-selected? app column-selector (:db/id attr-entity))] 265 | [re-com/v-box 266 | :style {:padding-left "12px"} 267 | :gap "3px" 268 | :children [[re-com/h-box 269 | :gap "5px" 270 | :children [[re-com/checkbox 271 | :model checked? 272 | :on-change (fn [checked-now?] 273 | (d/transact! conn [[(if checked-now? :db/add :db/retract) column-selector ::columns (:db/id attr-entity)]]))] 274 | [re-com/label :label (dat.view/pull-summary-string attr-entity)]]] 275 | (when @checked? 276 | ;; Present types for possible expansion 277 | [re-com/v-box 278 | :children (for [ref-type-id (map :db/id (:attribute.ref/types attr-entity))] 279 | ;; Not sure what the semantics of nil/key are in this case? 280 | ^{:key ref-type-id} 281 | [attribute-column-selector-rows app column-selector ref-type-id seen])])]]))) 282 | 283 | (defn attribute-column-selector-rows 284 | "The rows in a attribute column selector for a table view given a type entity view with nested 285 | entities for attributes and subtypes." 286 | ([app column-selector type-id] 287 | [attribute-column-selector-rows app column-selector type-id #{}]) 288 | ([app column-selector type-id seen] 289 | (let [type-entity (type-attribute-tree-reaction app type-id) 290 | unfolded? (r-unfolded-type? app column-selector type-id)] 291 | (fn [app column-selector type-id seen] 292 | (let [type-eid (:db/id @type-entity)] 293 | (if-not (seen type-eid) 294 | [re-com/v-box 295 | :style {:padding-left "10px"} 296 | :children [[type-folder app column-selector @type-entity] 297 | (when-not @unfolded? 298 | [re-com/v-box 299 | ;; First, render the same thing for the subtypes, so their attributes can show up if unfolded 300 | :children [[re-com/v-box 301 | :children (for [subtype-id (map :db/id (:e.type/_isa @type-entity))] 302 | ^{:key subtype-id} 303 | [attribute-column-selector-rows app column-selector subtype-id (conj seen type-eid)])] 304 | ;; This is all of the types directly assigned attribute selection rows 305 | [re-com/v-box 306 | :children (for [attr-entity (:e.type/attributes @type-entity)] 307 | ^{:key (:db/id attr-entity)} 308 | [attribute-column-selector-row app column-selector attr-entity (conj seen type-eid)])]]])]] 309 | [re-com/label :label "This type has already been specified"])))))) 310 | 311 | (defn collapsed? 312 | []) 313 | 314 | (representation/register-representation 315 | ::column-selector 316 | (fn [app [_ context-data] column-selector-id] 317 | (let [collapse? (r/atom true)] 318 | (fn [app [_ context-data] column-selector-id] 319 | (let [base-type (::base-type context-data)] 320 | [re-com/v-box 321 | :children [[re-com/h-box 322 | :children [[dat.view/collapse-button collapse?] 323 | [re-com/title :level :level3 :label "Table column selector:"]]] 324 | (when-not @collapse? 325 | [re-com/border 326 | :border "1px solid black" 327 | :width "300px" 328 | :max-height "300px" 329 | :style {:overflow-y "scroll"} 330 | ;; TODO Switch to posh/entid when that is implemented 331 | :child (let [base-type-id (:db/id @(posh/pull (:conn app) '[:db/id] base-type))] 332 | [attribute-column-selector-rows app column-selector-id base-type-id])])]]))))) 333 | 334 | ; Build a magical selector for attributes 335 | (defn attribute-column-selector 336 | "The top level attribute column selector component; based on type eid or lookup ref (like [:db/ident :e.type/Comment])." 337 | [app column-selector base-type] 338 | [representation/represent app [::column-selector {::base-type base-type}] column-selector]) 339 | 340 | 341 | (representation/register-representation 342 | ::row-value-view 343 | (fn [app [_ context-data] value] 344 | [:td {:style {:padding "4px 8px"}} 345 | ;; If here we know in context what the path is to the data, we should pass that along as well 346 | (if-let [path (::path context-data)] 347 | ;; Then we should have enough info to use :dat.view/value-view 348 | ;; XXX Note; this hasn't been tested yet and is probably broken, so dont pass path and use generic for now 349 | ;; Also make sure to rewrite with attr-ident in context 350 | (let [attr-ident (last path) 351 | context-data' (assoc context-data ::path path 352 | :attribute/ident attr-ident)] 353 | [dat.view/represent app [:dat.view/value-view context-data'] value]) 354 | ;; Otherwise, just stringify; This could also maybe be a separate mm dispatch 355 | (str value))])) 356 | 357 | 358 | ;; Context data should have 359 | (representation/register-representation 360 | ::row-view 361 | (fn [app [_ context-data] row] 362 | (let []) 363 | [:tr 364 | ;; If here we know in context what the path is to the data, we should pass that along as well 365 | (for [[i value] (map-indexed vector row)] 366 | (let [path (nth (::paths context-data) i nil)] 367 | ^{:key i} 368 | [dat.view/represent app 369 | [::row-value-view (assoc context-data 370 | ;; Shoud be associng in the attr-ident as well 371 | ::path path 372 | :db.attr/ident (last path) 373 | ::row-index i)] 374 | value]))])) 375 | 376 | 377 | (defn entity-row-view 378 | ([app context-data paths row] 379 | [dat.view/represent app [::row-view (merge context-data {::paths paths})] row]) 380 | ([app paths row] 381 | [entity-row-view app {} paths row])) 382 | 383 | 384 | (defn path-name 385 | [path] 386 | (if-let [path-names (seq (map name path))] 387 | (clojure.string/join "/" (take-last 2 path-names)) 388 | "db-id")) 389 | 390 | (defn ordered-paths 391 | [{:as query-context :keys [query sym-mapping]}] 392 | (mapv sym-mapping (:find query))) 393 | 394 | 395 | ;; Again, this is gonna have to totally change once we refactor to accept (and probably prefer) pull 396 | (representation/register-representation 397 | ::header-view 398 | (fn [app [_ context-data] _] 399 | (let [{:keys [query sym-mapping]} context-data 400 | find-syms (:find query)] 401 | [:tr 402 | (for [sym find-syms] 403 | (let [path (sym-mapping sym)] 404 | ^{:key (hash path)} 405 | ;; TODO This should really be based on :dat.view/attr-label 406 | [:th 407 | {:style {:padding "8px"}} 408 | (path-name path)]))]))) 409 | 410 | 411 | (defn header-view 412 | [app context-data] 413 | [dat.view/represent app [::header-view context-data] nil]) 414 | 415 | 416 | ;; Writing out results 417 | 418 | ;(defn evaluate-query 419 | ;[app query-context eids] 420 | ;(posh/q (:query query-context) (:conn app) eids)) 421 | 422 | ;; Here's more or less how you can do the download in js (from 423 | ;; http://stackoverflow.com/questions/14964035/how-to-export-javascript-array-info-to-csv-on-client-side) 424 | ;; 425 | ;; var csvContent = "data:text/csv;charset=utf-8,"; 426 | ;; data.forEach(function(infoArray, index){}) 427 | ;; dataString = infoArray.join(","); 428 | ;; csvContent += index < data.length ? dataString+ "\n" : dataString; 429 | ;; }); 430 | ;; 431 | ;; Then you can use JavaScript's window.open and encodeURI functions to download the CSV file like so: 432 | ;; 433 | ;; var encodedUri = encodeURI(csvContent); 434 | ;; window.open(encodedUri); 435 | 436 | 437 | (defn format-csv 438 | [rows] 439 | (->> rows 440 | (map (partial map pr-str)) 441 | (csv/write-csv))) 442 | 443 | ;; XXX Would really like to use the js papa lib for this but can't figure out how to do cljsjs 444 | ;(println (format-csv [["1,000" "2" "3" "frank,this"] [4 "5,\"000" "6"]])) 445 | 446 | (defn download-csv 447 | [paths rows] 448 | (let [csv-content "data:text/csv;charset=utf-8," 449 | rows (vec (concat [(mapv path-name paths)] 450 | rows)) 451 | csv-content (str csv-content (format-csv rows)) 452 | encode-uri (js/encodeURI csv-content)] 453 | (.open js/window encode-uri))) 454 | 455 | 456 | ;; Here we should be able to extend the table view via the context interpretation 457 | ;; But for right now just assuming data is eids 458 | (representation/register-representation 459 | :dat.view/table-view 460 | (fn [app [_ context-data] [base-type eids]] 461 | (let [column-selector (::column-selector context-data) 462 | ;base-type (::base-type context-data) 463 | conn (:conn app) 464 | conn-reaction (dat.view/as-reaction conn) 465 | query-context (type-query-reaction conn-reaction base-type)] 466 | ;query-results (evaluate-query conn query-context eids)] 467 | (fn [app [_ context-data] [base-type eids]] 468 | (let [ordered-paths (ordered-paths @query-context) 469 | ;; Question: What if conn changes? Compute in inner fn? 470 | ;; TODO Should translate this to posh/q 471 | rows @(dat.view/safe-q (:query @query-context) conn eids)] 472 | [re-com/v-box 473 | :gap "15px" 474 | :children [[re-com/title :level :level2 :label "Table view"] 475 | [re-com/h-box 476 | :gap "20px" 477 | :children [[re-com/md-icon-button 478 | :md-icon-name "zmdi-download" 479 | :tooltip "Download table as CSV" 480 | :on-click (partial download-csv ordered-paths rows)] 481 | [attribute-column-selector app column-selector base-type]]] 482 | [:table 483 | [:tbody 484 | [header-view app @query-context] 485 | (for [row rows] 486 | ^{:key (hash row)} 487 | [dat.view/represent app [::row-view context-data] row])]]]]))))) 488 | ;[entity-row-view ordered-paths row])]]]])))) 489 | 490 | 491 | ;; This is more or less deprecated and going to be rewritten, so don't build on it for now. 492 | ;; Backwards compatibility 493 | (defn table-view 494 | ;; Should generate a column-selector from 495 | [app column-selector base-type eids] 496 | (dat.view/represent app 497 | [:dat.view/table-view {::mode ::eids 498 | ::base-type base-type 499 | ::column-selector column-selector}] 500 | eids)) 501 | 502 | -------------------------------------------------------------------------------- /src/dat/view/utils.cljs: -------------------------------------------------------------------------------- 1 | (ns dat.view.utils 2 | ;(:require-macros [reagent.ratom :refer [reaction]]) 3 | (:require 4 | [datascript.core :as d] 5 | [reagent.core :as r] 6 | [reagent.ratom :as ratom :refer-macros [reaction]] 7 | [posh.reagent :as posh] 8 | [taoensso.timbre :as log])) 9 | 10 | ;(defn deref-or-value 11 | ; [val-or-atom] 12 | ; (if (satisfies? #?(:cljs IDeref :clj clojure.lang.IDeref) val-or-atom) @val-or-atom val-or-atom)) 13 | (defn deref-or-value 14 | [val-or-atom] 15 | (if (satisfies? IDeref val-or-atom) @val-or-atom val-or-atom)) 16 | 17 | (defn deep-merge 18 | "Like merge, but merges maps recursively." 19 | ;; XXX Need to be able to specify customizations for how things like vectors are going to merge; 20 | ;; May not always want to do what is described here 21 | [& maps] 22 | (if (every? #(or (map? %) (nil? %)) maps) 23 | (apply merge-with deep-merge maps) 24 | (last maps))) 25 | 26 | 27 | (def ratom r/atom) 28 | 29 | 30 | ;; If we build/mock a reaction macro for clj, we could build these out for both 31 | ;; is it bad to memoize this? Would rather use a dispenser... 32 | (def as-reaction 33 | "Treat a regular atom as though it were a reaction; Be careful, memoizes (we might end up using a dispensor trick 34 | like posh does to avoid this, but that limits us to using conns; can't get listeners/watches with regular atoms...)" 35 | (memoize 36 | (fn 37 | [vanilla-atom] 38 | (let [trigger (ratom 0)] 39 | (add-watch vanilla-atom :as-reaction-trigger (fn [& _] (swap! trigger inc))) 40 | (reaction 41 | @trigger 42 | @vanilla-atom))))) 43 | 44 | 45 | ;; XXX This will be coming to posh soon, but in case we need it earlier 46 | 47 | (def safe-q 48 | "A version of posh/q without any transaction pattern matching filters (al a posh) that delegates directly to d/q, and 49 | wraps in a reaction" 50 | ;posh/q) 51 | (memoize 52 | (fn [query conn & args] 53 | (reaction 54 | (let [conn (as-reaction conn) 55 | db (deref-or-value conn) 56 | args (mapv deref-or-value args)] 57 | (apply d/q query db args)))))) 58 | 59 | ;; QUESTION Should this be wrapped in a reaction as well? 60 | (defn pull-many 61 | [app pattern eids] 62 | (map (partial posh/pull (:conn app) pattern) 63 | (deref-or-value eids))) 64 | 65 | 66 | (def pull-attr 67 | "Wraps safe pull, and etracts the results for a given attr" 68 | (memoize 69 | (fn 70 | ([conn eid attr-ident options] 71 | (reaction 72 | (get @(posh/pull conn [attr-ident] eid options) attr-ident))) 73 | ([conn eid attr-ident] 74 | (pull-attr conn eid attr-ident {}))))) 75 | 76 | 77 | (def pull-path 78 | (memoize 79 | (fn 80 | ([conn eid attr-path options] 81 | ;; Question: Should use cursor? 82 | (reaction 83 | (get-in 84 | @(posh/pull conn (vec (filter keyword? attr-path)) eid options) 85 | attr-path))) 86 | ([conn eid attr-path] 87 | (pull-path conn eid attr-path {}))))) 88 | 89 | 90 | 91 | --------------------------------------------------------------------------------