@@ -1,3 +1,12 @@

+(defpackage :objc-runtime.data-extractors

+  (:use :cl )

+  (:export

+   #:extract-from-objc

+   #:define-extractor

+   #:clear-extractors

+   #:add-extractor

+   #:get-plist))

+

 (in-package :objc-runtime.data-extractors)

 (named-readtables:in-readtable :objc-readtable)

@@ -35,7 +44,7 @@

     (mapcar (serapeum:op

               `(if (objc-isa ,obj ,(car _1))

                    (progn ,@(cdr _1))))

-            cases)))

+                   cases)))

 (defmacro objc-typecase (form &body ((case-type &body case-handler) &rest cases))

   (alexandria:once-only (form)

@@ -66,33 +75,14 @@

         (t (format t "~&other... ~s~%" (objc-runtime::objc-class-get-name

                                         (objc-runtime::object-get-class obj))))))))

-(defvar *objc-extractors* (list)

-  "Functions called to extract specific data types")

-

-(serapeum:eval-always

-  (defun add-extractor (class cb)

-    (unless (member class *objc-extractors* :test 'cffi:pointer-eq :key #'car)

-      (setf *objc-extractors*

-            (merge 'list *objc-extractors* (list (cons class cb))

-                   'objc-subclass-p

-                   :key 'car)))

-    *objc-extractors*))

-

-(defmacro define-extractor (class (o) &body body)

-  `(serapeum:eval-always

-     (add-extractor ,class

-                    (lambda (,o)

-                      ,@body))

-     *objc-extractors*))

-

-(defun clear-extractors ()

-  (setf *objc-extractors* ()))

-

 (defmacro funcall-some (fun &rest args)

   (alexandria:once-only (fun)

     `(if ,fun

          (funcall ,fun ,@args))))

+(defvar *objc-extractors* (list)

+  "Functions called to extract specific data types")

+

 (defun extract-from-objc (obj)

   (objc-typecase obj

     (#@NSDate [[[[#@NSISO8601DateFormatter @(alloc)]

@@ -110,3 +100,22 @@

     (t (or (funcall-some (cdr (objc-pick-by-type obj *objc-extractors*))

                          obj)

            obj))))

+

+(defmacro define-extractor (class (o) &body body)

+  `(serapeum:eval-always

+     (add-extractor ,class

+                    (lambda (,o)

+                      ,@body))

+     *objc-extractors*))

+

+(defun clear-extractors ()

+  (setf *objc-extractors* ()))

+

+(serapeum:eval-always

+  (defun add-extractor (class cb)

+    (unless (member class *objc-extractors* :test 'cffi:pointer-eq :key #'car)

+      (setf *objc-extractors*

+            (merge 'list *objc-extractors* (list (cons class cb))

+                   'objc-subclass-p

+                   :key 'car)))

+    *objc-extractors*))

@@ -15,50 +15,28 @@

   (make-org-file *standard-output*

                  (translate-plist (get-bookmark-filename))))

-(defparameter *reading-list-location* "Library/Safari/Bookmarks.plist")

-(defun get-bookmark-filename ()

-  (merge-pathnames *reading-list-location*

-                   (truename "~/")))

-

-(defun translate-plist (fn)

-  (objc-runtime.data-extractors:extract-from-objc

-   (objc-runtime.data-extractors:get-plist fn)))

-

 (defun make-org-file (s bookmarks)

   (format s "~&* Safari Reading List~%")

   (serapeum:mapply (serapeum:partial 'make-org-entry s)

                    (get-readinglist-info bookmarks)))

-

 (defun make-org-entry (s title url preview tag)

   (format s "~&** ~a :~{~a:~}~% ~a~2% ~{~<~% ~1,80:;~a~> ~}~%"

           title (alexandria:ensure-list tag)

           url

           (serapeum:tokens preview)))

-

 (defun get-readinglist-info (bookmarks)

-  (mapcar (serapeum:juxt

-           (fw.lu:op

-             (fw.lu:pick '("URIDictionary" "title")

-                         _))

-           (fw.lu:op

-             (fw.lu:pick '("URLString")

-                         _))

-           (fw.lu:op

-             (plump:decode-entities

-              (coerce (fw.lu:pick '("ReadingList" "PreviewText")

-                                  _)

-                      'simple-string)

-              t))

-           (fw.lu:op

-             (fw.lu:may

-               (slugify

-                (fw.lu:pick '("ReadingListNonSync" "siteName")

-                            _)))))

+  (mapcar 'extract-link-info

           (gethash "Children"

                    (car

                     (select-child bookmarks

                                   "com.apple.ReadingList")))))

+(defun extract-link-info (link)

+  (list (fw.lu:pick '("URIDictionary" "title") link)

+        (fw.lu:pick '("URLString") link)

+        (plump:decode-entities (coerce (fw.lu:pick '("ReadingList" "PreviewText") link) 'simple-string) t)

+        (fw.lu:may (slugify (fw.lu:pick '("ReadingListNonSync" "siteName") link)))))

+

 (defun slugify (s)

   (cl-ppcre:regex-replace-all "\\s+"

                               (string-downcase s)