Added LIKE" for creating 'WHERE column LIKE' queries

(cherry picked from commit 0ea3d948ff5fe4bf60f03a14854e02a06267fe23)
(cherry picked from commit a6f6ddfb724c1ec02c6d6c807fd8ae3c4f61bbf4)

diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index cf6414b19caa7d1c8aff393b564b20482410fb27..79f27053992aadef972633a715f3566a740b4580 100644 (file)
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -2,13 +2,22 @@
 ! See https://factorcode.org/license.txt for BSD license.
 USING: accessors arrays byte-arrays classes classes.tuple
 combinators continuations db db.errors db.tuples
-db.tuples.private db.types destructors kernel make math
-math.bitwise math.intervals math.parser namespaces nmake random
-sequences strings ;
+db.tuples.private db.types destructors kernel lexer make math
+math.bitwise math.intervals math.parser namespaces nmake
+peg.search random sequences strings strings.parser ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
 
+TUPLE: likeexp text ;
+: <likeexp> ( string -- <likeexp> )
+    likeexp boa ; 
+
+: parse-like ( accum -- accum )
+    lexer get skip-blank parse-string <likeexp> suffix! ;
+
+SYNTAX: LIKE" parse-like ; ! "
+
 SINGLETON: retryable
 : make-retryable ( obj -- obj' )
     dup sequence? [
@@ -129,6 +138,11 @@ M: integer where object-where ;
 
 M: string where object-where ;
 
+: like-where ( spec obj -- )
+   text>> over column-name>> 0% " LIKE " 0% bind# ;
+
+M: likeexp where like-where ;
+
 : filter-slots ( tuple specs -- specs' )
     [
         slot-name>> swap get-slot-named