Stephen Compall avatar Stephen Compall committed c44069e

get-object-view-fields: split into multiple functions, convert part of internals to streaming process

Comments (0)

Files changed (1)

src/views/view/utils.lisp

 if it was mixed into the view."
   field object parent-info)
 
+(defun factor-overriden-fields (field-info-list)
+  "Overrides parent fields redefined in children."
+  ;; XXX this is quite inefficient (at least n^2 + n*log(n))
+  #+lp-view-field-debug
+  (format t "fil: ~S~%" field-info-list)
+  (labels ((field-key (field-info)
+	     (cons (view-field-slot-name (field-info-field field-info))
+		   (awhen (parent field-info)
+		     (view-field-slot-name (field-info-field IT)))))
+	   (parent (field-info)
+	     (field-info-parent-info field-info))
+	   (mixin-p (field-info)
+	     (typep (field-info-field field-info) 'mixin-view-field)))
+    #+lp-view-field-debug
+    (format t "in: ~S~%" (mapcar (compose #'describe #'field-info-field) field-info-list))
+    (let* ((fields (remove-duplicates field-info-list :key #'field-key :from-end nil))
+	   (true-inline-fields
+	    (remove-if (disjoin #'parent #'mixin-p)
+		       (remove-duplicates fields :test #'equal
+					  :key (compose #'view-field-slot-name
+							#'field-info-field))
+		       :from-end t))
+	   (expanded-mixin-fields
+	    (remove-if (curry-after #'find true-inline-fields
+				    :test #'equal :key (compose #'view-field-slot-name
+								#'field-info-field))
+		       (remove-duplicates (remove-if-not (disjoin #'parent #'mixin-p)
+							 fields)
+					  :test #'equal :key #'field-key)))
+	   (merged-fields
+	    (sort (union true-inline-fields expanded-mixin-fields)
+		  #'< :key (lambda (field)
+			     (flet ((pos (field where)
+				      (let ((r (position (field-key field) where
+							 :key #'field-key :test #'equal)))
+					#+lp-view-field-debug
+					(format t "field: ~S / where: ~S -> ~S%" (field-key field)
+					        (mapcar #'field-key where) r)
+					r)))
+			       (let ((result (or (pos field fields)
+						 (pos field true-inline-fields)
+						 (pos field expanded-mixin-fields)
+						 0)))
+				 #+lp-view-field-debug
+				 (format t "result for field ~A: ~A~%" field result)
+				 result))))))
+      #+lp-view-field-debug
+      (progn
+	(format t "true inline: ~S~%" (mapcar #'field-key true-inline-fields))
+	(format t "expanded ~S~%" (mapcar #'field-key expanded-mixin-fields))
+	(format t "fields ~S~%" (mapcar #'field-key fields))
+	(format t "merged ~S~%" (mapcar (compose #'describe #'field-info-field) merged-fields)))
+      merged-fields)))
+
+(defun map-view-field-info-list (proc view-designator obj parent-field-info)
+  "Walk a full list of view fields, including inherited fields."
+  (let ((view (when view-designator
+		(find-view view-designator))))
+    (when view
+      (map-view-field-info-list proc (view-inherit-from view) obj
+				parent-field-info)
+      (dolist (field (view-fields view))
+	(funcall proc (make-field-info :field field :object obj
+				       :parent-info parent-field-info))))))
+
+(defun map-expanding-mixin-fields (proc field-info-list &optional include-invisible-p)
+  "Expands mixin fields into inline fields. Returns two values - a
+list of expanded field-infos, and true if at least one field has been
+expanded."
+  (labels ((map-emf (field-info)
+	     (let ((field (field-info-field field-info))
+		   (obj (field-info-object field-info)))
+	       (etypecase field
+		 (inline-view-field (funcall proc field-info))
+		 (mixin-view-field
+		    (when (or include-invisible-p
+			      (not (view-field-hide-p field)))
+		      (map-view-field-info-list
+		       #'map-emf
+		       (mixin-view-field-view field)
+		       (when obj
+			 (or (obtain-view-field-value field obj)
+			     (funcall (mixin-view-field-init-form field))))
+		       field-info)))))))
+    (mapc #'map-emf field-info-list)))
+
 (defun get-object-view-fields (obj view-designator &rest args
 			       &key include-invisible-p (expand-mixins t) custom-fields
 			       &allow-other-keys)
 view-field. Field-info structures are inserted as is, and view-fields
 are wrapped in field-info structures with common-sense defaults."
   (declare (ignore args))
-  (labels ((compute-view-field-info-list (view-designator obj parent-field-info)
-	     "Computes a full list of view fields, including inherited
-	     fields. Returns a list of field-infos."
-	     (let ((view (when view-designator
-			   (find-view view-designator))))
-	       (when view
-		 (append (compute-view-field-info-list
-			  (view-inherit-from view) obj
-			  parent-field-info)
-			 (mapcar (lambda (field)
-				   (make-field-info :field field :object obj
-						    :parent-info parent-field-info))
-				 (view-fields view))))))
-	   (factor-overriden-fields (field-info-list)
-	     "Overrides parent fields redefined in children."
-             ;(format t "fil: ~S~%" field-info-list)
-             (flet ((field-key (field-info &aux (field (field-info-field field-info)))
-                      (cons (view-field-slot-name field) (awhen (field-info-parent-info field-info)
-                                                              (view-field-slot-name (field-info-field IT)))))
-                    (parent (field-info &aux (field (field-info-field field-info)))
-                      (field-info-parent-info field-info))
-                    (mixin-p (field-info &aux (field (field-info-field field-info)))
-                      (typep field 'mixin-view-field)))
-               ;(format t "in: ~S~%" (mapcar (compose #'describe #'field-info-field) field-info-list))
-               (let* ((fields (remove-duplicates field-info-list :key #'field-key :from-end nil))
-                      (true-inline-fields (remove-duplicates fields :test #'equal
-                                                             :key (compose #'view-field-slot-name #'field-info-field)
-                                                             :from-end nil))
-                      (true-inline-fields (remove-if (lambda (fi) (or (parent fi) (mixin-p fi))) true-inline-fields
-                                                     :from-end t))
-                      (expanded-mixin-fields (remove-if-not (lambda (fi) (or (parent fi) (mixin-p fi)))
-                                                            fields))
-                      (expanded-mixin-fields (remove-duplicates expanded-mixin-fields :test #'equal :key #'field-key))
-                      (expanded-mixin-fields (remove-if (curry-after #'find true-inline-fields
-                                                                     :test #'equal :key (compose #'view-field-slot-name
-                                                                                                 #'field-info-field)
-                                                                     :from-end nil) expanded-mixin-fields))
-                      (merged-fields (sort (union true-inline-fields expanded-mixin-fields)
-                                           #'< :key (lambda (field)
-                                                      (flet ((pos (field where)
-                                                               (let ((r (position (field-key field) where :key #'field-key :test #'equal)))
-                                                               ;(format t "field: ~S / where: ~S -> ~S%" (field-key field)
-                                                               ;        (mapcar #'field-key where) r)
-                                                               r
-                                                               )))
-                                                        (let ((result (or (pos field fields)
-                                                                          (pos field true-inline-fields)
-                                                                          (pos field expanded-mixin-fields)
-                                                                          0)))
-                                                        #+(or)(format t "result for field ~A: ~A~%" field result) result))))))
-                 ;(format t "true inline: ~S~%" (mapcar #'field-key true-inline-fields))
-                 ;(format t "expanded ~S~%" (mapcar #'field-key expanded-mixin-fields))
-                 ;(format t "fields ~S~%" (mapcar #'field-key fields))
-                 ;(format t "merged ~S~%" (mapcar (compose #'describe #'field-info-field) merged-fields))
-                 merged-fields))) ; XXX this is quite inefficient (at least n^2 + n*log(n))
-	   (expand-mixin-fields (field-info-list)
-	     "Expands mixin fields into inline fields. Returns two
-              values - a list of expanded field-infos, and true if at
-              least one field has been expanded."
-	     (apply #'append
-		    (mapcar (lambda (field-info)
-			      (let ((field (field-info-field field-info))
-				    (obj (field-info-object field-info)))
-				(etypecase field
-				  (inline-view-field (list field-info))
-				  (mixin-view-field (when (or include-invisible-p
-							      (not (view-field-hide-p field)))
-						      (compute-view-field-info-list
-						       (mixin-view-field-view field)
-						       (when obj
-							 (or (obtain-view-field-value field obj)
-							     (funcall (mixin-view-field-init-form field))))
-						       field-info))))))
-			    field-info-list)))
-	   (custom-field->field-info (custom-field)
+  (labels ((custom-field->field-info (custom-field)
 	     (etypecase custom-field
 	       (field-info custom-field)
 	       (view-field (make-field-info :field custom-field
 					    :object obj
 					    :parent-info nil)))))
-    (let* ((initial-step (factor-overriden-fields
-			  (compute-view-field-info-list view-designator obj nil)))
-	   (results
-	    (if expand-mixins
-		(loop for field-info-list = initial-step
-		   then (factor-overriden-fields
-			 (expand-mixin-fields field-info-list))
-		   until (notany (lambda (field-info)
-				   (typep (field-info-field field-info) 'mixin-view-field))
-				 field-info-list)
-		   finally (return (if include-invisible-p
-				       field-info-list
-				       (remove-if #'view-field-hide-p field-info-list
-						  :key #'field-info-field))))
-		initial-step)))
+    (let* ((results (factor-overriden-fields
+		     (let ((expansion '()))
+		       (map-view-field-info-list (f_ (push _ expansion))
+						 view-designator obj nil)
+		       (nreverse expansion)))))
+      (when expand-mixins
+	(setf results (factor-overriden-fields
+		       (let ((expansion '()))
+			 (map-expanding-mixin-fields
+			  (f_ (push _ expansion)) results include-invisible-p)
+			 (nreverse expansion)))))
+      (unless include-invisible-p
+	(setf results (remove-if #'view-field-hide-p results
+				 :key #'field-info-field)))
       (dolist (custom-field custom-fields results)
 	(if (consp custom-field)
 	    (insert-at (custom-field->field-info (cdr custom-field)) results (car custom-field))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.