Archive emails from outlook

archive-email.rkt

#lang racket/base

(require ffi/unsafe
         ffi/unsafe/objc
         ffi/unsafe/nsstring
         gregor
         racket/match
         racket/sequence
         threading)

;; Get started by loading the Cocoa scripting bridge bundle.
(import-class NSBundle)

(define sb-bundle
  (tell NSBundle
        bundleWithPath:
        #:type _NSString
        "/System/Library/Frameworks/ScriptingBridge.framework"))

(unless (tell #:type _BOOL sb-bundle load)
  (error "failed to load Cocoa scripting bridge"))

;; Now import the scripting bridge class and connect to the target
(import-class SBApplication)

;; osascript -e 'id of app "Microsoft Outlook"'
(define outlook
  (tell SBApplication
        applicationWithBundleIdentifier:
        #:type _NSString "com.microsoft.Outlook"))

;; XXX: actually general enough for any NSArray
(define (in-messages msgs)
  (define count (tell #:type _uint64 msgs count))
  (define (at i)
    (tell msgs objectAtIndex: #:type _uint64 i))
  (sequence-map at (in-range 0 count)))

(match-define
  (vector archive-folder
          archive-path)
  (current-command-line-arguments))

(define archive-filename
  (build-path archive-path
              (~t (today) "yyyy'_'MM'_'dd'.mbox'")))

(define the-messages
  (~> (tell outlook defaultAccount)
      (tell mailFolders)
      (tell objectWithName:
            #:type _NSString
            archive-folder)
      (tell messages)))

;; this is not quite mbox, but mbox enough
;; using '\r' as line ending and the dummy 'From ' line to match
;; older archives
(call-with-output-file archive-filename
  #:exists 'replace
  (lambda (outp)
    (for ([msg (in-messages the-messages)])
      (displayln (tell #:type _NSString msg subject))
      (define contents (tell #:type _NSString msg source))
      (write-string "From ???@???\r" outp)
      (write-string contents outp)
      (write-string "\r" outp))))