Advanced OODB in PicoLisp

In this tutorial I will assume you’ve already glanced at the documents I linked to in the prior article. I hope you still have cms.db intact.

# Copy paste relations and classes from the prior 
# article here, nothing has changed

(pool "cms.db")

(? 
 (select (@A) 
         ((tag +Tag "pc" (tags +Article)))
         (tolr "computer" @A body) 
 (show @A)))

A lot easier than the approach we employed in the prior tutorial, select will first take generators, in our case only (tag +Tag “pc” (tags +Article)). It will go through the tags and when we find one with tag “pc” we will continue and retrieve all articles connected through the tags reference. Next comes an arbitrary amount of filter clauses, in our case only one: (tolr “computer” @A body). tolr is a shortcut for tolerant which means we do partials too. Try replacing “computer” with “comp” and the result will be the same.

The result is of course a list with all articles who are tagged with “pc” and contain the substring “computer” in their article bodies.

(? 
 (select (@A) 
         ((tag +Tag "pc" (tags +Article)))
         (tolr "computer" @A body)
         (same "sam" @A author username)
         (same "tech" @A folder slug)
 (show @A)))

The only addition here is more filtering through the author and folder references. We now get a list of all articles tagged with “pc”, written by Sam, containing “computer” in their bodies and located in the “tech” folder, feel free to contemplate the equivalent SQL…

As you might know already this all works through Pilog which is a Pico Lisp implementation of Prolog. To understand how it works let’s play around a little with be and a Pilog version of the SWI-Prolog tutorial:

(be Indian (vindaloo))
(be Indian (dahl))
(be Indian (tandoori))
(be Indian (kurma))
(be mild (dahl))
(be mild (tandoori))
(be mild (kurma))
(be Chinese (chow-mein))
(be Chinese (chop-suey))
(be Chinese (sweet-and-sour))
(be Italian (pizza))
(be Italian (spaghetti))

(be likes (Sam @F) (Indian @F) (mild @F))
(be likes (Sam @F) (Chinese @F))
(be likes (Sam @F) (Italian @F))
(be likes (Sam chips))

(? (likes Sam @F))

Yep, Sam likes Indian food but only the mild curries, vindaloo doesn’t fall into that category, that’s why it’s missing in the output. This is the mechanism behind our OODB queries. The same and tolr keywords we use above are in fact set with be in pilog.l.

Let’s continue with some simple pagination:

(new! '(+Article) 'slug "new-pcs-in-2008" 'headline "New PC's in 2008" 'body "An article about all the new PC's in 2008." 'author (db 'username '+User "sam"))

(setq *Query (goal '(@Headline "2008" (db headline +Article @Headline @A))))

(do 2 (bind (prove *Query) (println (get @A 'headline))))

There are two new things here goal and prove. Until now we have used the shortcut ? to do both at the same time. Goal will prepare a Lisp statement by turning it into a valid query that the Pilog engine can prove or disprove like we are doing above with Sam and his food. Try printing *Query to see what it looks like. In this case repeated calls to the last line will retrieve the results two by two because prove will return the next result which makes it ideal to call repeatedly to get the next two and then the next two and so on. Try this instead:

(setq *Query (goal '(@Headline "2008" (db headline +Article @Headline @A))))
(do 1 (bind (prove *Query) (println (get @A 'headline))))
(do 1 (bind (prove *Query) (println (get @A 'headline))))

In a “sharp” situation we could have called that last line to fetch the next result when our user presses a next button for instance. Notice also the necessary “preparation” of 2008 with @Headline at the beginning of the quoted list we pass to goal.

Updating and Deleting

Until now we have only selected and inserted things, let’s look at ways to change and delete our data. As you know most of our articles are tagged with “fun”, this is how we could remove that tag from our tech folder/article:

(del!> (db 'slug '+Article "tech") 'tags (db 'tag '+Tag "fun"))
(mapcar show (collect 'slug '+Article))

Note how del!> automatically deletes the fun tag from the reference list in the tech article. Updating a pure value is just a matter of putting again:

(put!> (db 'slug '+Article "tech") 'headline "The technology folder")
(mapcar show (collect 'slug '+Article))

Let’s get rid of the fun tag altogether:

(lose!> (db 'tag '+Tag "fun"))
(mapcar show (collect 'slug '+Article))

The tag is gone but the references are still there, in my case the fun tag was {P} and the {P} still shows in the tag list of each article. So we have a case of orphaning, sometimes it’s a wanted behavior, not now though so let’s get rid of the reference:

(for Article (collect 'tags '+Article '{P})
     (put!> Article 'tags (delete '{P} (get Article 'tags))))

(mapcar show (collect 'slug '+Article))

The for loop is the Pico version of the old “for in” or “for each”. We collect all articles that are referring to the fun tag ({P}). After that we get the tag list in question, delete the fun reference and finally put it back. With that in mind we could create a custom lose method:

(extend +Entity)
(dm loseref!> ()
    (for Child (var: Cascade) 
         (let (ChildClass (car Child) ChildRef (cdr Child)) 
           (for Element (collect ChildRef ChildClass This)
                (put!> Element ChildRef (delete This (get Element ChildRef))))))
    (lose!> This))

(class +User +Entity)
(rel username (+Need +Key +String))
(rel password (+Need +String))

(class +Article +Entity)
(rel slug     (+Need +Key +String))
(rel headline (+Need +Idx +String))
(rel body     (+Need +String))
(rel author   (+Ref +Link) NIL (+User))
(rel folder   (+Ref +Link) NIL (+Article))
(rel tags     (+List +Ref +Link) NIL (+Tag))

(class +Tag +Entity)
(rel tag (+Need +Key +String))
(var Cascade . ((+Article . tags)))

(pool "cms.db")

(loseref!> (db 'tag '+Tag "pc"))

(mapcar show (collect 'slug '+Article))

This is just repetition of the above with the addition of a Cascade list that we loop through to find which classes are affected (in our case only +Article) and the name of the reference to use (tags). Note the use of class variables (which I forgot to mention in the simple OO tutorial). We initiate a class variable with var and retrieve it with var:.

That was one way of doing it, another is to inspect the relations and use that information to do the cleanup. The problem with this is that it will delete all references in all tagged objects. Pretend you had something else in the system that you are tagging, +Novel(s) for instance. If you only wanted to remove the specific tag for articles, not novels you would have to specifically state that somewhere and you are back to something like the above. However, if this is not a problem you could do like this instead:

(extend +Entity)
(dm loseref!> ()
    (for Child (getRefs> This) 
         (let (ChildClass (car Child) ChildRef (cdr Child)) 
           (for Element (collect ChildRef ChildClass This)
                (put!> Element ChildRef (delete This (get Element ChildRef))))))
    (lose!> This))

(dm getRefs> ()
    (make 
     (for Class (all)
          (when (isa '+Entity Class) 
            (for El (getl Class) 
                 (and 
                  (isa '(+Ref +Link) (car El))
                  (= (list *Class) (get El 1 'type))
                  (link (cons Class (cdr El)))))))))

# Relations here without the (var Cascade . ((+Article . tags))) line.

(pool "cms.db")

(loseref!> (db 'tag '+Tag "scuba"))

(mapcar show (collect 'slug '+Article))

GetRefs> will loop through all symbols currently loaded, when the symbol is an +Entity we fetch the whole property list from the symbol.

We loop through all properties and check if they have +Ref +Link, if yes we check if the current class accessed through the *Class global is equal to the type we fetch from the car of El, yes (get (car El) ‘type) would have worked too. If they are equal we move on and link a cons pair to the list.

We get the name of the relation with (cdr El), the result is identical to the explicitly set ((+Article . tags)) in the prior example.

Related Posts

Tags: ,