Changeset 306 for branches/new-datamodel/src/model

Timestamp:

06/27/10 11:30:32 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: fixed bugs in get-latest-topic-by-psi, find-all-associations-for-topic, find-associations-for-topic, changed-p, with-tm; adapted the json-unit-tests to the new datamodel

Location:

branches/new-datamodel/src/model

Files:

• changes.lisp (modified) (6 diffs)
• datamodel.lisp (modified) (2 diffs)

branches/new-datamodel/src/model/changes.lisp ¶

@@ -29 +29 @@
        (tops-and-assocs (when tm (union (topics tm) (associations tm))))
        (revision-set nil))
-    ;(format t "tops-and-assocs: ~a~&" (mapcan #'versions tops-and-assocs))
     (dolist (vi (mapcan #'versions tops-and-assocs))
-      ;(format t "(start-revision vi): ~a~&" (start-revision vi))
       (pushnew (start-revision vi) revision-set))
     (sort revision-set #'<)))
 
 
-(defun find-all-associations-for-topic (top &key (revision *TM-REVISION*))
-  "Finds all associations for a topic."
-  (remove-duplicates 
-   (map 'list #'(lambda(role)
-                  (parent role :revision revision))
-        (player-in-roles top :revision revision))))
-
-
-(defun find-associations-for-topic (top &key (revision *TM-REVISION*))
-  "Finds all associations of this topic except type-instance-associations."
-  (let
-      ((type-instance-topic
-        (d:identified-construct
-         (elephant:get-instance-by-value 'PersistentIdC
-                                         'uri
-                                         constants:*type-instance-psi*))))
-    (remove-if
-     #'(lambda(assoc)
-         (when (eql (instance-of assoc :revision revision)
-                    type-instance-topic)
-           t))
-     (find-all-associations-for-topic top :revision revision))))
+(defgeneric find-all-associations (instance &key revision)
+  (:documentation "Finds all associations for a topic.")
+  (:method ((instance TopicC) &key (revision *TM-REVISION*))
+    (declare (type (or integer null) revision))
+    (remove-duplicates 
+     (map 'list #'(lambda(role)
+                    (parent role :revision revision))
+          (player-in-roles instance :revision revision)))))
+
+
+(defgeneric find-associations (instance &key revision)
+  (:documentation "Finds all associations of this topic except
+                   type-instance-associations.")
+  (:method ((instance TopicC) &key (revision *TM-REVISION*))
+    (declare (type (or integer null) revision))
+    (let ((type-instance-topic
+           (d:identified-construct
+            (elephant:get-instance-by-value
+             'PersistentIdC 'uri *type-instance-psi*))))
+      (remove-if
+       #'(lambda(assoc)
+           (eql (instance-of assoc :revision revision)
+                type-instance-topic))
+       (find-all-associations instance :revision revision)))))
   
 
@@ -128 +128 @@
      (mapcan #'(lambda(assoc)
                  (find-referenced-topics assoc :revision revision))
-             (find-associations-for-topic top :revision revision))))))
+             (find-associations top :revision revision))))))
    
 
@@ -155 +155 @@
         (remove-if-not
          (lambda (association)
-           (eq (player (first (roles association)))
+           (eq (player (first (roles association :revision revision))
+                       :revision revision)
                topic))
-         (find-associations-for-topic topic)))
+         (find-associations topic :revision revision)))
        (all-constructs
         (union
-         (get-all-identifiers-of-construct topic)
+         (get-all-identifiers-of-construct topic :revision revision)
          (union 
-          (names topic)
+          (names topic :revision revision)
           (union
-           (occurrences topic)
+           (occurrences topic :revision revision)
            first-player-in-associations)))))
     (some
@@ -217 +218 @@
         (remove 
          nil 
-         (map 'list 
-              (lambda (top)
-                (when (changed-p top revision)
-                  (make-instance 'FragmentC
-                                 :revision revision
-                                 :associations (find-associations-for-topic top :revision revision) ;TODO: this quite probably introduces code duplication with query: Check!
-                                 :referenced-topics (find-referenced-topics top :revision revision)
-                                 :topic top)))
-              (get-all-topics revision))))))
+         (map
+          'list 
+          (lambda (top)
+            (when (changed-p top revision)
+              (make-instance 'FragmentC
+                             :revision revision
+                             :associations (find-associations
+                                            top :revision revision)
+                                        ;TODO: this quite probably introduces
+                                        ;code duplication with query: Check!
+                             :referenced-topics (find-referenced-topics
+                                                 top :revision revision)
+                             :topic top)))
+          (get-all-topics revision))))))
 
 (defun get-fragment (unique-id)
@@ -257 +263 @@
   ;do not need to add an extra item identifier to them. However, we
   ;need to do that for all their characteristics + associations
-  (mapc (lambda (name) (add-source-locator name :revision revision :source-locator source-locator))
+  (mapc (lambda (name)
+          (add-source-locator name :revision revision
+                              :source-locator source-locator))
         (names top :revision revision))
-  (mapc (lambda (occ) (add-source-locator occ :revision revision :source-locator source-locator))
+  (mapc (lambda (occ)
+          (add-source-locator occ :revision revision
+                              :source-locator source-locator))
         (occurrences top :revision revision))
-  (mapc (lambda (ass) (add-source-locator ass :revision revision :source-locator source-locator))
-        (find-associations-for-topic top :revision revision)))
+  (mapc (lambda (ass)
+          (add-source-locator ass :revision revision
+                              :source-locator source-locator))
+        (find-associations top :revision revision)))
 
 
@@ -285 +297 @@
               (make-instance 'FragmentC
                              :revision start-revision
-                             :associations (find-associations-for-topic topic)
-                             :referenced-topics (find-referenced-topics topic)
+                             :associations (find-associations
+                                            topic :revision start-revision)
+                             :referenced-topics (find-referenced-topics
+                                                 topic :revision start-revision)
                              :topic topic)))))))
 

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -686 +686 @@
            (get-most-recent-versioned-assoc
             psi-inst 'identified-construct)))
-      (when latest-va
+      (when (and latest-va (versions latest-va))
         (identified-construct
-         psi-inst :revision (start-revision latest-va))))))
+         psi-inst :revision (start-revision (first (versions latest-va))))))))
 
 
@@ -1501 +1501 @@
     (mapc (lambda (ass) (mark-as-deleted ass :revision revision
                                          :source-locator source-locator))
-          (find-all-associations-for-topic top :revision 0))
+          (find-all-associations top :revision 0))
     (call-next-method)))