├── .elpaignore ├── .github └── workflows │ └── ci.yaml ├── .gitignore ├── COPYING ├── Eldev ├── NEWS.org ├── README.org ├── triples-backups-test.el ├── triples-backups.el ├── triples-design.org ├── triples-fts-test.el ├── triples-fts.el ├── triples-test-utils.el ├── triples-test.el ├── triples-upgrade.el └── triples.el /.elpaignore: -------------------------------------------------------------------------------- 1 | *-test*.el 2 | Eldev 3 | -------------------------------------------------------------------------------- /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [ "main" ] 6 | pull_request: 7 | branches: [ "*" ] 8 | 9 | jobs: 10 | test: 11 | runs-on: ubuntu-latest 12 | environment: Continuous Integration 13 | strategy: 14 | matrix: 15 | emacs_version: 16 | # 28.1 and 28.2 should be tested, but they are not working for reasons 17 | # I haven't figured out yet, and I haven't been able to test manually 18 | # for other reasons I haven't figured out yet. 19 | - 29.1 20 | - 29.2 21 | steps: 22 | - name: Set up Emacs 23 | uses: jcs090218/setup-emacs@master 24 | with: 25 | version: ${{matrix.emacs_version}} 26 | 27 | - name: Install Eldev 28 | uses: emacs-eldev/setup-eldev@v1 29 | 30 | - name: Check out the source code 31 | uses: actions/checkout@v4 32 | 33 | - name: Lint the project 34 | run: | 35 | eldev -p -dtT lint 36 | 37 | - name: Test the project 38 | run: | 39 | eldev -p -dtT test 40 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | .eldev -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | , 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. -------------------------------------------------------------------------------- /Eldev: -------------------------------------------------------------------------------- 1 | ; -*- mode: emacs-lisp; lexical-binding: t -*- 2 | 3 | (eldev-use-package-archive 'melpa) 4 | (eldev-use-plugin 'maintainer) 5 | (eldev-add-extra-dependencies 'test '(:package emacsql)) 6 | (eldev-add-extra-dependencies 'test '(:package kv)) 7 | (eldev-add-extra-dependencies 'emacs '(:package emacsql)) 8 | (eldev-add-extra-dependencies 'emacs '(:package kv)) 9 | 10 | ;; To both deal with emacsql and built-in sqlite in various versions, we need to 11 | ;; weird things that package linting doesn't like. So we disable this specific 12 | ;; kind of linting. 13 | (add-to-list 'eldev-lint-disabled 'package) 14 | -------------------------------------------------------------------------------- /NEWS.org: -------------------------------------------------------------------------------- 1 | TITLE: Changelog for the triples module for GNU Emacs. 2 | 3 | * 0.5.1 4 | - Add an optional limit for =triples-search=, and document it. 5 | * 0.5.0 6 | - Add FTS for adding full text search. 7 | - Fix for emacsql using an obsolete (or wrong) db opening function. 8 | * 0.4.1 9 | - Remove test files from GNU ELPA package. 10 | * 0.4.0 11 | - Add =triples-count=, to return a count of all triples. 12 | - Add =triples-remove-schema-type=, to delete schema and all its associated data. 13 | * 0.3.5 14 | - Compilation issues, and fixing an issue with not being able to use triples-with-transaction in some cases. 15 | * 0.3.4 16 | - Fix instances where the database has no index, and has duplicate rows because of that index. 17 | - Fix differences in the properties column between emacsql and builtin when upgrading from emacsql to builtin. 18 | * 0.3.3 19 | - Fix error in upgrade code SQL that occurs when integer conflicts are found. 20 | * 0.3.2 21 | - Remove hard dependency on the sqlite library, which is a problem for emacs 28 users. 22 | * 0.3.1 23 | - Fix issue with issue where duplicate values could interfere with table index creation during upgrade, causing type duplication. 24 | * 0.3 25 | - All integers are stored as integers, and not strings. Applications using this library in previous versions should have users run ~triples-upgrade-to-0.3~. 26 | - Fix for issue where adding schema would overwrite non-schema data on the same subject. 27 | * 0.2.7 28 | - Add new function =triples-db-select-pred-op=, which allows querying among predicates for objects with a certain relationship to values, replaces =triples-db-select-predicate-object-fragment=. 29 | - Add ability to store cons types (basically lists) as values. 30 | * 0.2.6 31 | - Fix bug where the functions =triples-subjects-with-predicate-object= could return the same subject multiple times. 32 | - Fix bug where backups were causing messages about "obsolete timestamp" for some users on Emacs 28.2. 33 | * 0.2.5 34 | - Fix bug where backing up a =nil= filename resulted in an error. 35 | - Fix bug where strings are wrongly escapified, distoring text especially when repeatedly saved. 36 | * 0.2.4 37 | - Move the =CHANGELOG.org= file to =NEWS.org= so the changes show up in GNU ELPA. 38 | * 0.2.3 39 | - Allow =nil= for =filename= arguments in the backup functions. This will default to backing up the default database. 40 | - Fix issue with fallback for bad backup strategies. 41 | * 0.2.2 42 | - Fix error behavior using Emacs builtin sqlite. Now error is rethrown instead of swallowed. 43 | * 0.2.1 44 | - Add backup strategy =never=. 45 | * 0.2 46 | - Create a default database to encourage a shared triple database. Add information on why this is an interesting idea in the README. 47 | - Add support for backups of databases via =triples-backup=, and a simple way to have a sane and shared backups created with the new =triples-backups= module. 48 | - Add =triples-move-subject= which will move both a subject as well as reference to it. 49 | * 0.1.2 50 | - Bugfix release to remove backward compatibility with pre-Emacs 29 versions. 51 | * 0.1.1 52 | - Bugfix release to fix =triples-subject-with-predicate-object=. 53 | * 0.1 54 | - This is the initial version that contained basic triple functionality, and was integrated into GNU ELPA. 55 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Triples 2 | 3 | The =triples= package is a standard database package designed for use in other emacs modules. It works with either the builtin sqlite in Emacs 29 or the [[https://github.com/magit/emacsql][emacsql]] package, and provides a simple way of storing entities and their associated schema. The triples package is well suited to graph-like applications, where links between entities are important. The package has wrappers for most common operations, but it is anticipated that occasionally client modules would need to make their own sqlite calls. Many different database instances can be handled by the =triples= package. It is expected that clients supply the database connection. However, a standard triples database can be used, which is defined in =triples-default-database-filename=, and used when no filename is used to connect to by clients of the triples library. 4 | 5 | This package is useful for simple applications that don't want to write their own SQL calls, as well as more complicated applications that want to store many different kinds of objects without having to set up and manage a variety of tables, especially when there is a graph-like relationship between the entities. It also is suited for applications where different packages want to store different data about the same set of entities, or store the same data about very different sets of entities. For example, having everything that has a creation time be treated uniformly, regardless of the type of entity, is something that would be require more advanced solutions in normal SQL but is standard and easy in a Triple database. These benefits are due to the fact that the storage is extremely regular and flexible, with a schema defining multiple types that are independent of each other, and with all the schema being software-managed, but installed in the database itself. The disadvantage is that it can be significantly more inefficient. However, for the kind of applications that emacs typically uses, the inefficiencies typically are not significant. 6 | 7 | * Installing 8 | This module is available through GNU ELPA, and can be installed as normal. However, most of the time this module is only useful in concert with another module which uses it as a library and will declare it as a dependency, so unless you are planning on developing with it, there is usually no need to install it directly. 9 | * Maturity 10 | This module is somewhat new and should be considered beta quality. 11 | 12 | While it has basic functionality, there are significant parts, such as a querying language, that are missing. Whether anyone needs such parts will determine the priority in which they get built. 13 | * Using the =triples= library 14 | ** Types and Schema 15 | =triples= employs a design in which each entity can be a member of many /types/, and each /type/ has multiple /properties/. The properties that a type has is defined by /schema/. Let's take an example: 16 | 17 | #+begin_src emacs-lisp 18 | ;; We assume a database called db has already been set up. 19 | (triples-add-schema db 'person 20 | '(name :base/unique t :base/type string) 21 | '(age :base/unique t :base/type integer)) 22 | (triples-add-schema db 'employee 23 | '(id :base/unique t :base/type integer) 24 | '(manager :base/unique t) 25 | '(reportees :base/virtual-reversed employee/manager)) 26 | #+end_src 27 | 28 | This adds a type called =person=, which can be set on any entity. There's another type called =employee=, which can also be set, independently of other types. This schema is stored in the database itself, so the database can function properly regardless on what elisp has been loaded. The schema can be redefined multiple times without any issues. 29 | 30 | The =person= has 2 properties, =name=, and =age=. They are both marked as unique, so they take a single value, not a list. If =:base/unique= was not true, the value would be a list. We also specify what type it is, which can be any elisp type. =employee= is similarly constructed, but has an interesting property, =reportees=, which is a =base/virtual-reversed= property, meaning that it is supplied with values, but rather can get them from the reversed relation of =employee/manager=. 31 | 32 | A valid =base/type= maps to elisp types, so can be values such as =integer=, =float=, =vector=, =cons=, =symbol=, or =string=. 33 | 34 | We'll explore how these types are used can be used in the section after next. 35 | ** The triples concept 36 | A triple is a unit of data consisting of a /subject/, a /predicate/, an /object/, and, optionally, internal metadata about the unit. The triple can be thought of as a link between the subject and object via the predicate. 37 | 38 | Let's say that, as in the example above, we want to store someone's name. The triples would be a /subject/ that uniquely identifies the person, a /predicate/ that indicates the link between subject and object is about a name, and the object, which is the name value. 39 | 40 | The object can become the subject, and this explains how the =base/virtual-reversed= predicate works. If Bob is the manager of Alice, then there could be a triple with Alice as the subject, =manager= as the predicate, and Bob as the object. But we can also find the reversed links, and ask who all are all the people that Bob manages. In this case, Bob is the subject, and Alice is the object. However, we don't actually need to store this information and try to keep it in sync, we can just get it by querying for when the Bob is the object and =manager= is the predicate. 41 | 42 | The ideas behind the database and notes on design can be found in the [[file:triples-design.org][triples-design.org file]]. 43 | ** Connecting 44 | Before a database can be used, it should be connected with. This is done by the =triples-connect= function, which can be called with a filename or without. If a filename isn't given, a default one for the triples library, given in =triples-default-database-filename= is used. This provides a standard database for those that want to take advantage of the possibilities of having data from different sources that can build on each other. 45 | 46 | An example of using this standard database is simply: 47 | #+begin_src emacs-lisp 48 | (let ((db (triples-connect))) 49 | (do-something-with db) 50 | (do-something-else-with db)) 51 | #+end_src 52 | You could also use a global variable to hold the database connection, if you need the database to be active during many user actions. 53 | ** Setting and retrieving 54 | A subject can be set all at once (everything about the subject), or dealt with per-type. For example, the following are equivalent: 55 | 56 | #+begin_src emacs-lisp 57 | (triples-delete-subject db "alice") 58 | (triples-set-type db "alice" 'person :name "Alice Aardvark" :age 41) 59 | (triples-set-type db "alice" 'employee :id 1901 :manager "bob") 60 | #+end_src 61 | 62 | #+begin_src emacs-lisp 63 | (triples-set-subject db "alice" '(person :name "Alice Aardvark" :age 41) 64 | '(employee :id 1901 :manager "bob")) 65 | #+end_src 66 | 67 | In the second, the setting of the entire subject implies deleting everything previously associated with it. 68 | 69 | Here is how the data is retrieved: 70 | 71 | #+begin_src emacs-lisp 72 | (triples-get-subject db "alice") 73 | #+end_src 74 | Which returns, assuming we have "catherine" and "dennis" who have "alice" as their =employee/manager=: 75 | #+begin_src emacs-lisp 76 | '(:person/name "Alice Aardvark" :person/age 41 :employee/id 1901 :employee/manager "bob" :employee/reportees '("catherine" "dennis")) 77 | #+end_src 78 | 79 | Or, 80 | #+begin_src emacs-lisp 81 | (triples-get-type db "alice" 'employee) 82 | #+end_src 83 | Which returns 84 | #+begin_src emacs-lisp 85 | '(:manager "bob" :reportees '("catherine" "dennis")) 86 | #+end_src 87 | 88 | Note that these subject names are just for demonstration purposes, and wouldn't make good subjects because they wouldn't be unique in practice. See [[file:triples-design.org][our document on triples design]] for more information. 89 | 90 | There are other useful functions, including: 91 | - =triples-get-types=, which gets all the types a subject has, 92 | - =triples-delete-subject=, which deletes all data associated with a subject, 93 | - =triples-with-predicate=, gets all triples that is about a specific property, 94 | - =triples-subject-with-predicate-object=, get all subjects whose predicate is equal to /object/, 95 | - =triples-subjects-of-type=, get all subjects which have a particular type. 96 | - =triples-search=, get all properties where a predicate matches given text. Can take an optional limit to restrict the number of results. 97 | - =triples-remove-schema-type= , remove a type and all associated data from the schema (should be rarely used). 98 | ** Predicates, with type and without 99 | Sometimes the triples library will require predicates that are without type, and sometimes with type, or "combined predicates". The rule is that if the type is already specified in the function, it does not need to be respecified. If the type is not specified, it is included in the combined predicate. 100 | 101 | When returning data, if data is from just one type, the type is not returned in the returned predicates. If the data is from multiple types, the type is returned as combined predicates. 102 | ** Using direct SQL access 103 | Sometimes clients of this library need to do something with the database, and the higher-level triples functionality doesn't help. If you would like lower-level functionality into handling triples, you can use the same low-level methods that the rest of this library uses. These start with =triples-db-=. 104 | - =triples-db-insert=: Add a triple. Uses SQL's =REPLACE= command, so there can't be completely duplicate triples (including the property, which often can serve as a disambiguation mechanism). 105 | - =triples-db-delete=: Delete triples matching the arguments. Empty arguments match everything, so =(triples-db-delete db)= will delete all triples. 106 | - =triples-db-delete-subject-predicate-prefix=: Delete triples matching subjects and with predicates with a certain prefix. This can't be done with =triples-db-delete= because that method uses exact matching for all arguments, and this uses prefix matching for the predicate. 107 | - =triples-db-select-pred-op=: Select triples that contain, for a predicate, an object with some relationship to the passed in value. This function lets you look for values equal to, greater, less, than or, "like", the passed in value. 108 | - =triples-db-select=: Select triples matching any of the parts of the triple. Like =triples-db-delete=, empty arguments match everything. You can specify exactly what to return with a selector. 109 | 110 | Sometimes this still doesn't cover what you might want to do. In that case, you should write your own direct database access. However, please follow the coding patterns for the functions above in writing it, so that the code works with both Emacs 29's builtin sqlite, and =emacsql=. 111 | ** Search 112 | Triples supports [[https://www.sqlite.org/fts5.html][SQLite's FTS5 extension]], which lets you run full text searches with scored results over text objects in the triples database. This will create new FTS tables to store the data necessary for the search. It is only available using the built-in sqlite in Emacs 29.1 and later. To enable: 113 | 114 | #+begin_src emacs-lisp 115 | (require 'triples-fts) 116 | (triples-fts-setup db) 117 | 118 | ;; If you need to rebuild the index 119 | (triples-fts-rebuild db) 120 | 121 | ;; Find the subjects for all objects that contain "panda", ordering by most 122 | ;; relevant to least. 123 | (triples-fts-query-subject db "panda") 124 | 125 | ;; Find the subjects for all objects with the predicate `description/text' (type 126 | ;; description, property text) that contain the word "panda", ordering by most 127 | ;; relevant to least. 128 | (triples-fts-query-subject db "description/text:panda") 129 | 130 | ;; The same, but with substitution with an abbreviation. 131 | (triples-fts-query-subject db "desc:panda" '(("desc" . "description/text"))) 132 | #+end_src 133 | 134 | This is different than =triples-search= which does a straight text match on a particular predicate only, and returns results without ranking them. 135 | ** Backups 136 | If your application wants to back up your database, the function =triples-backup= provides the capability to do so safely. It can be called like: 137 | #+begin_src emacs-lisp 138 | (triples-backup db db-file 3) 139 | #+end_src 140 | Where =db= is the database, =db-file= is the filename where that database is stored, and =3= is the number of most recent backup files to keep. All older backup files will be deleted. The backup is stored where other emacs file backups are kept, defined by =backup-directory-alist=. 141 | 142 | The =triples-backups= module provides a way to backup a database in a way defined in the database itself (so multiple clients of the same database can work in a sane way together). The number of backups to be kept, along with the "strategy" of when we want backups to happen is defined once per database. 143 | #+begin_src emacs-lisp 144 | ;; Set up a backup configuration if none exists. 145 | (require 'triples-backups) 146 | (unless (triples-backups-configuration db) 147 | (triples-backups-setup db 3 'daily)) 148 | #+end_src 149 | 150 | Once this is set up, whenever a change happens, simply call =triples-backups-maybe-backup= with the database and the filename where the database was opened from, which will back up the database if appropriate. This should be done after any important database write, once the action, at the application level, is finished. The triples module doesn't know when an appropriate point would be, so this is up to the client to run. 151 | #+begin_src emacs-lisp 152 | (defun my-package-add-data (data) 153 | (my-package-write-new-data package-db data) 154 | (triples-backups-maybe-backup db db-filename)) 155 | #+end_src 156 | * Using =triples= to develop apps with shared data 157 | One possibility that arises from a design with entities (in triples terms, 158 | subjects) having multiple decomposable types like is done in the =triples= library 159 | is the possibility of many modules using the same database, each one adding 160 | their own data, but being able to make use out of each other's data. 161 | 162 | For example, in the examples above we have a simple system for storing data about people and employees. If another module adds a type for annotations, now you can potentially annotate any entity, including people and employees. If another module adds functionality to store and complete on email addresses, now people, employees, and potentially types added by other modules such as organizations could have email addresses. 163 | 164 | If this seems to fit your use case, you may want to try to just use the default database. The downside of this is that nothing prevents other modules from changing, corrupting or deleting your data. 165 | -------------------------------------------------------------------------------- /triples-backups-test.el: -------------------------------------------------------------------------------- 1 | ;;; triples-backups-test.el --- Tests for the triples-backup module. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2022 Free Software Foundation, Inc. 4 | 5 | ;; This program is free software; you can redistribute it and/or 6 | ;; modify it under the terms of the GNU General Public License as 7 | ;; published by the Free Software Foundation; either version 2 of the 8 | ;; License, or (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, but 11 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | ;; General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Note: It's important to test this on emacs 29, with emacsql installed, so we 21 | ;; can make both types of sqlite backend work. 22 | 23 | ;;; Code: 24 | (require 'ert) 25 | (require 'triples-backups) 26 | (require 'iso8601) 27 | 28 | (ert-deftest triples-backups-strategy-daily () 29 | (cl-letf (((symbol-function 'current-time) 30 | (lambda () 31 | (encode-time (iso8601-parse "2023-01-15T12:00Z"))))) 32 | (should (triples-backups-strategy-daily (encode-time (iso8601-parse "2023-01-14T12:00Z")))) 33 | (should (triples-backups-strategy-daily (encode-time (iso8601-parse "2022-01-01T12:00Z")))) 34 | (should-not (triples-backups-strategy-daily (encode-time (iso8601-parse "2023-01-15T12:00Z")))) 35 | (should-not (triples-backups-strategy-daily (encode-time (iso8601-parse "2023-02-01T12:00Z")))))) 36 | 37 | (ert-deftest triples-backups-strategy-weekly () 38 | (cl-letf (((symbol-function 'current-time) 39 | (lambda () 40 | (encode-time (iso8601-parse "2023-01-15T12:00Z"))))) 41 | (should (triples-backups-strategy-daily (encode-time (iso8601-parse "2023-01-01T12:00Z")))) 42 | (should (triples-backups-strategy-daily (encode-time (iso8601-parse "2022-01-01T12:00Z")))) 43 | (should-not (triples-backups-strategy-daily (encode-time (iso8601-parse "2023-01-15T12:00Z")))) 44 | (should-not (triples-backups-strategy-daily (encode-time (iso8601-parse "2023-02-01T12:00Z")))))) 45 | 46 | (ert-deftest triples-backups-maybe-backup () 47 | (let* ((filename (make-temp-file "triples-test")) 48 | (db (triples-connect filename)) 49 | (backup-called)) 50 | (cl-letf (((symbol-function 'triples-backup) 51 | (lambda (_ _ num-to-keep) 52 | (should (= num-to-keep 3)) 53 | (setq backup-called t))) 54 | ((symbol-function 'triples-backups-strategy-always) 55 | (lambda (_) t)) 56 | ((symbol-function 'triples-backups-strategy-never) 57 | (lambda (_) nil))) 58 | (should-error (triples-backups-maybe-backup db filename)) 59 | (triples-backups-setup db 3 'never) 60 | (triples-backups-maybe-backup db filename) 61 | (should-not backup-called) 62 | (triples-backups-setup db 3 'always) 63 | (triples-backups-maybe-backup db filename) 64 | (should backup-called) 65 | (triples-backups-setup db 3 'unknown) 66 | (triples-backups-maybe-backup db filename) 67 | (should backup-called)))) 68 | 69 | (provide 'triples-backups-test) 70 | -------------------------------------------------------------------------------- /triples-backups.el: -------------------------------------------------------------------------------- 1 | ;;; triples-backups --- Functions to add backup functionality to triple databases. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2022 Free Software Foundation, Inc. 4 | 5 | ;; Author: Andrew Hyatt 6 | ;; Homepage: https://github.com/ahyatt/triples 7 | ;; 8 | ;; This program is free software; you can redistribute it and/or 9 | ;; modify it under the terms of the GNU General Public License as 10 | ;; published by the Free Software Foundation; either version 2 of the 11 | ;; License, or (at your option) any later version. 12 | ;; 13 | ;; This program is distributed in the hope that it will be useful, but 14 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 | ;; General Public License for more details. 17 | ;; 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with GNU Emacs. If not, see . 20 | 21 | ;;; Commentary: 22 | ;; This provides backup functionality. The information about how and when to do 23 | ;; backups lives in the database itself, on a special entity `database'. 24 | 25 | (require 'triples) 26 | 27 | ;;; Code: 28 | 29 | (defun triples-backups-setup (db num-to-keep strategy) 30 | "Set DB's backup strategy. 31 | NUM-TO-KEEP is the number of backup files to keep. Older ones 32 | are removed. STRATEGY is a symbol that corresponds to a function 33 | `triples-backups-strategy-STRATEGY'. This function must always be 34 | loaded before any client of this db calls 35 | `triples-backups-maybe-backup', so adding your own may not always 36 | be appropriate." 37 | (triples-with-transaction db 38 | (triples-add-schema db 'backup '(num-to-keep :base/unique t :base/type integer) 39 | '(strategy :base/unique t :base/type symbol) 40 | '(last-update-time :base/unique t :base/type integer)) 41 | (triples-set-type db 'database 'backup :num-to-keep num-to-keep 42 | :strategy strategy :last-update-time (time-convert (current-time) 'integer)))) 43 | 44 | (defun triples-backups-configuration (db) 45 | "Return the backup configuration set by `triples-backups-setup'. 46 | If no one has ever run that on this database, nil is returned. 47 | 48 | DB is the database to get the configuration for." 49 | (triples-get-type db 'database 'backup)) 50 | 51 | (defun triples-backups-last-update-time (db) 52 | "Get the last time DB has been updated." 53 | (plist-get (triples-get-type db 'database 'backup) :last-update-time)) 54 | 55 | (defun triples-backups-maybe-backup (db &optional filename) 56 | "If it is time for DB to be backed up, then back it up. 57 | FILENAME is optional, as in `triples-connect', if not given will 58 | default to the standard triple database given in 59 | `triples-default-database-filename'." 60 | (let* ((backup-info (triples-backups-configuration db)) 61 | (strategy-func (intern (format "triples-backups-strategy-%s" 62 | (plist-get backup-info :strategy))))) 63 | (unless backup-info 64 | (error "`triples-backups-setup' needs to be called on this database before trying to back up")) 65 | (unless (fboundp strategy-func) 66 | (display-warning 67 | 'triples 68 | (format "Triples backup strategy %s not found, defaulting to `triples-backups-strategy-daily'" 69 | strategy-func) 70 | :error)) 71 | (when (funcall (or (symbol-function strategy-func) #'triples-backups-strategy-daily) 72 | (plist-get backup-info :last-update-time)) 73 | (triples-backup db filename (plist-get backup-info :num-to-keep)) 74 | (apply #'triples-set-type db 'database 'backup (plist-put backup-info :last-update-time (time-convert (current-time) 'integer)))))) 75 | 76 | (defun triples-backups-strategy-every-change (_) 77 | "Backup strategy to do a backup on each change." 78 | t) 79 | 80 | (defun triples-backups-strategy-never (_) 81 | "Backup strategy to never do a backup." 82 | nil) 83 | 84 | (defun triples-backups-strategy-daily (last-update) 85 | "Backup strategy to create a change daily at most. 86 | LAST-UPDATE is the time of the last update." 87 | (>= (/ (- (float-time (current-time)) (float-time last-update)) 86400) 88 | 1)) 89 | 90 | (defun triples-backups-strategy-weekly (last-update) 91 | "Backup strategy to create a change daily at most. 92 | LAST-UPDATE is the time of the last update." 93 | (>= (/ (- (float-time (current-time)) (float-time last-update)) 86400) 94 | 7)) 95 | 96 | (provide 'triples-backups) 97 | ;;; triples-backups.el ends here 98 | -------------------------------------------------------------------------------- /triples-design.org: -------------------------------------------------------------------------------- 1 | * How to think about triples 2 | A triple graph is one that is based on /subject/, /predicate/ and /object/ "triples". These can be thought of as a graph: any object can also be a subject. The graph can be stored in many different ways, in a SQL database is just one way, and even that can be done in different ways. 3 | 4 | To show the graph-like nature, consider this example of how to store information about elisp functions. Here are a set of triples (in subject, predicate, object groups) that represent which functions are advised by other functions. 5 | 6 | #+begin_example 7 | (save-buffer :function/advised-by my-before-save-function) 8 | (save-buffer :function/advised-by my-save-notification-function) 9 | (kill-emacs :function/advised-by my-emacs-cleanup-function) 10 | #+end_example 11 | 12 | Here the subject and the object are both the same type of thing, an elisp function. You can consider this a graph where there is a link between =save-buffer= subject and =my-before-save-function=, and that link is of type =:advised-by=. The link is bidirectional. Because of that we can ask questions like: what are the functions that advise ~save-buffer~? Also, what functions does ~my-save-notification-function~ advise? 13 | 14 | But what if we wanted to also store what type of advising this is (~before~, ~around~, ~after~)? We could do this in a few ways. Perhaps we can make the object more complicated, encompassing everything about what we want to store: 15 | 16 | #+begin_example 17 | (save-buffer :function/advised-by (my-before-save-function before)) 18 | (save-buffer :function/advised-by (my-save-notification-function after)) 19 | (kill-emacs :function/advised-by (my-emacs-cleanup-function before)) 20 | #+end_example 21 | 22 | But that means we can no longer rely on a link between functions like there were before. Insead, it makes sense to write this in a way that introduces a point of indirection. We have to do this because the link between these two functions has data itself, the kind of advising. So we have to create an intermediary object. For example: 23 | 24 | #+begin_example 25 | (save-buffer :function/advised-by ) 26 | ( :advisor/name my-before-save-function) 27 | ( :advisor/type before) 28 | #+end_example 29 | 30 | Now we can ask questions like what functions are being advised with ~before~ advice, but for all queries about advising, we have to go through the intermediate object with subject ==. 31 | * Subjects 32 | In the above example, we have some subjects that have meaning (=save-buffer=), and some that don't (==). 33 | 34 | There isn't a need for any subjects to have meaning. For example, we could have modeled the above like this, and it'd still be able to do what we need: 35 | 36 | #+begin_example 37 | ( :function/name save-buffer) 38 | ( :function/advised-by ) 39 | ( :advisor/name my-before-save-function) 40 | ( :advisor/type before) 41 | #+end_example 42 | 43 | So to find out what functions advise ~save-buffer~ we can see what IDs have =:function/name= equal to =save-buffer=, and then look for =:function/advised-by=, and load the triple to see what is advising it. 44 | 45 | In general, subjects need to be unique. Not per row of the database that they are stored in, but unique to whatever the entity that is being stored is. So an email address would be a good subject, but a name would not be. A guaranteed unique ID (GUID) would be reasonable. These tend to be stored a lot, so the shorter the subjects are, the better. [[https://www.wikidata.org/wiki/Property:P646][Freebase IDs]] were uint64s, or base-32 encoding of that ID, with a prefix ("/m/05fqyx"). In the example above, having IDs instead of subjects is actually better, since function names aren't unique - they can be shared with variable names. If we were modeling Scheme, it would be OK to use the name as a subject, because it was unique, and could have properties related to functions and variables. That would be possible for lisp, though, since these are two different objects, and it's important to understand what triples mean when a certain value appears as an object. 46 | 47 | As long as subjects are unique, everything should work. Using IDs everywhere is safe and how most Knowledge Graphs do it. However, it's fine to have subjects as something meaningful, as long as they are unique and unlikely to change. For example, using an email address as a subject is fine, but may not be the best choice to represent a person, who may have many email addresses or change their email address. However, a URL is probably a reasonable choice to represent a webpage. 48 | * Predicates and schema 49 | The predicate can be anything, but in Knowledge Graphs it is typically constrained by a schema (and this is how =ekg= works as well). A subject can have multiple types, each with its own data. To expand on our example from earlier, an elisp function can have multiple types, such as data related to being a function itself, data related to advising, data related to documentation, etc. This is optional for functions, but other things especially in the real world often have data that is best modeled as different types. Some people are writers, some are actors, some are CEOs, and each one of these things has different data, and people can be multiple of these things. So a single subject has many different types, and each type stores data related to a certain data that is independent of all the other data the subject could have. 50 | 51 | Predicates also have reverse predicates. In the examples above, we just show one side, but in reality specify a triple link implies the reverse links as well. So, for example: 52 | #+begin_example 53 | ( :function/advised-by ) 54 | #+end_example 55 | 56 | also implicitly defines the reverse link triple: 57 | #+begin_example 58 | ( :advisor/advises ) 59 | #+end_example 60 | 61 | These reverse links are defined in the schema. 62 | 63 | When dealing with entities, it's important to be careful to not delete entities except in special circumstances. Most of the time, it's appropriate to remove the type. In our example, we know that the entity is really just about a function, so if the function disappears, it can be removed. But it could be that some entities are about multiple things, and one of those things may need to be removed, but that doesn't mean the rest shouldn't stay. 64 | 65 | * Objects 66 | Objects are also potentially subjects. We've seen that in the example above. It's not always the case, because sometimes the objects are just data: 67 | #+begin_example 68 | ( :function/num-times-called 4105) 69 | #+end_example 70 | 71 | Anything as an object can be queried, though, so this is why it's best to have simple objects, and model any complexity with different predicates. 72 | -------------------------------------------------------------------------------- /triples-fts-test.el: -------------------------------------------------------------------------------- 1 | ;;; triples-fts-test.el --- Tests for triples FTS module. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2025 Free Software Foundation, Inc. 4 | 5 | ;; This program is free software; you can redistribute it and/or 6 | ;; modify it under the terms of the GNU General Public License as 7 | ;; published by the Free Software Foundation; either version 2 of the 8 | ;; License, or (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, but 11 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | ;; General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; This file contains tests for the triples FTS module. 21 | 22 | ;;; Code: 23 | 24 | (require 'ert) 25 | (require 'triples-test-utils) 26 | (require 'triples-fts) 27 | 28 | (ert-deftest triples-fts-query-subject-after-setup () 29 | (triples-test-with-temp-db 30 | (triples-fts-setup db) 31 | (triples-add-schema db 'text '(text :base/type string :base/unique t) 32 | '(moretext :base/type string :base/unique t)) 33 | (triples-set-subject db 'a '(text :text "Hello, world!" :moretext "World is bond")) 34 | (triples-set-subject db 'b '(text :text "Goodbye, world!")) 35 | (should (equal '(a b) 36 | (triples-fts-query-subject db "world"))) 37 | (should (equal '(a) 38 | (triples-fts-query-subject db "bond"))))) 39 | 40 | (ert-deftest triples-fts-query-subject-added-before-setup () 41 | (triples-test-with-temp-db 42 | (triples-add-schema db 'text '(text :base/type string :base/unique t) 43 | '(moretext :base/type string :base/unique t)) 44 | (triples-set-subject db 'a '(text :text "Hello, world!" :moretext "World is bond")) 45 | (triples-set-subject db 'b '(text :text "Goodbye, world!")) 46 | (triples-fts-setup db) 47 | (should (equal '(a b) 48 | (triples-fts-query-subject db "world"))) 49 | (should (equal '(a) 50 | (triples-fts-query-subject db "bond"))))) 51 | 52 | (ert-deftest triples-fts-query-subject-with-abbrev () 53 | (triples-test-with-temp-db 54 | (let ((abbrevs '(("tag" . "text/tag")))) 55 | (triples-fts-setup db) 56 | (triples-add-schema db 'text '(text :base/type string :base/unique t) 57 | '(tag :base/type string)) 58 | (triples-set-subject db 'a '(text :text "Hello, world!" :tag ("foo" "bar"))) 59 | (should (equal '(a) (triples-fts-query-subject db "Hello" abbrevs))) 60 | (should (equal '(a) (triples-fts-query-subject db "tag:foo world" abbrevs))) 61 | (should (equal '(a) (triples-fts-query-subject db "tag: foo world" abbrevs))) 62 | (should (equal nil (triples-fts-query-subject db "tag:baz world" abbrevs))) 63 | (should (equal '(a) (triples-fts-query-subject db "text/tag:foo world" abbrevs)))))) 64 | 65 | (provide 'triples-fts-test) 66 | 67 | ;;; triples-fts-test.el ends here 68 | -------------------------------------------------------------------------------- /triples-fts.el: -------------------------------------------------------------------------------- 1 | ;;; triples-fts.el --- Sqlite full text search for triples. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2023 Free Software Foundation, Inc. 4 | 5 | ;; Author: Andrew Hyatt 6 | ;; Homepage: https://github.com/ahyatt/triples 7 | ;; 8 | ;; This program is free software; you can redistribute it and/or 9 | ;; modify it under the terms of the GNU General Public License as 10 | ;; published by the Free Software Foundation; either version 2 of the 11 | ;; License, or (at your option) any later version. 12 | ;; 13 | ;; This program is distributed in the hope that it will be useful, but 14 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 | ;; General Public License for more details. 17 | ;; 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with GNU Emacs. If not, see . 20 | 21 | ;;; Commentary: 22 | ;; This package provides full text search for triples. It uses sqlite's FTS 23 | ;; capabilities. It indexes all text objects. 24 | 25 | ;; This only will work with the built-in sqlite support in Emacs 29.1 or later. 26 | 27 | ;;; Code: 28 | 29 | (require 'triples) 30 | (require 'sqlite) 31 | (require 'seq) 32 | 33 | (defun triples-fts-setup (db &optional force) 34 | "Ensure DB has a FTS table. 35 | As long as the FTS table exists, this will not try to recreate 36 | it. If FORCE is non-nil, then the FTS and all triggers will be 37 | recreated and repopulated." 38 | (unless (eq triples-sqlite-interface 'builtin) 39 | (error "Emacs 29.1 or later is required for triples-fts")) 40 | (let ((fts-existed (sqlite-select db "SELECT name FROM sqlite_master WHERE type='table' AND name='triples_fts'"))) 41 | (when force (sqlite-execute db "DROP TABLE triples_fts")) 42 | (sqlite-execute db "CREATE VIRTUAL TABLE IF NOT EXISTS triples_fts USING fts5 (subject, predicate, object, content=triples, content_rowid=rowid)") 43 | ;; Triggers that will update triples_fts, but only for text objects. 44 | ;; New rows: 45 | (when force (sqlite-execute db "DROP TRIGGER IF EXISTS triples_fts_insert")) 46 | (sqlite-execute db "CREATE TRIGGER IF NOT EXISTS triples_fts_insert AFTER INSERT ON triples 47 | WHEN new.object IS NOT NULL and typeof(new.object) = 'text' 48 | BEGIN 49 | INSERT INTO triples_fts (rowid, subject, predicate, object) VALUES (new.rowid, new.subject, new.predicate, new.object); 50 | END") 51 | ;; Updated rows: 52 | (when force (sqlite-execute db "DROP TRIGGER IF EXISTS triples_fts_update")) 53 | (sqlite-execute db "CREATE TRIGGER IF NOT EXISTS triples_fts_update AFTER UPDATE ON triples 54 | WHEN new.object IS NOT NULL AND typeof(new.object) = 'text' 55 | BEGIN 56 | INSERT INTO triples_fts (triples_fts, rowid, subject, predicate, object) VALUES ('delete', old.rowid, old.subject, old.predicate, old.object); 57 | INSERT INTO triples_fts (rowid, subject, predicate, object) VALUES (new.rowid, new.subject, new.predicate, new.object); 58 | END") 59 | ;; Deleted rows: 60 | (when force (sqlite-execute db "DROP TRIGGER IF EXISTS triples_fts_delete")) 61 | (sqlite-execute db "CREATE TRIGGER IF NOT EXISTS triples_fts_delete AFTER DELETE ON triples 62 | WHEN old.object IS NOT NULL AND typeof(old.object) = 'text' 63 | BEGIN 64 | INSERT INTO triples_fts (triples_fts, subject, predicate, object) VALUES ('delete', old.subject, old.predicate, old.object); 65 | END") 66 | (if (or force (not fts-existed)) (triples-fts-rebuild db)))) 67 | 68 | (defun triples-fts-rebuild (db) 69 | "Rebuild the FTS table for DB." 70 | (sqlite-execute db "INSERT INTO triples_fts (triples_fts) VALUES ('rebuild')")) 71 | 72 | (defun triples-fts--split-query (query) 73 | "Return the QUERY split by whitespace, except for quoted strings." 74 | ;; First, we remove all quoted strings via regexes. 75 | (let ((quoted-strings '()) 76 | (quoted-strings-re (rx (seq "\"" (group (zero-or-more (not (any "\"")))) "\""))) 77 | (query-copy (replace-regexp-in-string (rx (seq ?: (zero-or-more space))) ":" query))) 78 | (while (string-match quoted-strings-re query-copy) 79 | (push (match-string 1 query-copy) quoted-strings) 80 | (setq query-copy (replace-match "" t t query-copy))) 81 | ;; Now we split by whitespace, except for quoted strings. 82 | (append (split-string query-copy) quoted-strings))) 83 | 84 | (defun triples-fts--transform-query (query abbrevs) 85 | "Rewrite abbreviations in QUERY based on `triples-fts-predicate-abbrevs`. 86 | 87 | This returns a list of new queries. Because each triple is a row, we 88 | have each part of the query matching separately, and then we do an 89 | intersection on the results. 90 | 91 | Because predicates that we need to match against are 92 | 93 | E.g. if `tag' is an abbreviation for `tagged/tag', from the alist 94 | ABBREVS, then: \"tag:foo urgent\" ==> \"predicate:\"tagged/tag\" 95 | object:\"foo\" urgent\"." 96 | ;; Split by whitespace, except for quoted strings. 97 | (let ((segments (triples-fts--split-query query))) 98 | (mapcar 99 | (lambda (w) 100 | (if (string-match "^\\([^:]+\\):\\(.*\\)$" w) 101 | (let* ((prefix (match-string 1 w)) 102 | (rest (match-string 2 w)) 103 | (full (assoc-default prefix abbrevs))) 104 | (if (or full (string-match-p "/" prefix)) 105 | ;; Example: "tag" => "tagged/tag", rest => "foo" 106 | (format "predicate:\"%s\" object:\"%s\"" (or full prefix) rest) 107 | w)) ; No known abbreviation; just leave as-is. 108 | w)) 109 | segments))) 110 | 111 | (defun triples-fts-query-subject (db query &optional abbrevs) 112 | "Query DB with QUERY, returning only subjects. 113 | 114 | QUERY should not have operators such as AND or OR, everything is assumed 115 | to be ANDed together. Phrases can be in quotes. 116 | 117 | Predicates can appear before colons to restrict a query term. For 118 | example, `person/name:Billy'. Anything with a slash in it, or matching 119 | an entry in ABBREV will be used to filter by a predicate, otherwise it 120 | is passed to FTS5 as-is. 121 | 122 | ABBREVS is an alist of abbreviations to predicate (both strings). If 123 | this is populated then we also expand user abbreviations like `tag:xyz` 124 | => `predicate:\"tagged/tag\" object:\"xyz\"`." 125 | (seq-uniq 126 | (mapcar 127 | #'triples-standardize-result 128 | (cl-reduce #'seq-intersection 129 | (mapcar 130 | (lambda (subquery) 131 | (mapcar #'car 132 | (sqlite-select 133 | db 134 | "SELECT subject FROM triples_fts 135 | WHERE triples_fts MATCH ? 136 | ORDER BY rank" 137 | (list subquery)))) 138 | (triples-fts--transform-query query abbrevs)))))) 139 | 140 | (provide 'triples-fts) 141 | 142 | ;;; triples-fts.el ends here 143 | -------------------------------------------------------------------------------- /triples-test-utils.el: -------------------------------------------------------------------------------- 1 | ;;; triples-test-utils.el --- Test utilities for triples.el -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023-2025 Free Software Foundation, Inc. 4 | 5 | ;; This program is free software; you can redistribute it and/or 6 | ;; modify it under the terms of the GNU General Public License as 7 | ;; published by the Free Software Foundation; either version 2 of the 8 | ;; License, or (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, but 11 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | ;; General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Thyis file contiains utilities for testing triples.el, all with the 21 | ;; `triples-test' prefix. 22 | 23 | ;;; Code: 24 | 25 | (defvar triples-test-db-file nil 26 | "The database file used in a test. 27 | This is defined so we can easily debug into it.") 28 | 29 | (defmacro triples-test-with-temp-db (&rest body) 30 | "Run BODY with a temporary database file." 31 | (declare (indent 0) (debug t)) 32 | `(let ((db-file (make-temp-file "triples-test"))) 33 | (unwind-protect 34 | (progn 35 | (let ((db (triples-connect db-file))) 36 | (setq triples-test-db-file db-file) 37 | ,@body 38 | (triples-close db))) 39 | (delete-file db-file)))) 40 | 41 | (defun triples-test-open-db () 42 | "Open the database file used in the current test. 43 | This is useful when debugging a test." 44 | (interactive) 45 | (sqlite-mode-open-file triples-test-db-file)) 46 | 47 | (defmacro triples-deftest (name _ &rest body) 48 | "Create a test exercising variants of `triples-sqlite-interface'. 49 | NAME is the name of the test, and BODY is the test code." 50 | (declare (debug t) (indent 2)) 51 | (let ((builtin-name (intern (format "%s-builtin" name))) 52 | (emacsql-name (intern (format "%s-emacsql" name)))) 53 | `(progn 54 | (ert-deftest ,builtin-name () 55 | (let ((triples-sqlite-interface 'builtin)) 56 | (skip-unless (and (fboundp 'sqlite-available-p) (sqlite-available-p))) 57 | ,@body)) 58 | (ert-deftest ,emacsql-name () 59 | (let ((triples-sqlite-interface 'emacsql)) 60 | (skip-unless (featurep 'emacsql)) 61 | ,@body))))) 62 | 63 | (provide 'triples-test-utils) 64 | 65 | ;;; triples-test-utils.el ends here 66 | -------------------------------------------------------------------------------- /triples-test.el: -------------------------------------------------------------------------------- 1 | ;;; triples-test.el --- Tests for triples module. -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2022 Free Software Foundation, Inc. 4 | 5 | ;; This program is free software; you can redistribute it and/or 6 | ;; modify it under the terms of the GNU General Public License as 7 | ;; published by the Free Software Foundation; either version 2 of the 8 | ;; License, or (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, but 11 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | ;; General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Note: It's important to test this on emacs 29, with emacsql installed, so we 21 | ;; can make both types of sqlite backend work. 22 | ;; 23 | ;; The tests also require the `kv' package, which can be found at 24 | ;; https://github.com/jjeffery/kv. 25 | 26 | ;;; Code: 27 | 28 | (require 'triples) 29 | (require 'triples-test-utils) 30 | (require 'seq) 31 | (require 'kv) 32 | (require 'emacsql nil t) ;; May be absent. 33 | (require 'emacsql-sqlite nil t) ;; May be absent. 34 | 35 | ;;; Code: 36 | 37 | (triples-deftest triples-connect-default () 38 | (let* ((triples-default-database-filename (make-temp-file "triples-default")) 39 | (db (triples-connect))) 40 | (triples-db-insert db 1 'pred 2) 41 | (triples-close db) 42 | (should (file-exists-p triples-default-database-filename)))) 43 | 44 | (triples-deftest triples-test-insert () 45 | (triples-test-with-temp-db 46 | (triples-db-insert db "sub" 'pred "obj") 47 | (should (equal (mapcar (lambda (row) (seq-take row 3)) (triples-db-select db)) 48 | '(("sub" pred "obj")))) 49 | ;; Test that we actually are storing with builtin something compatible 50 | ;; with emacsql. 51 | (when (eq triples-sqlite-interface 'builtin) 52 | (should (equal (sqlite-select db "SELECT * FROM triples") 53 | '(("\"sub\"" "pred" "\"obj\"" "()"))))) 54 | ;; Test that it replaces - this shouldn't result in two rows. 55 | (triples-db-insert db "sub" 'pred "obj") 56 | (should (= (triples-count db) 1)) 57 | ;; Test that colons in the predicate are stripped away when stored. 58 | (triples-db-insert db "sub" :test/pred "obj") 59 | (should (= (length (triples-db-select db nil 'test/pred)) 1)) 60 | ;; Test we correctly test for bad inputs. 61 | (should-error (triples-db-insert db "sub" "pred" "obj")) 62 | (should-error (triples-db-insert db "sub" 'pred "obj" '(ordinary-list))) 63 | (should-error (triples-db-insert db "sub" 'pred "obj" "string")) 64 | ;; Test that we can have symbol subject and objects. 65 | (triples-db-insert db 'sub 'pred 'obj) 66 | (should (equal 67 | (mapcar (lambda (row) (seq-take row 3)) (triples-db-select db 'sub)) 68 | '((sub pred obj)))) 69 | ;; Test that properties aren't strings. They happen to be stored 70 | ;; differently for each system due to differences in how the inserting 71 | ;; face works. 72 | (should (plistp (nth 3 (car (triples-db-select db 'sub))))))) 73 | 74 | (triples-deftest triples-test-delete () 75 | (triples-test-with-temp-db 76 | (triples-db-insert db 1 'pred 2) 77 | (triples-db-insert db 2 'pred 1) 78 | (triples-db-delete db 1) 79 | (should (= 1 (triples-count db))) 80 | (should (= 0 (length (triples-db-select db 1)))) 81 | (triples-db-insert db 1 'pred 2) 82 | (triples-db-delete db nil nil 2) 83 | (should (= 0 (length (triples-db-select db nil nil 2)))) 84 | (triples-db-insert db 1 'pred 2) 85 | (triples-db-delete db nil 'pred nil) 86 | (should (= 0 (triples-count db))))) 87 | 88 | (triples-deftest triples-test-delete-subject-predicate-prefix () 89 | (triples-test-with-temp-db 90 | (triples-db-insert db 1 'test/foo 2) 91 | (triples-db-insert db 1 'bar/bar 1) 92 | (triples-db-delete-subject-predicate-prefix db 1 'test) 93 | (should (= 1 (triples-count db))) 94 | ;; Make sure colons are stripped. 95 | (triples-db-delete-subject-predicate-prefix db 1 :bar) 96 | (should (= 0 (triples-count db))))) 97 | 98 | (triples-deftest triples-test-select () 99 | (triples-test-with-temp-db 100 | (triples-db-insert db 1 'pred 2 '(:a 1)) 101 | (let ((expected '((1 pred 2 (:a 1))))) 102 | (should (equal (triples-db-select db 1) expected)) 103 | (should (equal (triples-db-select db nil 'pred) expected)) 104 | (should (equal (triples-db-select db nil nil 2) expected)) 105 | (should (equal (triples-db-select db 1 nil 2) expected)) 106 | (should (equal (triples-db-select db 1 'pred 2) expected)) 107 | (should (equal '((1)) (triples-db-select db 1 nil nil nil '(subject)))) 108 | (should (equal '((1 pred)) (triples-db-select db 1 nil nil nil '(subject predicate))))))) 109 | 110 | (triples-deftest triples-test-select-with-pred-prefix () 111 | (triples-test-with-temp-db 112 | (triples-db-insert db 'sub1 'pred/foo 'obj) 113 | (triples-db-insert db 'sub1 'pred/bar 'obj) 114 | (triples-db-insert db 'sub2 'pred/foo 'obj) 115 | (should (equal (triples-test-list-sort (triples-db-select-pred-prefix db 'sub1 'pred)) 116 | (triples-test-list-sort `((sub1 pred/foo obj ,(pcase triples-sqlite-interface 117 | ('builtin nil) 118 | ('emacsql '(:t t)))) 119 | (sub1 pred/bar obj ,(pcase triples-sqlite-interface 120 | ('builtin nil) 121 | ('emacsql '(:t t)))))))))) 122 | 123 | (triples-deftest triples-test-subjects-with-predicate-object () 124 | (triples-test-with-temp-db 125 | (triples-db-insert db 'sub1 'pred/foo "bar") 126 | (should (equal (triples-subjects-with-predicate-object db 'pred/foo "bar") 127 | '(sub1))))) 128 | 129 | (triples-deftest triples-test-db-select-pred-op-strings () 130 | (triples-test-with-temp-db 131 | (triples-add-schema db 'named '(name)) 132 | (triples-set-subject db 123 '(named :name ("Foo" "Foo"))) 133 | (should (= 2 (length (triples-db-select-pred-op db :named/name '= "Foo")))) 134 | (should (= 2 (length (triples-db-select-pred-op db :named/name 'like "F%")))) 135 | (should (= 1 (length (triples-db-select-pred-op db :named/name '= "Foo" '(:index 0))))) 136 | (should (= 2 (length (triples-db-select-pred-op db :named/name '> "A")))) 137 | (should (= 0 (length (triples-db-select-pred-op db :named/name '< "A")))) 138 | (should (= 2 (length (triples-db-select-pred-op db :named/name '= "foo")))))) 139 | 140 | (triples-deftest triples-test-db-select-pred-op-int () 141 | (triples-test-with-temp-db 142 | (triples-add-schema db 'person '(age :base/unique t :base/type integer)) 143 | (triples-set-subject db 123 '(person :age 20)) 144 | (triples-set-subject db 456 '(person :age 40)) 145 | (triples-set-subject db 789 '(person :age 60)) 146 | (should (= 2 (length (triples-db-select-pred-op db :person/age '> 20)))) 147 | (should (= 3 (length (triples-db-select-pred-op db :person/age '>= 20)))) 148 | (should (= 2 (length (triples-db-select-pred-op db :person/age '!= 20)))) 149 | (should (= 3 (length (triples-db-select-pred-op db :person/age '!= 30)))) 150 | (should (= 1 (length (triples-db-select-pred-op db :person/age '= 20)))) 151 | (should (= 2 (length (triples-db-select-pred-op db :person/age '< 60)))) 152 | (should (= 3 (length (triples-db-select-pred-op db :person/age '<= 60)))) 153 | (should (= 0 (length (triples-db-select-pred-op db :person/age '> 60)))) 154 | ;; This may seem duplicative, but if we are doing textwise comparison, then 155 | ;; this will fail. 156 | (should (= 0 (length (triples-db-select-pred-op db :person/age '> 1000)))))) 157 | 158 | (triples-deftest triples-test-db-select-pred-op-float () 159 | (triples-test-with-temp-db 160 | (triples-add-schema db 'measurement '(value :base/unique t :base/type float)) 161 | (triples-set-subject db 'm1 '(measurement :value 20.5)) 162 | (triples-set-subject db 'm2 '(measurement :value 40.25)) 163 | (triples-set-subject db 'm3 '(measurement :value 60.0)) 164 | (should (= 2 (length (triples-db-select-pred-op db :measurement/value '> 20.5)))) 165 | (should (= 3 (length (triples-db-select-pred-op db :measurement/value '>= 20.5)))) 166 | (should (= 2 (length (triples-db-select-pred-op db :measurement/value '!= 20.5)))) 167 | (should (= 3 (length (triples-db-select-pred-op db :measurement/value '!= 30.0)))) 168 | (should (= 1 (length (triples-db-select-pred-op db :measurement/value '= 20.5)))) 169 | (should (= 2 (length (triples-db-select-pred-op db :measurement/value '< 60.0)))) 170 | (should (= 3 (length (triples-db-select-pred-op db :measurement/value '<= 60.0)))) 171 | (should (= 0 (length (triples-db-select-pred-op db :measurement/value '> 60.0)))) 172 | ;; Test with a value that might cause issues if treated as string 173 | (should (= 0 (length (triples-db-select-pred-op db :measurement/value '> 100.75)))))) 174 | 175 | (ert-deftest triples-test-symbols () 176 | (triples-test-with-temp-db 177 | (triples-add-schema db 'enum '(value :base/unique t :base/type symbol)) 178 | (triples-set-type db 'foo 'enum :value 'bar) 179 | (should (equal '(:value bar) (triples-get-type db 'foo 'enum))))) 180 | 181 | (ert-deftest triples-test-builtin-emacsql-compat () 182 | (cl-loop for subject in '(1 a "a") do 183 | (let ((triples-sqlite-interface 'builtin)) 184 | (triples-test-with-temp-db 185 | (triples-add-schema db 'person 186 | '(name :base/unique t :base/type string) 187 | '(age :base/unique t :base/type integer) 188 | '(temperature :base/unique t :base/type float)) 189 | (triples-set-type db subject 'person :name "Alice Aardvark" :age 41 :temperature 36.6) 190 | (should (equal (triples-test-plist-sort (triples-get-type db subject 'person)) 191 | (triples-test-plist-sort '(:age 41 :name "Alice Aardvark" :temperature 36.6)))) 192 | (triples-close db) 193 | (let* ((triples-sqlite-interface 'emacsql) 194 | (db (triples-connect db-file))) 195 | (should (equal (triples-test-plist-sort (triples-get-type db subject 'person)) 196 | (triples-test-plist-sort '(:age 41 :name "Alice Aardvark" :temperature 36.6)))) 197 | (triples-close db)) 198 | ;; Just so the last close will work. 199 | (setq db (triples-connect db-file)))))) 200 | 201 | (ert-deftest triples-test-emacsql-builtin-compat () 202 | (cl-loop for subject in '(1 a "a") do 203 | (let ((triples-sqlite-interface 'emacsql)) 204 | (triples-test-with-temp-db 205 | (triples-add-schema db 'person 206 | '(name :base/unique t :base/type string) 207 | '(age :base/unique t :base/type integer) 208 | '(temperature :base/unique t :base/type float)) 209 | (triples-set-type db subject 'person :name "Alice Aardvark" :age 41 :temperature 36.6) 210 | (should (equal (triples-test-plist-sort (triples-get-type db subject 'person)) 211 | (triples-test-plist-sort '(:age 41 :name "Alice Aardvark" :temperature 36.6)))) 212 | (triples-close db) 213 | (let* ((triples-sqlite-interface 'builtin) 214 | (db (triples-connect db-file))) 215 | (should (equal (triples-test-plist-sort (triples-get-type db subject 'person)) 216 | (triples-test-plist-sort '(:age 41 :name "Alice Aardvark" :temperature 36.6)))) 217 | (triples-close db)) 218 | ;; Just so the last close will work. 219 | (setq db (triples-connect db-file)))))) 220 | 221 | (ert-deftest triples-test-emacsql-to-sqlite-dup-fixing () 222 | (let ((triples-sqlite-interface 'emacsql) 223 | (db-file (make-temp-file "triples-test")) 224 | (db)) 225 | (setq triples-test-db-file db-file) 226 | (setq db (triples-connect db-file)) 227 | (triples-add-schema db 'person '(name :base/unique t :base/type string)) 228 | (triples-set-type db 1 'person :name "Alice Aardvark") 229 | (triples-close db) 230 | (setq triples-sqlite-interface 'builtin) 231 | (setq db (triples-connect db-file)) 232 | (triples-set-type db 1 'person :name "Alice Aardvark") 233 | ;; Should just be one plist key and value, so two values. However, if we 234 | ;; don't fix things up, we get two because there is a dup row. 235 | (should (= 2 (length (triples-get-subject db 1)))) 236 | (triples-close db) 237 | (delete-file db-file))) 238 | 239 | ;; After this we don't bother testing both with emacsql and the builtin sqlite, 240 | ;; since if the functions tested above work, it should also work for both. 241 | 242 | (defun triples-test-op-equals (result target) 243 | (and (equal (car result) (car target)) 244 | (seq-set-equal-p (cdr result) (cdr target) #'equal))) 245 | 246 | (ert-deftest triples-add-schema-op () 247 | (should (triples-test-op-equals 248 | (triples--add-schema-op 249 | 'named 250 | '(name :base/unique t) 251 | '(locale :base/unique t) 252 | 'alternate-names 253 | '(nicknames :base/unique nil)) 254 | '(replace-subject-type 255 | . 256 | ((named base/type schema) 257 | (named schema/property name) 258 | (named/name base/unique t) 259 | (named schema/property locale) 260 | (named/locale base/unique t) 261 | (named schema/property alternate-names) 262 | (named schema/property nicknames)))))) 263 | 264 | (defun triples-test-list-sort (list) 265 | "Standard sort for LIST for test stability." 266 | (sort list (lambda (a b) (string< (format "%S" a) (format "%S" b))))) 267 | 268 | (ert-deftest triples-schema-crud () 269 | (triples-test-with-temp-db 270 | (triples-add-schema db 'named 271 | '(name :base/unique t) 'alternate-names) 272 | (should (equal '(:base/unique t) 273 | (triples-properties-for-predicate db 'named/name))) 274 | (should (equal 275 | (triples-test-list-sort '(name alternate-names)) 276 | (triples-test-list-sort (triples-predicates-for-type db 'named)))))) 277 | 278 | (ert-deftest triples-properties-for-predicate () 279 | (triples-test-with-temp-db 280 | (triples-add-schema db 'named 281 | '(name :base/unique t) 282 | 'alternate-names) 283 | (should (equal '(:base/unique t) 284 | (triples-properties-for-predicate db 'named/name))) 285 | (should-not (triples-properties-for-predicate db 'foo/bar)))) 286 | 287 | (ert-deftest triples-set-type () 288 | (should (triples-test-op-equals 289 | (triples--set-type-op "Bert" 'named 290 | '(:name "Bertholomew The Second" 291 | :alias ("Bert" "Berty")) 292 | '((name :base/type string :base/unique t) 293 | (alias :base/type string :base/unique nil))) 294 | '(replace-subject-type 295 | . 296 | (("Bert" base/type named) 297 | ("Bert" named/name "Bertholomew The Second") 298 | ("Bert" named/alias "Bert" (:index 0)) 299 | ("Bert" named/alias "Berty" (:index 1))))))) 300 | 301 | (defun triples-test-plist-sort (plist) 302 | "Sort PLIST in a standard way, for comparison." 303 | (kvalist->plist 304 | (kvalist-sort (kvplist->alist plist) 305 | (lambda (a b) (string< (format "%s" a) (format "%s" b)))))) 306 | 307 | (ert-deftest triples-schema-compliant () 308 | (let ((pal '((named/name :base/type string :base/unique t) 309 | (named/alternate-names :base/type string :base/unique nil) 310 | (measurement/value :base/type float :base/unique t) 311 | (enum/value :base/type symbol :base/unique t) 312 | ;; Alias doesn't specify base/unique or base/type, so anything is fine. 313 | (named/alias)))) 314 | (should (triples-verify-schema-compliant '(("foo" named/name "bar")) pal)) 315 | (should-error (triples-verify-schema-compliant '(("foo" named/name 5)) pal)) 316 | (should-error (triples-verify-schema-compliant '(("foo" named/name "bar" (:index 0))) pal)) 317 | (should (triples-verify-schema-compliant '(("foo" named/alternate-names "bar" (:index 0))) pal)) 318 | (should-error (triples-verify-schema-compliant '(("foo" named/alternate-names "bar" nil)) pal)) 319 | (should (triples-verify-schema-compliant '(("foo" named/alias "bar" nil)) pal)) 320 | (should (triples-verify-schema-compliant '(("foo" named/alias 5 nil)) pal)) 321 | (should (triples-verify-schema-compliant '(("foo" named/alias 5 (:index 0))) pal)) 322 | ;; Integers are not floats, so cannot be used for float values. 323 | (should-error (triples-verify-schema-compliant '(("m1" measurement/value 36)) pal)) 324 | (should (triples-verify-schema-compliant '(("m1" measurement/value 36.6)) pal)) 325 | (should-error (triples-verify-schema-compliant '(("m1" measurement/value "not-a-float")) pal)) 326 | (should-error (triples-verify-schema-compliant '(("m1" measurement/value 36.6 (:index 0))) pal)) 327 | (should-error (triples-verify-schema-compliant '(("foo" enum/value "mysymbol")) pal)) 328 | (should (triples-verify-schema-compliant '(("foo" enum/value mysymbol)) pal)))) 329 | 330 | (ert-deftest triples-crud () 331 | (triples-test-with-temp-db 332 | (triples-add-schema db 'named 333 | '(name :base/unique t) 334 | 'alias) 335 | (triples-add-schema db 'callable 336 | '(phone-number :base/unique t)) 337 | (triples-set-type db "foo" 'named :name "Name" :alias '("alias1" "alias2")) 338 | (triples-set-type db "foo" 'callable :phone-number "867-5309") 339 | (should (equal (triples-test-plist-sort '(:name "Name" :alias ("alias1" "alias2"))) 340 | (triples-test-plist-sort (triples-get-type db "foo" 'named)))) 341 | (should (equal (triples-test-list-sort (triples-get-types db "foo")) 342 | (triples-test-list-sort '(callable named)))) 343 | (should-not (triples-get-type db "bar" 'named)) 344 | (should-not (triples-get-types db "bar")) 345 | (triples-remove-type db "foo" 'named) 346 | (should-not (triples-get-type db "foo" 'named)) 347 | (should (triples-get-type db "foo" 'callable)))) 348 | 349 | (ert-deftest triples-crud-all () 350 | (triples-test-with-temp-db 351 | (triples-add-schema db 'named 352 | '(name :base/unique t)) 353 | (triples-add-schema db 'positioned '(position :base/unique t)) 354 | (should-not (triples-get-subject db "foo")) 355 | (triples-set-subject db "foo" 356 | '(named :name "bar") 357 | '(positioned :position "right behind you")) 358 | (should (equal '(:named/name "bar" :positioned/position "right behind you") 359 | (triples-get-subject db "foo"))) 360 | (triples-delete-subject db "foo") 361 | (should-not (triples-get-subject db "foo")))) 362 | 363 | (ert-deftest triples-set-types () 364 | (triples-test-with-temp-db 365 | (triples-add-schema db 'named 366 | '(name :base/unique t) 367 | 'alias) 368 | (triples-add-schema db 'reachable 'phone) 369 | (triples-set-type db "foo" 'named :name "Name" :alias '("alias1" "alias2")) 370 | (triples-set-types db "foo" :named/name "New Name" :reachable/phone '("867-5309")) 371 | (should (equal (triples-test-plist-sort '(:named/name "New Name" :reachable/phone ("867-5309"))) 372 | (triples-test-plist-sort (triples-get-subject db "foo")))))) 373 | 374 | (ert-deftest triples-single-element () 375 | (triples-test-with-temp-db 376 | (triples-add-schema db 'named 'name) 377 | (triples-set-type db "foo" 'named :name '("Name")) 378 | (should (equal '(:name ("Name")) 379 | (triples-get-type db "foo" 'named))))) 380 | 381 | (ert-deftest triples-store-and-retrieve () 382 | (triples-test-with-temp-db 383 | (triples-add-schema db 'text '(text :base/unique t)) 384 | (let ((text "Foo\nBar\tBaz \"Quoted\" ")) 385 | (triples-set-type db "foo" 'text :text text) 386 | (let ((retrieved (triples-get-type db "foo" 'text))) 387 | (should (equal `(:text ,text) retrieved)) 388 | (triples-set-type db "foo" 'text retrieved) 389 | (should (equal `(:text ,text) (triples-get-type db "foo" 'text))))))) 390 | 391 | (ert-deftest triples-vector () 392 | (triples-test-with-temp-db 393 | (triples-add-schema db 'named 'name) 394 | (triples-add-schema db 'embedding '(embedding :base/unique t :base/type vector)) 395 | (triples-set-type db "foo" 'named :name '("Name")) 396 | (triples-set-type db "foo" 'embedding :embedding [1 2 3 4 5]) 397 | (should (equal '(:embedding [1 2 3 4 5]) 398 | (triples-get-type db "foo" 'embedding))) 399 | (should-error (triples-set-type db "foo" 'embedding :embedding '(1 2 3))))) 400 | 401 | (ert-deftest triples-cons () 402 | (triples-test-with-temp-db 403 | (triples-add-schema db 'data '(data :base/unique t :base/type cons)) 404 | (triples-set-type db "foo" 'data :data '(a (b c))) 405 | (should (equal '(:data (a (b c))) 406 | (triples-get-type db "foo" 'data))) 407 | (should (= 1 (length (triples-db-select db nil 'data/data)))) 408 | ;; Let's also make sure if we store it as a straight list triples doesn't get 409 | ;; confused and try to store it as separate rows in the db. 410 | (triples-set-type db "foo" 'data :data '(a b c)) 411 | (should (= 1 (length (triples-db-select db nil 'data/data)))))) 412 | 413 | (ert-deftest triples-reversed () 414 | (triples-test-with-temp-db 415 | (triples-add-schema db 'named 416 | '(name :base/unique t) 417 | '(locale :base/unique t)) 418 | (triples-add-schema db 'locale 419 | '(used-in-name :base/virtual-reversed named/locale)) 420 | (triples-set-type db "en/US" 'locale nil) 421 | (should-not (triples-get-type db "en/US" 'locale)) 422 | (triples-set-type db "foo" 'named :name "foo" :locale "en/US") 423 | (should (equal '(:used-in-name ("foo")) 424 | (triples-get-type db "en/US" 'locale))) 425 | (should-error (triples-set-type db "en/US" 'locale :used-in-name '("bar"))))) 426 | 427 | (ert-deftest triples-with-predicate () 428 | (triples-test-with-temp-db 429 | (triples-add-schema db 'named '(name)) 430 | (should-not (triples-with-predicate db 'named/name)) 431 | (triples-set-type db "foo" 'named :name "My Name Is Fred Foo") 432 | (triples-set-type db "bar" 'named :name "My Name Is Betty Bar") 433 | (should (equal 434 | (triples-test-list-sort 435 | '(("bar" named/name "My Name Is Betty Bar" nil) 436 | ("foo" named/name "My Name Is Fred Foo" nil))) 437 | (triples-test-list-sort 438 | (triples-with-predicate db 'named/name)))))) 439 | 440 | (ert-deftest triples-subjects-of-type () 441 | (triples-test-with-temp-db 442 | (triples-add-schema db 'named '(name)) 443 | (should-not (triples-subjects-of-type db 'named)) 444 | (triples-set-type db "foo" 'named :name "My Name Is Fred Foo") 445 | (triples-set-type db "bar" 'named :name "My Name Is Betty Bar") 446 | (should (seq-set-equal-p '("foo" "bar") 447 | (triples-subjects-of-type db 'named))))) 448 | 449 | (ert-deftest triples-no-dups () 450 | (triples-test-with-temp-db 451 | ;; Just add a marker schema, no attributes 452 | (triples-add-schema db 'marker) 453 | (triples-set-type db "foo" 'marker) 454 | (should (equal '((1)) 455 | (sqlite-select db "SELECT COUNT(*) FROM triples WHERE subject = ? AND predicate = 'base/type' AND object = 'marker'" 456 | (list (triples-standardize-val "foo"))))) 457 | (triples-set-type db "foo" 'marker) 458 | (should (equal '((1)) 459 | (sqlite-select db "SELECT COUNT(*) FROM triples WHERE subject = ? AND predicate = 'base/type' AND object = 'marker'" 460 | (list (triples-standardize-val "foo"))))))) 461 | 462 | (ert-deftest triples-move-subject () 463 | (triples-test-with-temp-db 464 | (triples-add-schema db 'named '(name :base/unique t)) 465 | (triples-add-schema db 'friend '(id :base/unique t)) 466 | (triples-set-subject db 123 '(named :name "Ada Lovelace")) 467 | (triples-set-subject db 456 '(named :name "Michael Faraday") 468 | '(friend :id 123)) 469 | (triples-set-subject db 987 '(named :name "To Be Deleted")) 470 | (should-error (triples-move-subject db 123 987)) 471 | (triples-delete-subject db 987) 472 | (triples-move-subject db 123 987) 473 | (should-not (triples-get-subject db 123)) 474 | (should (equal "Ada Lovelace" (plist-get (triples-get-subject db 987) :named/name))) 475 | (should (equal 987 (plist-get (triples-get-subject db 456) :friend/id))))) 476 | 477 | (ert-deftest triples-test-subjects-with-predicate-object-unique-subject () 478 | (triples-test-with-temp-db 479 | (triples-add-schema db 'named '(name)) 480 | (triples-set-subject db 123 '(named :name ("Foo" "Foo"))) 481 | (should (= 1 (length (triples-subjects-with-predicate-object db 'named/name "Foo")))))) 482 | 483 | (ert-deftest triples-test-schema-and-data-with-same-subject () 484 | (triples-test-with-temp-db 485 | (triples-add-schema db 'foo '(bar :base/unique t)) 486 | (triples-add-schema db 'baz '(boo :base/unique t)) 487 | (triples-set-subject db 'foo '(baz :boo "bwa")) 488 | (should (equal "bwa" (plist-get (triples-get-subject db 'foo) :baz/boo))))) 489 | 490 | (ert-deftest triples-test-remove-schema-type () 491 | (triples-test-with-temp-db 492 | (should (= 0 (triples-count db))) 493 | (triples-add-schema db 'named '(name)) 494 | (triples-set-type db "foo" 'named :name "My Name Is Fred Foo") 495 | (triples-remove-schema-type db 'named) 496 | (should-not (triples-get-type db 'named 'base/type)) 497 | (should-not (triples-get-type db "foo" 'named)) 498 | (should-error (triples-set-type db "foo" 'named :name "My Name Is Fred Foo")) 499 | (ert-info ((format "Triples: %s" (triples-db-select db))) 500 | (should (= 0 (triples-count db)))))) 501 | 502 | (ert-deftest triples-readme () 503 | (triples-test-with-temp-db 504 | (triples-add-schema db 'person 505 | '(name :base/unique t :base/type string) 506 | '(age :base/unique t :base/type integer)) 507 | (triples-add-schema db 'employee 508 | '(id :base/unique t :base/type integer) 509 | '(manager :base/unique t) 510 | '(reportees :base/virtual-reversed employee/manager)) 511 | ;; Set up catherine and dennis 512 | (triples-set-type db "catherine" 'employee :manager "alice") 513 | (triples-set-type db "dennis" 'employee :manager "alice") 514 | (triples-delete-subject db "alice") 515 | (triples-set-type db "alice" 'person :name "Alice Aardvark" :age 41) 516 | (triples-set-type db "alice" 'employee :id 1901 :manager "bob") 517 | (should (equal (triples-test-plist-sort (triples-get-subject db "alice")) 518 | (triples-test-plist-sort '(:person/name "Alice Aardvark" :person/age 41 519 | :employee/id 1901 520 | :employee/manager "bob" 521 | :employee/reportees ("catherine" "dennis"))))) 522 | (triples-set-subject db "alice" '(person :name "Alice Aardvark" :age 41) 523 | '(employee :id 1901 :manager "bob")) 524 | (should (equal (triples-test-plist-sort (triples-get-subject db "alice")) 525 | (triples-test-plist-sort '(:person/name "Alice Aardvark" :person/age 41 526 | :employee/id 1901 527 | :employee/manager "bob" 528 | :employee/reportees ("catherine" "dennis"))))))) 529 | 530 | 531 | (provide 'triples-test) 532 | 533 | ;;; triples-test.el ends here 534 | -------------------------------------------------------------------------------- /triples-upgrade.el: -------------------------------------------------------------------------------- 1 | ;;; triples-upgrade --- Functions to upgrade data from previous triple db version -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2023 Free Software Foundation, Inc. 4 | 5 | ;; Author: Andrew Hyatt 6 | ;; Homepage: https://github.com/ahyatt/triples 7 | ;; 8 | ;; This program is free software; you can redistribute it and/or 9 | ;; modify it under the terms of the GNU General Public License as 10 | ;; published by the Free Software Foundation; either version 2 of the 11 | ;; License, or (at your option) any later version. 12 | ;; 13 | ;; This program is distributed in the hope that it will be useful, but 14 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 | ;; General Public License for more details. 17 | ;; 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with GNU Emacs. If not, see . 20 | 21 | ;;; Commentary: 22 | ;; Occasionally, changes in the triples library are not backwards-compatible, 23 | ;; and require upgrading the database. This file contains functions to do those 24 | ;; ugprades, along with instructions an how and when to use them. 25 | 26 | ;;; Code: 27 | 28 | (require 'triples) 29 | (require 'rx) 30 | (require 'sqlite nil t) 31 | 32 | (defun triples-upgrade-to-0.3 (db) 33 | "Upgrade the DB to version 0.3. 34 | This will convert all stringified integers stored with sqlite to 35 | actual integers. On Emacs version before 29, it will not do 36 | anything, since only the built-in sqlite data needs upgrading. 37 | Callers should force a backup to happen before calling this, 38 | by calling triples-backup with `most-positive-fixnum'. 39 | 40 | This function only handles the case where users transition from 41 | emacsql to sqlite, it is assumed that users don't transition from 42 | sqlite to emacsql after first creating their database. 43 | 44 | After triples version 0.3, everything should be created 45 | correctly, so databases created at that version or later should 46 | be correct by default." 47 | (if (or (version< emacs-version "29") 48 | (not (eq (type-of db) 'sqlite))) 49 | (message "Upgrade is only needed for the built-in sqlite databases used by emacs 29+") 50 | (message "triples: Upgrading triples schema to 0.3") 51 | (triples-rebuild-builtin-database db) 52 | (let ((replace-approved)) 53 | (mapc (lambda (column) 54 | ;; This would all be easier if sqlite supported REGEXP, but 55 | ;; instead we have to programmatically examine each string to see if it 56 | ;; is an integer. 57 | (mapc (lambda (row) 58 | (let ((string-val (car row))) 59 | (when (string-match (rx (seq string-start (opt ?\") (group-n 1 (1+ digit))) (opt ?\") string-end) 60 | string-val) 61 | (message "triples: Upgrading %s with integer string value %s to a real integer" column string-val) 62 | ;; Subject transformations have to be treated 63 | ;; carefully, since they could end up duplicating 64 | ;; predicates. 65 | (let ((int-val (string-to-number (match-string 1 string-val)))) 66 | (when (equal column "subject") 67 | (when (and (> (caar (sqlite-execute db "SELECT count(*) FROM triples WHERE subject = ? AND typeof(subject) = 'integer'" 68 | (list int-val))) 0) 69 | (or replace-approved 70 | (y-or-n-p (format "triples: For subject %d, existing real integer subject found. Replace for this and others? " 71 | int-val)))) 72 | (setq replace-approved t) 73 | (sqlite-execute db "DELETE FROM triples WHERE subject = ? AND typeof(subject) = 'integer'" 74 | (list int-val)))) 75 | (sqlite-execute db (format "UPDATE OR REPLACE triples SET %s = cast(REPLACE(%s, '\"', '') as integer) WHERE %s = ?" 76 | column column column) 77 | (list string-val)))))) 78 | (sqlite-select 79 | db 80 | (format "SELECT %s from triples WHERE cast(REPLACE(%s, '\"', '') as integer) > 0 AND typeof(%s) = 'text' GROUP BY %s" 81 | column column column column)))) 82 | '("subject" "object")) 83 | (message "Upgraded all stringified integers in triple database to actual integers")))) 84 | 85 | (provide 'triples-upgrade) 86 | 87 | ;;; triples-upgrade.el ends here 88 | -------------------------------------------------------------------------------- /triples.el: -------------------------------------------------------------------------------- 1 | ;;; triples.el --- A flexible triple-based database for use in apps -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (c) 2022-2025 Free Software Foundation, Inc. 4 | 5 | ;; Author: Andrew Hyatt 6 | ;; Homepage: https://github.com/ahyatt/triples 7 | ;; Package-Requires: ((seq "2.0") (emacs "28.1")) 8 | ;; Keywords: triples, kg, data, sqlite 9 | ;; Version: 0.6.0 10 | ;; This program is free software; you can redistribute it and/or 11 | ;; modify it under the terms of the GNU General Public License as 12 | ;; published by the Free Software Foundation; either version 2 of the 13 | ;; License, or (at your option) any later version. 14 | ;; 15 | ;; This program is distributed in the hope that it will be useful, but 16 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 | ;; General Public License for more details. 19 | ;; 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with GNU Emacs. If not, see . 22 | 23 | ;;; Commentary: 24 | ;; Triples is a library implementing a data storage based on the idea of 25 | ;; triples: subject, predicate, objects, plus some extra metadata. This data 26 | ;; structure provides a way to store data according to an extensible schema, and 27 | ;; provide an API offering two-way links between all information stored. 28 | ;; 29 | ;; This package requires either Emacs 29 or the emacsql package to be installed. 30 | 31 | 32 | (require 'cl-lib) 33 | (require 'package) 34 | (require 'seq) 35 | (require 'subr-x) 36 | (require 'emacsql nil t) 37 | 38 | ;;; Code: 39 | 40 | (defvar emacsql-sqlite-executable) 41 | (declare-function emacsql-with-transaction "emacsql") 42 | (declare-function emacsql-close "emacsql") 43 | (declare-function emacsql-sqlite "emacsql") 44 | (declare-function emacsql "emacsql") 45 | 46 | (defvar triples-sqlite-interface 47 | (if (and (fboundp 'sqlite-available-p) (sqlite-available-p)) 48 | 'builtin 49 | 'emacsql) 50 | "The interface to sqlite to use. 51 | Either `builtin' or `emacsql'. Defaults to builtin when 52 | available. Builtin is available when the version is Emacs 29 or 53 | greater, and emacsql is usable when the `emacsql' package is 54 | installed.") 55 | 56 | (defconst triples-sqlite-executable "sqlite3" 57 | "If using Emacs 29 builtin sqlite, this specifices the executable. 58 | It is invoked to make backups.") 59 | 60 | (defconst triples-default-database-filename (locate-user-emacs-file "triples.db") 61 | "The default filename triples database. 62 | 63 | If no database is specified, this file is used.") 64 | 65 | (defmacro triples-with-transaction (db &rest body) 66 | "Create a transaction using DB, executing BODY. 67 | The transaction will abort if an error is thrown." 68 | (declare (indent 0) (debug t)) 69 | `(triples--with-transaction ,db (lambda () ,@body))) 70 | 71 | (defun triples-rebuild-builtin-database (db) 72 | "Rebuild the builtin database DB. 73 | This is used in upgrades and when problems are detected." 74 | (triples-with-transaction 75 | db 76 | (sqlite-execute db "ALTER TABLE triples RENAME TO triples_old") 77 | (triples-setup-table-for-builtin db) 78 | (sqlite-execute db "INSERT INTO triples (subject, predicate, object, properties) SELECT DISTINCT subject, predicate, object, properties FROM triples_old") 79 | (sqlite-execute db "DROP TABLE triples_old"))) 80 | 81 | (defun triples-maybe-upgrade-to-builtin (db) 82 | "Check to see if DB needs to be upgraded from emacsql to builtin." 83 | ;; Check to see if this was previously an emacsql database, and if so, 84 | ;; change the property column to be standard for builtin sqlite. 85 | (when (> (caar (sqlite-select db "SELECT COUNT(*) FROM triples WHERE properties = '(:t t)'")) 86 | 0) 87 | (if (> (caar (sqlite-select db "SELECT COUNT(*) FROM triples WHERE properties = '()'")) 88 | 0) 89 | (progn 90 | (message "triples: detected data written with both builtin and emacsql, upgrading and removing duplicates") 91 | ;; Where we can, let's just upgrade the old data. However, sometimes we cannot due to duplicates. 92 | (sqlite-execute db "UPDATE OR IGNORE triples SET properties = '()' WHERE properties = '(:t t)'") 93 | ;; Remove any duplicates that we cannot upgrade. 94 | (sqlite-execute db "DELETE FROM triples WHERE properties = '(:t t)'")) 95 | (message "triples: detected previously used emacsql database, converting to builtin sqlite") 96 | (sqlite-execute db "UPDATE triples SET properties = '()' WHERE properties = '(:t t)'")))) 97 | 98 | (defun triples-connect (&optional file) 99 | "Connect to the database FILE and make sure it is populated. 100 | If FILE is nil, use `triples-default-database-filename'." 101 | (unless (pcase-exhaustive triples-sqlite-interface 102 | ('builtin 103 | (and (fboundp 'sqlite-available-p) (sqlite-available-p))) 104 | ('emacsql (require 'emacsql nil t))) 105 | (error "The triples package requires either Emacs 29 or the emacsql package to be installed")) 106 | (let ((file (or file triples-default-database-filename))) 107 | (pcase triples-sqlite-interface 108 | ('builtin (let* ((db (sqlite-open file))) 109 | (condition-case nil 110 | (progn 111 | (triples-setup-table-for-builtin db) 112 | (triples-maybe-upgrade-to-builtin db)) 113 | (error 114 | (message "triples: failed to ensure proper database tables and indexes. Trying an automatic fix.") 115 | (triples-rebuild-builtin-database db) 116 | (message "triples: fix completed, if this message re-occurs please file a bug report."))) 117 | db)) 118 | ('emacsql 119 | (require 'emacsql) 120 | (let* ((db (emacsql-sqlite-open file)) 121 | (triple-table-exists 122 | (emacsql db [:select name 123 | :from sqlite_master 124 | :where (= type table) :and (= name 'triples)]))) 125 | (unless triple-table-exists 126 | (emacsql db [:create-table triples ([(subject :not-null) 127 | (predicate text :not-null) 128 | (object :not-null) 129 | (properties text :not-null)])]) 130 | (emacsql db [:create-index subject_idx :on triples [subject]]) 131 | (emacsql db [:create-index subject_predicate_idx :on triples [subject predicate]]) 132 | (emacsql db [:create-index predicate_object_idx :on triples [predicate object]]) 133 | (emacsql db [:create-unique-index subject_predicate_object_properties_idx :on triples [subject predicate object properties]])) 134 | db))))) 135 | 136 | (defun triples-setup-table-for-builtin (db) 137 | "Set up the triples table in DB. 138 | This is a separate function due to the need to use it during 139 | upgrades to version 0.3" 140 | (sqlite-execute db "CREATE TABLE IF NOT EXISTS triples(subject NOT NULL, predicate TEXT NOT NULL, object NOT NULL, properties TEXT NOT NULL)") 141 | (sqlite-execute db "CREATE INDEX IF NOT EXISTS subject_idx ON triples (subject)") 142 | (sqlite-execute db "CREATE INDEX IF NOT EXISTS subject_predicate_idx ON triples (subject, predicate)") 143 | (sqlite-execute db "CREATE INDEX IF NOT EXISTS predicate_object_idx ON triples (predicate, object)") 144 | (sqlite-execute db "CREATE UNIQUE INDEX IF NOT EXISTS subject_predicate_object_properties_idx ON triples (subject, predicate, object, properties)")) 145 | 146 | (defun triples-close (db) 147 | "Close sqlite database DB." 148 | (pcase triples-sqlite-interface 149 | ('builtin (sqlite-close db)) 150 | ('emacsql (emacsql-close db)))) 151 | 152 | (defun triples-backup (_ filename num-to-keep) 153 | "Perform a backup of the db, located at path FILENAME. 154 | The first argument is unused, but later may be used to specify 155 | the running database. 156 | 157 | This uses the same backup location and names as configured in 158 | variables such as `backup-directory-alist'. Due to the fact that 159 | the database is never opened as a buffer, normal backups will not 160 | work, therefore this function must be called instead. 161 | 162 | Th DB argument is currently unused, but may be used in the future 163 | if Emacs's native sqlite gains a backup feature. 164 | 165 | FILENAME can be nil, if so `triples-default-database-filename' 166 | will be used. 167 | 168 | This also will clear excess backup files, according to 169 | NUM-TO-KEEP, which specifies how many backup files at max should 170 | exist at any time. Older backups are the ones that are deleted." 171 | (let ((filename (expand-file-name (or filename triples-default-database-filename)))) 172 | (call-process (pcase triples-sqlite-interface 173 | ('builtin triples-sqlite-executable) 174 | ('emacsql emacsql-sqlite-executable)) 175 | nil nil nil filename 176 | (format ".backup '%s'" (expand-file-name 177 | (car (find-backup-file-name 178 | filename))))) 179 | (let ((backup-files (file-backup-file-names filename))) 180 | (cl-loop for backup-file in (cl-subseq 181 | backup-files 182 | (min num-to-keep (length backup-files))) 183 | do (delete-file backup-file))))) 184 | 185 | (defun triples--decolon (sym) 186 | "Remove colon from SYM." 187 | (intern (string-replace ":" "" (format "%s" sym)))) 188 | 189 | (defun triples--encolon (sym) 190 | "Add a colon to SYM." 191 | (intern (format ":%s" sym))) 192 | 193 | (defun triples-standardize-val (val) 194 | "If VAL is a string, return it as enclosed in quotes. 195 | 196 | This is done to have compatibility with the way emacsql stores 197 | values. Turn a symbol into a string as well, but not a quoted 198 | one, because sqlite cannot handle symbols. Integers do not need 199 | to be stringified." 200 | ;; Do not print control characters escaped - we want to get things out exactly 201 | ;; as we put them in. 202 | (let ((print-escape-control-characters nil)) 203 | (pcase val 204 | ;; Just to save a bit of space, let's use "()" instead of "null", which is 205 | ;; what it would be turned into by the pcase above. 206 | ((pred null) "()") 207 | ((pred integerp) val) 208 | ((pred floatp) val) 209 | (_ (format "%S" val))))) 210 | 211 | (defun triples-standardize-result (result) 212 | "Return RESULT in standardized form. 213 | This imitates the way emacsql returns items, with strings 214 | becoming either symbols, lists, or strings depending on whether 215 | the string itself is wrapped in quotes." 216 | (if (numberp result) 217 | result 218 | (read result))) 219 | 220 | (defun triples-db-insert (db subject predicate object &optional properties) 221 | "Insert triple to DB: SUBJECT, PREDICATE, OBJECT with PROPERTIES. 222 | This is a SQL replace operation, because we don't want any 223 | duplicates; if the triple is the same, it has to differ at least 224 | with PROPERTIES. This is a low-level function that bypasses our 225 | normal schema checks, so should not be called from client programs." 226 | (unless (symbolp predicate) 227 | (error "Predicates in triples must always be symbols")) 228 | (when (and (fboundp 'plistp) (not (plistp properties))) 229 | (error "Properties stored must always be plists")) 230 | (pcase triples-sqlite-interface 231 | ('builtin 232 | (sqlite-execute db "REPLACE INTO triples VALUES (?, ?, ?, ?)" 233 | (list (triples-standardize-val subject) 234 | (triples-standardize-val (triples--decolon predicate)) 235 | (triples-standardize-val object) 236 | ;; Properties cannot be null, since in sqlite each null value 237 | ;; is distinct from each other, so replace would not replace 238 | ;; duplicate triples each with null properties. 239 | (triples-standardize-val properties)))) 240 | ('emacsql 241 | ;; We use a simple small plist '(:t t). Unlike sqlite, we can't insert this 242 | ;; as a string, or else it will store as something that would come out as a 243 | ;; string. And if we use nil, it will actually store a NULL in the cell. 244 | (emacsql db [:replace :into triples :values $v1] 245 | (vector subject (triples--decolon predicate) object (or properties '(:t t))))))) 246 | 247 | (defun triples--emacsql-andify (wc) 248 | "In emacsql where clause WC, insert `:and' between query elements. 249 | Returns the new list with the added `:and.'s. The first element 250 | MUST be there `:where' clause. This does reverse the clause 251 | elements, but it shouldn't matter." 252 | (cons (car wc) ;; the :where clause 253 | (let ((clauses (cdr wc)) 254 | (result)) 255 | (while clauses 256 | (push (car clauses) result) 257 | (if (cdr clauses) (push :and result)) 258 | (setq clauses (cdr clauses))) 259 | result))) 260 | 261 | (defun triples-db-delete (db &optional subject predicate object properties) 262 | "Delete triples matching SUBJECT, PREDICATE, OBJECT, PROPERTIES. 263 | 264 | DB is the database to delete from. 265 | 266 | If any of these are nil, they will not selected for. If you set 267 | all to nil, everything will be deleted, so be careful!" 268 | (pcase triples-sqlite-interface 269 | ('builtin (sqlite-execute 270 | db 271 | (concat "DELETE FROM triples" 272 | (when (or subject predicate object properties) 273 | (concat " WHERE " 274 | (string-join 275 | (seq-filter #'identity 276 | (list (when subject "SUBJECT = ?") 277 | (when predicate "PREDICATE = ?") 278 | (when object "OBJECT = ?") 279 | (when properties "PROPERTIES = ?"))) 280 | " AND ")))) 281 | (mapcar #'triples-standardize-val (seq-filter #'identity (list subject predicate object properties))))) 282 | ('emacsql 283 | (let ((n 0)) 284 | (apply #'emacsql 285 | db 286 | (apply #'vector 287 | (append '(:delete :from triples) 288 | (when (or subject predicate object properties) 289 | (triples--emacsql-andify 290 | (append 291 | '(:where) 292 | (when subject `((= subject ,(intern (format "$s%d" (cl-incf n)))))) 293 | (when predicate `((= predicate ,(intern (format "$s%d" (cl-incf n)))))) 294 | (when object `((= object ,(intern (format "$s%d" (cl-incf n)))))) 295 | (when properties `((= properties ,(intern (format "$s%d" (cl-incf n))))))))))) 296 | (seq-filter #'identity (list subject predicate object properties))))))) 297 | 298 | (defun triples-db-delete-subject-predicate-prefix (db subject pred-prefix) 299 | "Delete triples matching SUBJECT and predicates with PRED-PREFIX. 300 | 301 | DB is the database to delete from." 302 | (unless (symbolp pred-prefix) 303 | (error "Predicates in triples must always be symbols")) 304 | (pcase triples-sqlite-interface 305 | ('builtin (sqlite-execute db "DELETE FROM triples WHERE subject = ? AND predicate LIKE ?" 306 | (list (triples-standardize-val subject) 307 | (format "%s/%%" (triples--decolon pred-prefix))))) 308 | ('emacsql (emacsql db [:delete :from triples :where (= subject $s1) :and (like predicate $r2)] 309 | subject (format "%s/%%" (triples--decolon pred-prefix)))))) 310 | 311 | (defun triples-db-select-pred-op (db pred op val &optional properties limit) 312 | "Select matching predicates with PRED having OP relation to VAL. 313 | 314 | DB is the database to select from. 315 | 316 | OP is a comparison operator, and VAL is the value to compare. It 317 | is a symbol for a standard numerical comparison such as `=', 318 | `!=', `>', or, when `val' is a strings, `like'. All alphabetic 319 | comparison is case insensitive. 320 | 321 | If PROPERTIES is given, triples must match the given properties. 322 | If LIMIT is a positive integer, limit the results to that number." 323 | (unless (symbolp pred) 324 | (error "Predicates in triples must always be symbols")) 325 | (let ((pred (triples--decolon pred))) 326 | (pcase triples-sqlite-interface 327 | ('builtin 328 | (mapcar (lambda (row) (mapcar #'triples-standardize-result row)) 329 | (sqlite-select 330 | db 331 | (concat "SELECT * FROM triples WHERE predicate = ? AND " 332 | (cond ((integerp val) "CAST(object AS INTEGER) ") 333 | ((floatp val) "CAST(object AS REAL) ") 334 | (t "object COLLATE NOCASE ")) 335 | (symbol-name op) " ?" 336 | (when properties " AND properties = ?") 337 | (when (and limit (> limit 0)) (format " LIMIT %d" limit))) 338 | (append 339 | (list (triples-standardize-val pred) 340 | (triples-standardize-val val)) 341 | (when properties (list (triples-standardize-val properties))))))) 342 | ('emacsql 343 | (emacsql db 344 | (append 345 | [:select * :from triples :where (= predicate $s1) :and] 346 | (pcase op 347 | ('< [(< object $s2)]) 348 | ('<= [(<= object $s2)]) 349 | ('= [(= object $s2)]) 350 | ('!= [(!= object $s2)]) 351 | ('>= [(>= object $s2)]) 352 | ('> [(> object $s2)]) 353 | ('like [(like object $s2)])) 354 | (when (stringp val) [:collate :nocase]) 355 | (when properties 356 | (list :and '(= properties $s3))) 357 | (when (and limit (> limit 0)) 358 | (list :limit limit))) 359 | pred val properties))))) 360 | 361 | (defun triples-db-select-pred-prefix (db subject pred-prefix) 362 | "Return rows in DB matching SUBJECT and PRED-PREFIX." 363 | (pcase triples-sqlite-interface 364 | ('builtin (mapcar (lambda (row) (mapcar #'triples-standardize-result row)) 365 | (sqlite-select db "SELECT * FROM triples WHERE subject = ? AND predicate LIKE ?" 366 | (list (triples-standardize-val subject) 367 | (format "%s/%%" pred-prefix))))) 368 | ('emacsql (emacsql db [:select * :from triples :where (= subject $s1) :and (like predicate $r2)] 369 | subject (format "%s/%%" pred-prefix))))) 370 | 371 | (defun triples-db-select (db &optional subject predicate object properties selector) 372 | "Return rows matching SUBJECT, PREDICATE, OBJECT, PROPERTIES. 373 | 374 | DB is the database to select from. 375 | 376 | If any of these are nil, they are not included in the select 377 | statement. The SELECTOR is list of symbols subject, precicate, 378 | object, properties to retrieve or nil for *." 379 | (pcase triples-sqlite-interface 380 | ('builtin (mapcar (lambda (row) (mapcar #'triples-standardize-result row)) 381 | (sqlite-select db 382 | (concat "SELECT " 383 | (if selector 384 | (mapconcat (lambda (e) (format "%s" e)) selector ", ") 385 | "*") " FROM triples" 386 | (when (or subject predicate object properties) 387 | (concat " WHERE " 388 | (string-join 389 | (seq-filter #'identity 390 | (list (when subject "SUBJECT = ?") 391 | (when predicate "PREDICATE = ?") 392 | (when object "OBJECT = ?") 393 | (when properties "PROPERTIES = ?"))) 394 | " AND ")))) 395 | (mapcar #'triples-standardize-val (seq-filter #'identity (list subject predicate object properties)))))) 396 | ('emacsql 397 | (let ((n 0)) 398 | (apply #'emacsql 399 | db 400 | (apply #'vector 401 | (append `(:select 402 | ,(if selector (apply #'vector selector) '*) 403 | :from triples) 404 | (when (or subject predicate object properties) 405 | (triples--emacsql-andify 406 | (append 407 | '(:where) 408 | (when subject `((= subject ,(intern (format "$s%d" (cl-incf n)))))) 409 | (when predicate `((= predicate ,(intern (format "$s%d" (cl-incf n)))))) 410 | (when object `((= object ,(intern (format "$s%d" (cl-incf n)))))) 411 | (when properties `((= properties ,(intern (format "$s%d" (cl-incf n))))))))))) 412 | (seq-filter #'identity (list subject predicate object properties))))))) 413 | 414 | (defun triples-db-count (db) 415 | "Return the number of triples in DB." 416 | (pcase triples-sqlite-interface 417 | ('builtin (caar (sqlite-select db "SELECT COUNT(*) FROM triples"))) 418 | ('emacsql (caar (emacsql db [:select (funcall count *) :from triples]))))) 419 | 420 | (defun triples-move-subject (db old-subject new-subject) 421 | "Replace all instance in DB of OLD-SUBJECT to NEW-SUBJECT. 422 | Any references to OLD-SUBJECT as an object are also replaced. 423 | This will throw an error if there is an existing subject 424 | NEW-SUBJECT with at least one equal property (such as type 425 | markers). But if there are no commonalities, the OLD-SUBJECT is 426 | merged into NEW-SUBJECT." 427 | (pcase triples-sqlite-interface 428 | ('builtin 429 | (condition-case err 430 | (progn 431 | (sqlite-transaction db) 432 | (sqlite-execute db "UPDATE triples SET subject = ? WHERE subject = ?" 433 | (list (triples-standardize-val new-subject) (triples-standardize-val old-subject))) 434 | (sqlite-execute db "UPDATE triples SET object = ? WHERE object = ?" 435 | (list (triples-standardize-val new-subject) (triples-standardize-val old-subject))) 436 | (sqlite-commit db)) 437 | (error (sqlite-rollback db) 438 | (signal 'error err)))) 439 | ('emacsql 440 | (emacsql-with-transaction db 441 | (emacsql db [:update triples :set (= subject $s1) :where (= subject $s2)] 442 | new-subject old-subject) 443 | (emacsql db [:update triples :set (= object $s1) :where (= object $s2)] 444 | new-subject old-subject))))) 445 | 446 | ;; Code after this point should not call sqlite or emacsql directly. If any more 447 | ;; calls are needed, put them in a defun, make it work for sqlite and emacsql, 448 | ;; and put them above. 449 | 450 | (defun triples--subjects (triples) 451 | "Return all unique subjects in TRIPLES." 452 | (seq-uniq (mapcar #'car triples))) 453 | 454 | (defun triples--group-by-subjects (triples) 455 | "Return an alist of subject to TRIPLES with that subject." 456 | (let ((subj-to-triples (make-hash-table :test #'equal))) 457 | (dolist (triple triples) 458 | (puthash (car triple) 459 | (cons triple (gethash (car triple) subj-to-triples)) 460 | subj-to-triples)) 461 | (cl-loop for k being the hash-keys of subj-to-triples using (hash-values v) 462 | collect (cons k v)))) 463 | 464 | (defun triples--add (db op) 465 | "Perform OP on DB." 466 | (pcase (car op) 467 | ('replace-subject 468 | (mapc 469 | (lambda (sub) 470 | (triples-db-delete db sub)) 471 | (triples--subjects (cdr op)))) 472 | ('replace-subject-type 473 | (mapc (lambda (sub-triples) 474 | (mapc (lambda (type) 475 | ;; We have to ignore base, which keeps type information in general. 476 | (unless (eq type 'base) 477 | (triples-db-delete-subject-predicate-prefix db (car sub-triples) type))) 478 | (seq-uniq 479 | (mapcar #'car (mapcar #'triples-combined-to-type-and-prop 480 | (mapcar #'cl-second (cdr sub-triples))))))) 481 | (triples--group-by-subjects (cdr op))))) 482 | (mapc (lambda (triple) 483 | (apply #'triples-db-insert db triple)) 484 | (cdr op))) 485 | 486 | (defun triples-properties-for-predicate (db cpred) 487 | "Return the properties in DB for combined predicate CPRED as a plist." 488 | (mapcan (lambda (row) 489 | (list (intern (format ":%s" (nth 1 row))) (nth 2 row))) 490 | (triples-db-select db cpred))) 491 | 492 | (defun triples-predicates-for-type (db type) 493 | "Return all predicates defined for TYPE in DB." 494 | (mapcar #'car 495 | (triples-db-select db type 'schema/property nil nil '(object)))) 496 | 497 | (defun triples-verify-schema-compliant (triples prop-schema-alist) 498 | "Error if TRIPLES is not compliant with schema in PROP-SCHEMA-ALIST. 499 | PROP-SCHEMA-ALIST is an alist of the relevant properties to the 500 | data stored, in combined type/property form, and their schema 501 | definitions." 502 | (mapc (lambda (triple) 503 | (pcase-let ((`(,type . ,_) (triples-combined-to-type-and-prop (nth 1 triple)))) 504 | (unless (or (eq type 'base) (assoc (nth 1 triple) prop-schema-alist)) 505 | (error "Property %s not found in schema" (nth 1 triple))))) 506 | triples) 507 | (mapc (lambda (triple) 508 | (triples--plist-mapc (lambda (pred-prop val) 509 | (let ((f (intern (format "triples-verify-%s-compliant" 510 | (triples--decolon pred-prop))))) 511 | (if (fboundp f) 512 | (funcall f val triple)))) 513 | (cdr (assoc (nth 1 triple) prop-schema-alist)))) triples)) 514 | 515 | (defun triples-add-schema (db type &rest props) 516 | "Add schema for TYPE and its PROPS to DB." 517 | (triples--add db (apply #'triples--add-schema-op type props))) 518 | 519 | (defun triples--add-schema-op (type &rest props) 520 | "Return the operation store schema for TYPE, with PROPS. 521 | PROPS is a list of either property symbols, or lists of 522 | properties of the type and the meta-properties associated with 523 | them." 524 | (cons 'replace-subject-type 525 | (cons `(,type base/type schema) 526 | (cl-loop for p in props 527 | nconc 528 | (let* ((pname (if (symbolp p) p (car p))) 529 | (pprops (when (listp p) (cdr p))) 530 | (pcombined (intern (format "%s/%s" type pname)))) 531 | (cons (list type 'schema/property pname) 532 | (seq-filter #'identity 533 | (triples--plist-mapcar 534 | (lambda (k v) 535 | ;; If V is nil, that's the default, so don't 536 | ;; store anything. 537 | (when v 538 | (list pcombined (triples--decolon k) v))) 539 | pprops)))))))) 540 | 541 | (defun triples-remove-schema-type (db type) 542 | "Remove the schema for TYPE in DB, and all associated data." 543 | (triples-with-transaction 544 | db 545 | (let ((subjects (triples-subjects-of-type db type))) 546 | (mapc (lambda (subject) 547 | (triples-remove-type db subject type)) 548 | subjects) 549 | (triples-remove-type db type 'schema)))) 550 | 551 | (defun triples-count (db) 552 | "Return the number of triples in DB." 553 | (triples-db-count db)) 554 | 555 | (defun triples-set-type (db subject type &rest properties) 556 | "Create operation to replace PROPERTIES for TYPE for SUBJECT in DB. 557 | PROPERTIES is a plist of properties, without TYPE prefixes." 558 | (let* ((prop-schema-alist 559 | ;; If the type doesn't exist, there is no schema to check against. 560 | (when (triples-get-type db type 'schema) 561 | (triples--plist-mapcar 562 | (lambda (k v) 563 | (cons (triples--decolon k) v)) 564 | (triples-properties-for-predicate db (triples-type-and-prop-to-combined type 'schema/property))) 565 | (mapcar (lambda (prop) 566 | (cons (triples--decolon prop) 567 | (triples-properties-for-predicate 568 | db 569 | (triples-type-and-prop-to-combined type prop)))) 570 | (triples--plist-mapcar (lambda (k _) k) properties)))) 571 | (op (triples--set-type-op subject type properties prop-schema-alist))) 572 | (triples-verify-schema-compliant 573 | (cdr op) 574 | ;; triples-verify-schema-compliant can act on triples from many types, so 575 | ;; we have to include the type information in our schema property alist. 576 | (mapcar (lambda (c) 577 | (cons (triples-type-and-prop-to-combined type (car c)) 578 | (cdr c))) prop-schema-alist)) 579 | (triples--add db op))) 580 | 581 | (defmacro triples--eval-when-fboundp (sym form) 582 | "Delay macroexpansion to runtime if SYM is not yet `fboundp'. 583 | FORM is the code to delay." 584 | (declare (indent 1) (debug (symbolp form))) 585 | (if (fboundp sym) 586 | form 587 | `(eval ',form t))) 588 | 589 | (defun triples--with-transaction (db body-fun) 590 | "Wrap BODY-FUN in a transaction for DB." 591 | (pcase triples-sqlite-interface 592 | ('builtin (condition-case err 593 | (progn 594 | (sqlite-transaction db) 595 | (funcall body-fun) 596 | (sqlite-commit db)) 597 | (error (sqlite-rollback db) 598 | (signal (car err) (cdr err))))) 599 | ('emacsql (funcall (triples--eval-when-fboundp emacsql-with-transaction 600 | (lambda (db body-fun) 601 | (emacsql-with-transaction db (funcall body-fun)))) 602 | db body-fun)))) 603 | 604 | (defun triples-set-types (db subject &rest combined-props) 605 | "Set all data for types in COMBINED-PROPS in DB for SUBJECT. 606 | COMBINED-PROPS is a plist which takes combined properties such as 607 | :named/name and their values. All other data related to the types 608 | given in the COMBINED-PROPS will be removed." 609 | (let ((type-to-plist (make-hash-table))) 610 | (triples--plist-mapc 611 | (lambda (cp val) 612 | (pcase-let ((`(,type . ,prop) (triples-combined-to-type-and-prop cp))) 613 | (puthash (triples--decolon type) 614 | (plist-put (gethash (triples--decolon type) type-to-plist) 615 | (triples--encolon prop) val) type-to-plist))) 616 | combined-props) 617 | (triples-with-transaction 618 | db 619 | (cl-loop for k being the hash-keys of type-to-plist using (hash-values v) 620 | do (apply #'triples-set-type db subject k v))))) 621 | 622 | (defun triples--set-type-op (subject type properties type-schema) 623 | "Create operation to replace PROPERTIES for TYPE for SUBJECT. 624 | PROPERTIES is a plist of properties, without TYPE prefixes. 625 | TYPE-SCHEMA is an alist of property symbols to their schema, 626 | which is necessary to understand when lists are supposed to be 627 | broken down into separate rows, and when to leave as is." 628 | (cons 'replace-subject-type 629 | (cons (list subject 'base/type type) 630 | (triples--plist-mapcan 631 | (lambda (prop v) 632 | (let ((prop-schema (cdr (assoc (triples--decolon prop) type-schema)))) 633 | (if (and 634 | (listp v) 635 | (not (plist-get prop-schema :base/unique))) 636 | (cl-loop for e in v for i from 0 637 | collect 638 | (list subject 639 | (triples-type-and-prop-to-combined type prop) 640 | e 641 | (list :index i))) 642 | (list (list subject (triples-type-and-prop-to-combined type prop) v))))) 643 | properties)))) 644 | 645 | (defun triples-get-type (db subject type) 646 | "From DB get data associated with TYPE for SUBJECT." 647 | (let ((preds (make-hash-table :test #'equal))) 648 | (mapc (lambda (db-triple) 649 | (puthash (nth 1 db-triple) 650 | (cons (cons (nth 2 db-triple) (nth 3 db-triple)) 651 | (gethash (nth 1 db-triple) preds)) 652 | preds)) 653 | (triples-db-select-pred-prefix db subject type)) 654 | (append 655 | (cl-loop for k being the hash-keys of preds using (hash-values v) 656 | nconc (list (triples--encolon (cdr (triples-combined-to-type-and-prop k))) 657 | (if (and (car v) 658 | (plist-get (cdar v) :index)) 659 | (mapcar #'car (sort v (lambda (a b) 660 | (< (plist-get (cdr a) :index) 661 | (plist-get (cdr b) :index))))) 662 | (caar v)))) 663 | (cl-loop for pred in (triples-predicates-for-type db type) 664 | nconc 665 | (let ((reversed-prop (plist-get 666 | (triples-properties-for-predicate 667 | db (triples-type-and-prop-to-combined type pred)) 668 | :base/virtual-reversed))) 669 | (when reversed-prop 670 | (let ((result 671 | (triples-db-select db nil reversed-prop subject nil '(subject)))) 672 | (when result (cons (triples--encolon pred) (list (mapcar #'car result))))))))))) 673 | 674 | (defun triples-remove-type (db subject type) 675 | "Remove TYPE for SUBJECT in DB, and all associated data." 676 | (triples-with-transaction 677 | db 678 | (triples-db-delete db subject 'base/type type) 679 | (triples-db-delete-subject-predicate-prefix db subject type))) 680 | 681 | (defun triples-get-types (db subject) 682 | "From DB, get all types for SUBJECT." 683 | (mapcar #'car 684 | (triples-db-select db subject 'base/type nil nil '(object)))) 685 | 686 | (defun triples-get-subject (db subject) 687 | "From DB return all properties for SUBJECT as a single plist." 688 | (mapcan (lambda (type) 689 | (triples--plist-mapcan 690 | (lambda (k v) 691 | (list (intern (format ":%s/%s" type (triples--decolon k))) v)) 692 | (triples-get-type db subject type))) 693 | (triples-get-types db subject))) 694 | 695 | (defun triples-set-subject (db subject &rest type-vals-cons) 696 | "From DB set properties of SUBJECT to TYPE-VALS-CONS data. 697 | TYPE-VALS-CONS is a list of conses, combining a type and a plist of values." 698 | (triples-with-transaction db 699 | (triples-delete-subject db subject) 700 | (mapc (lambda (cons) 701 | (apply #'triples-set-type db subject cons)) 702 | type-vals-cons))) 703 | 704 | (defun triples-delete-subject (db subject) 705 | "Delete all data in DB associated with SUBJECT. 706 | This usually should not be called, it's better to just delete 707 | data you own with `triples-remove-type'." 708 | (triples-db-delete db subject)) 709 | 710 | (defun triples-search (db cpred text &optional limit) 711 | "Search DB for instances of combined property CPRED with TEXT. 712 | If LIMIT is a positive integer, limit the results to that number." 713 | (triples-db-select-pred-op db cpred 'like (format "%%%s%%" text) nil limit)) 714 | 715 | (defun triples-with-predicate (db cpred) 716 | "Return all triples in DB with CPRED as its combined predicate." 717 | (triples-db-select db nil cpred)) 718 | 719 | (defun triples-subjects-with-predicate-object (db cpred obj) 720 | "Return all subjects in DB with CPRED equal to OBJ. 721 | Subjects will not be returned more than once." 722 | (seq-uniq (mapcar #'car (triples-db-select db nil cpred obj)))) 723 | 724 | (defun triples-subjects-of-type (db type) 725 | "Return a list of all subjects with a particular TYPE in DB." 726 | (triples-subjects-with-predicate-object db 'base/type type)) 727 | 728 | (defun triples-combined-to-type-and-prop (combined) 729 | "Return cons of type and prop that form the COMBINED normal representation. 730 | This is something of form `:type/prop'." 731 | (let ((s (split-string (format "%s" combined) "/"))) 732 | (cons (triples--decolon (nth 0 s)) (intern (nth 1 s))))) 733 | 734 | (defun triples-type-and-prop-to-combined (type prop) 735 | "Format TYPE and PROP to a combined format - type/prop." 736 | (intern (format "%s/%s" (triples--decolon type) (triples--decolon prop)))) 737 | 738 | (defun triples--plist-mapc (fn plist) 739 | "Map FN over PLIST, for only side effects. 740 | FN must take two arguments: the key and the value." 741 | (let ((plist-index plist)) 742 | (while plist-index 743 | (let ((key (pop plist-index))) 744 | (funcall fn key (pop plist-index)))))) 745 | 746 | (defun triples--plist-mapcar (fn plist) 747 | "Map FN over PLIST, returning an element for every property. 748 | FN must take two arguments: the key and the value." 749 | (let ((plist-index plist) 750 | (result)) 751 | (while plist-index 752 | (let ((key (pop plist-index))) 753 | (push (funcall fn key (pop plist-index)) result))) 754 | (nreverse result))) 755 | 756 | (defun triples--plist-mapcan (fn plist) 757 | "Map FN over PLIST, nconcing elements together. 758 | FN must take two arguments: the key and the value." 759 | (let ((plist-index plist) 760 | (result)) 761 | (while plist-index 762 | (let ((key (pop plist-index))) 763 | (setq result (nconc result (funcall fn key (pop plist-index)))))) 764 | result)) 765 | 766 | ;; Standard properties 767 | 768 | (defun triples-verify-base/unique-compliant (uniquep triple) 769 | "Verify that TRIPLE has an index or not, based on UNIQUEP." 770 | (if uniquep 771 | (when (member :index (nth 3 triple)) 772 | (error "Invalid triple found: %s, violates base/unique, should be just one value" triple)) 773 | (unless (member :index (nth 3 triple)) 774 | (error "Invalid triple found: %s, violates base/unique, should be a list of values" triple)))) 775 | 776 | (defun triples-verify-base/type-compliant (type triple) 777 | "Verify that TRIPLE's object is of TYPE." 778 | (unless (eq (type-of (nth 2 triple)) type) 779 | (error "Triple %s has an object with the wrong type: expected type of %s but was %s" 780 | triple type (type-of (nth 2 triple))))) 781 | 782 | (defun triples-verify-base/virtual-reversed-compliant (_ triple) 783 | "Reject any TRIPLE with a virtual reversed property. 784 | 785 | Virtual reversed properties shouldn't be set manually, so are 786 | never compliant." 787 | (error "Invalid triple found: %s, should not be setting a `base/virtual-reversed' property" 788 | triple)) 789 | 790 | (provide 'triples) 791 | 792 | ;;; triples.el ends here 793 | --------------------------------------------------------------------------------