Major refactoring of meta-model code + added dependancy on cl-pg-introspect + patches
[clinton/lisp-on-lines.git] / doc / lisp-on-lines.txt
1 LISP-ON-LINES
2
3 Drew Crampsie, José Pablo Ezequiel "Pupeno" Fernández Silva
4
5 Abstract
6
7 Lisp-On-Lines is a very useful module that works on top
8 of the UnCommon Web framework to do rapid developing of
9 complex data-driven web appilcations (on Common Lisp,
10 of course).
11
12 1 Introduction
13
14 Lisp-On-Lines was founded and developed and continues
15 to be developed and mantained by Drew Crampsie.
16
17 1.1 Conventions
18
19 The conventions used in this manual are:
20
21 * Code is shown in a monospace font. When it is
22 expected that the user is working in an interactive
23 environment what the user should type appears as
24 bold, while the computer result appears non-bold, for example:
25
26 > (+ 5 10)
27
28 15
29
30 * Names of people or products are show as small caps,
31 like Drew Crampsie or Lisp-On-Lines.
32
33 * Sections marked with ToDo require further revision.
34
35 ToDo: Add more conventions as they are needed, possible
36 classes of text: names of concepts, name of programming
37 entities, like variables, functions, etc (which are
38 embedded in text, should they be shown monospaced ?).
39
40 2 Components
41
42 Meta Model Protocol A Protocol for introspection on
43 relational objects.
44
45 Mewa Presentations A Mewa-likehttp://www.adrian-lienhard.ch/files/mewa.pdf layer for UncommonWebhttp://common-lisp.net/project/ucw/
46 Presentations.
47
48 3 Example
49
50 First we start with the data model. The Meta Model
51 Protocol (MMP) is used to provide information on the
52 data objects and how they relate to one another. Its is
53 currently implemented as a layer over CLSQLhttp://clsql.b9.com/, although
54 support is planned for other backends (CLOS,
55 Elephant[4], whatever).
56
57 The MMP shares its definition syntax with CLSQL's
58 Object Oriented Data Definition Language (OODDL)http://clsql.b9.com/manual/ref-ooddl.html. The
59 macro to define view-classes is named
60 DEF-VIEW-CLASS/META, and takes the same arguments as
61 DEF-VIEW-CLASS from CLSQL. For the purposes of this
62 simple example, we will only need two functions from
63 the MMP beyond what CLSQL provides : LIST-SLOTS and
64 LIST-SLOT-TYPES[5].
65
66 We'll define a simple class to hold a user.
67
68 > (def-view-class/meta user ()
69
70 ((userid :initarg :userid :accessor userid :type
71 integer :db-kind :key)
72
73 (username :initarg :username :accessor username
74 :type string :db-kind :base)
75
76 (password :initarg :password :accessor password
77 :type string :db-kind :base)))
78
79 and now we create a user:
80
81 > (defparameter user (make-instance 'user :userid 1
82
83 :username "drewc"
84
85 :password "p@ssw0rd"))
86
87 We can see the slots of users running:
88
89 > (lisp-on-lines::list-slots user)
90
91 (USERID USERNAME PASSWORD)
92
93 or the types with:
94
95 > (lisp-on-lines::list-slot-types user)
96
97 ((USERID INTEGER) (USERNAME STRING) (PASSWORD STRING))
98
99 To see the default attributes of a classIs this correct ? Drew, please, check. we run.
100
101 > (lisp-on-lines::default-attributes user)
102
103 ((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
104
105 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
106
107 (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
108
109 To set the attributes of a class to the default values
110 we use:
111
112 > (lisp-on-lines::set-default-attributes user)
113
114 ((USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
115
116 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
117
118 (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD))
119
120 which takes an object of the class we are working with.
121 This is going to be change so we can do this action
122 directly on the class. It is on the TODO file.
123
124 Class attributes?
125
126 > (lisp-on-lines::find-class-attributes user)
127
128 (USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
129
130 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
131
132 (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
133
134 NIL)
135
136 note that the mewa functions (find-attribute,
137 set-attribute etc) can take either an instance, or a
138 class-name as a symbol:
139
140 > (lisp-on-lines::find-class-attributes 'user)
141
142 (USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
143
144 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
145
146 (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
147
148 NIL)
149
150 > (lisp-on-lines::find-class-attributes (make-instance 'user))
151
152 (USER (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
153
154 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
155
156 (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
157
158 NIL)
159
160 Using that information, we have enough to create an
161 interface to the object. UnCommon Web includes a
162 powerful presentation systemTo see this system in action, we strongly recomend to
163 study the presentations example which comes with
164 UnCommon Web. Reading components/presentations.lisp can
165 help understand a lot about how presentations are built.
166 , but it is not dynamic enough for some of the most
167 advanced applications. Mewa defines an approach to
168 presentations that solves that problem, but the paper
169 is written from a Smalltalk point of view. A mixture of
170 the two , Mewa Presentations(MP), is described here.
171
172 MP introduces to UnCommon Web the concept of
173 attributes. An attribute is essentially a named version
174 of the DEFPRESENTATION slot-like arguments, for example
175 in :
176
177 > (defpresentation person-editor (object-presentation)
178
179 ((string :label "First Name" :slot-name 'first-name
180 :max-length 30)))
181
182 the (string :label "First Name" ...) form is an
183 attribute definiton. Attributes are accessed through
184 FIND-ATTIRIBUTES, and are composed at run time (where
185 the UnCommon Web's presentation system is done at
186 compile time) to display the object. This allows a very
187 flexible system of displaying objects which is
188 reminiscent of CSSDrew Crapmsie discovered this, rather than invent or
189 design it, so there are some rough edges, but its a
190 good start.
191 .
192
193 Its much easier to show this than to tell. Lets present
194 our user class. Currently in UnCommon Web, you'd define
195 a presentation as such :
196
197 > (defpresentation user-presentation (object-presentation)
198
199 ((INTEGER :LABEL "USERID" :SLOT-NAME USERID)
200
201 (STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
202
203 (STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)))
204
205 which could be presented using PRESENT-OBJECT :
206
207 > (present-object user :using 'user-presentation)
208
209 The equivalent approach using mewa presentations is
210 actually longer and more verbose(!) but it serves to
211 demonstrate how the MP system works.
212
213 Mewa Presentations adds a set of attributes to a class,
214 keyed off the class name. Attributes are inherited, so
215 if you define an attribute on T, you can use it with
216 any class.
217
218 MP stores named attributes keyed on a class name. To
219 achieve the same functionality as the above using mp
220 would look like this :
221
222 > (setf (lisp-on-lines::find-attribute 'user :viewer)Isn't this too imperative (in contrast to functional, lispy).
223
224 '(lisp-on-lines::mewa-object-presentation
225
226 :attributes (userid username password)
227
228 :global-properties (:editablep nil)))
229
230 (:VIEWER MEWA-OBJECT-PRESENTATION
231
232 :ATTRIBUTES
233
234 (USERID USERNAME PASSWORD)
235
236 :GLOBAL-PROPERTIES
237
238 (:EDITABLEP NIL))
239
240 > (setf (lisp-on-lines::find-attribute 'user 'userid)Are this setfs to 'userid, 'username and 'password
241 needed ? I (Pupeno) inspected they contents at of this
242 moment and they seem to already contain what they are
243 being set to.
244
245 '(integer :label "userid" :slot-name userid))
246
247 (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
248
249 > (setf (lisp-on-lines::find-attribute 'user 'username)
250
251 '(STRING :LABEL "USERNAME" :SLOT-NAME USERNAME))
252
253 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
254
255 > (setf (lisp-on-lines::find-attribute 'user 'password)
256
257 '(STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD))
258
259 (PASSWORD STRING :LABEL "USERNAME" :SLOT-NAME PASSWORD)
260
261 > (lisp-on-lines::find-class-attributes 'user)
262
263 (USER
264
265 (:VIEWER MEWA-OBJECT-PRESENTATION
266
267 :ATTRIBUTES
268
269 (USERID USERNAME PASSWORD)
270
271 :GLOBAL-PROPERTIES
272
273 (:EDITABLEP NIL))
274
275 (PASSWORD STRING :LABEL "PASSWORD" :SLOT-NAME PASSWORD)
276
277 (USERNAME STRING :LABEL "USERNAME" :SLOT-NAME USERNAME)
278
279 (USERID INTEGER :LABEL "USERID" :SLOT-NAME USERID)
280
281 NIL)
282
283 this is all turned into a UnCommon Web presentation at
284 runtime using MAKE-PRESENTATION, for example, the
285 following code should be enough to show what's built so
286 far attached to the examples application:
287
288 > (defcomponent lol-example (window-component)
289
290 ())
291
292 > (defmethod render-on ((res response) (lol-example lol-example))
293
294 (<:h1 "User")
295
296 (<ucw:render-component :component
297 (lisp-on-lines::make-presentation user :type :viewer)))
298
299 > (defentry-point "lol.ucw" (:application
300 *example-application*) ()
301
302 (call 'lol-example))
303
304 As you'll see, nothing is exported from the
305 LISP-ON-LINES package. If you wish to use LOL in your
306 own package (or in UCW-USER or whatever), you simply
307 need to use the MEWA and META-MODEL packages.
308
309 SET-ATTRIBUTE can be used in place of (setf
310 (find-attribute ...)) when you want to "inherit" the
311 properties of an existing attribute definition :
312
313 LISP-ON-LINES> (set-attribute 'user 'password '(string
314 :label "password: (must be at least 8 chars)"))
315
316 (PASSWORD STRING
317
318 :LABEL
319
320 "password: (must be at leat 8 chars)"
321
322 :SLOT-NAME
323
324 PASSWORD)
325
326 Now we want to create a presentation with which to edit
327 the username. we will use the existing attributes on a
328 subclass of mewa-object-presetation :
329
330 > (defcomponent user-editor (mewa-object-presentation)
331
332 ()
333
334 (:default-initargs
335
336 :attributes '((username :label "Enter your New
337 Username") password)
338
339 :global-properties '(:editablep t)))
340
341 USER-EDITOR
342
343 LISP-ON-LINES> (setf (find-attribute 'user :editor)
344 '(user-editor))
345
346 (:EDITOR USER-EDITOR)
347
348 which we then can display below our earlier example :
349
350 (defmethod render-on ((res response) (e presentations-index))
351
352 "
353
354 As you'll see, nothing is exported from the
355 LISP-ON-LINES package.
356
357 if you wish to use LOL in your own package (or in
358 UCW-USER or whatever),
359
360 you simply need to use the MEWA and META-MODEL
361 packages"
362
363 (<ucw:render-component :component
364 (lisp-on-lines::make-presentation lisp-on-lines::user
365 :type :viewer))
366
367 (<ucw:render-component :component
368 (lisp-on-lines::make-presentation lisp-on-lines::user
369 :type :editor)))
370
371 that should give you some idea on how it works .. ask
372 me when you get confused :)
373
374 4 Pupeno's Example
375
376 This is Pupeno's view of how to do rapid developing of
377 a database-driven web application. It currently is
378 going to assume a very specific case but latter it may
379 be made bigger.
380
381 We first start with a PostgreSQL connection of CLSQL
382 which is set up with one line:
383
384 > (clsql:connect '("localhost" "geo" "geo" "geogeo"))
385
386 which connect us to the server on localhost, to the
387 database geo as user "geo" with password "geogeo" (this is
388 not a smart way to generate password, don't do this).
389 To have a nice SQL environment, we also want:
390
391 > (clsql:locally-enable-sql-reader-syntax)
392
393 > (setf clsql:*default-caching* nil)
394
395 Actually, it is more than a nice environmnet, without
396 those lines the rest of the code won't work.
397
398 On the geo database, there's a table called product
399 which has the following structure:
400
401 CREATE TABLE product (
402
403 id serial NOT NULL,
404
405 name text NOT NULL,
406
407 details text,
408
409 description text,
410
411 cost double precision,
412
413 CONSTRAINT product_cost_check CHECK ((cost >
414 (0)::double precision))
415
416 );
417
418 ALTER TABLE ONLY product ADD CONSTRAINT
419 product_name_key UNIQUE (name);
420
421 ALTER TABLE ONLY product ADD CONSTRAINT product_pkey
422 PRIMARY KEY (id);
423
424 ToDo: express the table structure in a better way.
425
426 Now we'll create the class that represents a product,
427 mirroring the database structure:
428
429 > (lisp-on-lines::def-view-class/table "product")
430
431 and then we generate the default attributes (from
432 product's slots) and assign it to product:
433
434 > (lisp-on-lines::set-default-attributes (make-instance
435 'product))set-default-attributes is marked to be renamed to
436 set-generated-attributes.
437
438 As you can see, we instantiate product to pass it to
439 set-default-attributes, because it expects an object
440 instead of a class. We don't need the object anymore,
441 so we don't save any reference to it. In the future we
442 might have a set-default-attributes that can use a
443 class directly. Now we set a the attribute :viewer to
444 contain the mewa-object-presentation exposing the
445 attributes we like the user to work with:
446
447 > (setf (lisp-on-lines::find-attribute (make-instance
448 'product) :viewer)
449
450 '(lisp-on-lines::mewa-object-presentation
451
452 :attributes (name details description cost)
453
454 :global-properties (:editablep nil)))
455
456 The last parameter is a list of properties that will be
457 applied to each attribute.
458
459 5 Yet Another Example .
460
461 Drew Crampsie Posted the following to comp.lang.lisp ..
462 it just might help until he writes some real
463 documentation.
464
465 I've written a system that generates presentations for
466 database objects based on the type and relation
467 information in the system catalog. Its based on MewaMewa : Meta-level Architecture for Generic
468 Web-Application Construction
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485 http://map1.squeakfoundation.org/sm/package/32c5401f-fa30-4a2b-80c8-1006dd462859
486 clsql + postgres and the UCW presentation components.
487
488 This is the code to add a new contact to the system.
489 (screenshot pr0n follows).
490
491 In the RENDER-ON method of my front-page i have :
492
493
494
495 (let ((p (make-instance 'person :person-type-code nil)))
496
497 (<:as-html "Add Person :")
498
499 (<ucw:render-component
500
501 :component (make-presentation
502
503 p
504
505 :type :one-line
506
507 :initargs '(:attributes
508
509 ((person-type-code
510 :editablep t)))))
511
512 (<ucw:submit :action (new-person self p) :value "add"))
513
514
515
516
517
518 This creates a drop-down list of person-types and an
519 "add" button which calls NEW-PERSON :
520
521 (defaction new-person ((self component) person)
522
523 "
524
525 Take a PERSON with a user-defined PERSON-TYPE-CODE,
526
527 * Prompt the user for a FIRST-NAME, LAST-NAME and/or
528 COMPANY-NAME
529
530 * Search for similar PERSONs in the database.
531
532 * If they exist, ask the user to select one or continue
533
534 * otherwise, just continue editing the person"
535
536 (let ((named-person
537
538 (call-component self (make-presentation
539
540 person
541
542 :type 'new-person
543
544 :initargs '(:global-properties
545
546 (:size 25
547 :editablep t))))))
548
549 (when named-person
550
551 (call-component self (make-presentation
552
553
554 (find-or-return-named-person self named-person)
555
556 :type :editor)))))
557
558
559
560 (defaction find-or-return-named-person ((self
561 component) person)
562
563 "
564
565 If any similiar contacts exist in the database,
566
567 select one or continue with the current person
568
569 PERSON must have FIRST-NAME, LAST-NAME and COMPANY-NAME bound."
570
571 (let ((instances (sql-word-search person 'first-name
572 'last-name 'company-name)))
573
574 (if instances
575
576 (call-component self (make-presentation
577
578 person
579
580 :type 'person-chooser
581
582 :initargs
583
584 `(:instances ,instances)))
585
586 person)))
587
588 You can hardly tell it's a web application ... there is
589 no checking of CGI params etc... just nice code in the
590 order i wanted to write it.
591
592 Screenshots :
593
594 * http://tech.coop/img/screenshots/select-person-type.jpg
595
596 * http://tech.coop/img/screenshots/enter-person-name.jpg
597
598 * http://tech.coop/img/screenshots/select-similar-contacts.jpg
599
600 * http://tech.coop/img/screenshots/edit-person-details.jpg
601
602 * http://tech.coop/img/screenshots/view-recent-changes.jpg
603
604 All of the code used to create the presentations for
605 this is below my sig. I do eventually plan to release
606 the presentation system as Free Software, it just needs
607 a little cleaning up. E-mail me for a sneak peak.
608
609 --
610
611 Drew Crampsie
612
613 drewc at tech dot coop
614
615 "Never mind the bollocks -- here's the sexp's tools."
616
617 -- Karl A. Krueger on comp.lang.lisp
618
619
620
621 (def-view-class/table "person")
622
623
624
625 (set-default-attributes (make-instance 'person)
626
627
628
629 (defcomponent person-display (mewa::two-column-presentation)
630
631 ())
632
633
634
635 (defcomponent one-line-person (mewa::mewa-one-line-presentation)
636
637 ()
638
639 (:default-initargs :attributes '(first-name last-name
640 company-name)))
641
642
643
644 (setf (find-attribute 'person :one-line) '(one-line-person))
645
646
647
648 (set-attribute 'person 'person-type-code '(code-select
649 :category 1))
650
651
652
653 (set-attribute 'person 'province-state-code
654 '(code-select :category 2))
655
656
657
658 (setf (find-attribute 'person :viewer) '(person-display
659 :global-properties (:editablep nil)))
660
661
662
663 (set-attribute 'person :editor '(person-display
664 :global-properties (:editablep t)))
665
666
667
668 (setf (find-attribute 'person 'claim->adjuster-id)
669 '(ucw::has-very-many :label "Claims as Adjuster"
670 :slot-name claim->adjuster-id ) )
671
672
673
674 (set-attribute 'person 'policy->agent-id
675 '(ucw::has-very-many :label "Policies as Agent"))
676
677
678
679 (defcomponent new-person (person-display)
680
681 ()
682
683 (:default-initargs
684
685 :attributes '(first-name last-name company-name)))
686
687
688
689 (defcomponent person-chooser (mewa::mewa-list-presentation)
690
691 ()
692
693 (:default-initargs
694
695 :attributes '(first-name
696
697 last-name
698
699 company-name
700
701 address
702
703 city
704
705 person-type-code)
706
707 :global-properties '(:editablep nil)
708
709 :editablep nil
710
711 :deleteablep nil))
712
713
714
715 (defmethod render-on :wrapping ((res response) (self
716 person-chooser))
717
718 (<:p (<:as-html "Similar contact(s) in database. You
719 can :")
720
721 (<:ul
722
723 (<:li (<:as-html "Select one of the contacts below"))
724
725 (<:li (<ucw:a :action (answer (instance self))
726
727 (<:as-html "Continue, adding a
728 new contact")))))
729
730 (call-next-method))
731
732
733
734 (defaction ok ((self new-person) &optional arg)
735
736 (declare (ignore arg))
737
738 (answer (instance self)))
739
740
741
742 (defmethod sql-word-search ((instance
743 standard-db-object) &rest slots)
744
745 (let ((names
746
747 (loop for slot in slots
748
749 nconc (split-sequence #\Space
750 (slot-value instance slot)))))
751
752 (select (class-name (class-of instance))
753
754 :where (sql-or (mapcar #'(lambda (x)
755
756 (when (< 0
757 (length x))
758
759 (apply #'sql-or
760
761
762 (mapcar #'(lambda (y)
763
764
765 (sql-uplike
766
767 (sql-slot-value 'person y)
768
769
770 (format nil "%~a%" x)))
771
772
773 slots))))
774
775 names))
776
777 :flatp t)))