;;;
;;; feature-isync.
;;;

(define (prep-str sym str)
  (symbol-append sym '- (string->symbol str)))

(define (isync-channel id local remote)
  `((Channel ,(prep-str id local))
    (Near ,(format #f ":~a-local:~a" id local))
    (Far ,(format #f ":~a-remote:~a" id remote))
    ,#~""))

(define (isync-group-with-channels id isync-mapping)
  (append
   (append-map
    (lambda (x) (isync-channel id (car x) (cdr x)))
    isync-mapping)
   `((Group ,(symbol-append id))
     ,@(map
        (lambda (x) (list 'Channel (prep-str id (car x))))
        isync-mapping)
     ,#~"")))

(define* (generate-isync-serializer
          host folders-mapping
          #:key
          (port #f)
          (auth-mechs #f)
          (subfolders 'Verbatim)
          (cipher-string #f)
          (pipeline-depth #f))
  (ensure-pred symbol? subfolders)

  (define (isync-settings mail-directory mail-account)
    (let* ((id       (mail-account-id mail-account))
           (user     (or (mail-account-user mail-account)
                         (mail-account-fqda mail-account)))
           (pass-cmd (mail-account-get-pass-cmd mail-account)))
      `(,#~(string-append "# Account '" #$(symbol->string id)
                          " starts here")
        (IMAPAccount ,id)
        (Host ,host)
        ,@(if (integer? port) `((Port ,port)) '())
        (User ,user)
        (PassCmd ,pass-cmd)
        ,@(if (symbol? auth-mechs) `((AuthMechs ,auth-mechs)) '())
        (SSLType IMAPS)
        (CertificateFile /etc/ssl/certs/ca-certificates.crt)
        ,@(if (symbol? cipher-string) `((CipherString ,cipher-string)) '())
        ,@(if (integer? pipeline-depth) `((PipelineDepth ,pipeline-depth)) '())
        ,#~""
        (IMAPStore ,(symbol-append id '-remote))
        (Account ,id)
        ,#~""
        (MaildirStore ,(symbol-append id '-local))
        (SubFolders ,subfolders)
        (Path ,(string-append mail-directory "/accounts/" user "/"))
        (Inbox ,(string-append mail-directory "/accounts/" user "/inbox"))
        ,#~""
        ,@(isync-group-with-channels id folders-mapping))))
  isync-settings)

;; Directory names has lowercased spelling to match notmuch tags
(define gmail-folder-mapping
  '(("inbox"   . "INBOX")
    ("sent"    . "[Gmail]/Sent Mail")
    ("drafts"  . "[Gmail]/Drafts")
    ("archive" . "[Gmail]/All Mail")
    ("trash"   . "[Gmail]/Trash")
    ("spam"    . "[Gmail]/Spam")))

(define gandi-folder-mapping
  '(("inbox"   . "INBOX")
    ("sent"    . "Sent")
    ("drafts"  . "Drafts")
    ("archive" . "Archive")
    ("trash"   . "Trash")
    ("spam"    . "Junk")))

(define gmx-fr-folder-mapping
  '(("inbox"   . "INBOX")
    ("sent"    . "Envoy&AOk-s")
    ("drafts"  . "Brouillons")
    ("archive" . "Archive")
    ("trash"   . "Corbeille")
    ("spam"    . "Junk")))

(define outlook-fr-folder-mapping
  '(("inbox"   . "INBOX")
    ("sent"    . "&AMk-l&AOk-ments envoy&AOk-s") ;"Éléments envoyés"
    ("drafts"  . "Brouillons")
    ("archive" . "Notes")
    ("trash"   . "&AMk-l&AOk-ments supprim&AOk-s") ;"Éléments supprimés"
    ("spam"    . "Courrier ind&AOk-sirable"))) ;"Courrier indésirable"

(define mailbox-folder-mapping
  '(("inbox"   . "INBOX")
    ("sent"    . "Sent")
    ("drafts"  . "Drafts")
    ("trash"   . "Trash")
    ("junk"    . "Junk")
    ("archive" . "Archive")))

(define hosteurope-de-folder-mapping
  '(("inbox"   . "INBOX")
    ("sent"    . "Sent")
    ("drafts"  . "Entwurf")
    ("trash"   . "Trash")
    ("spam"    . "Spam")
    ("archive" . "All")))

(define gmx-fr-isync-settings
  (generate-isync-serializer "imap.gmx.net" gmx-fr-folder-mapping))

(define ovh-isync-settings
  (generate-isync-serializer "ssl0.ovh.net" gandi-folder-mapping
                             #:subfolders 'Legacy
                             #:auth-mechs 'LOGIN))

(define gmail-isync-settings
  (generate-isync-serializer "imap.gmail.com" gmail-folder-mapping))

(define gandi-isync-settings
  (generate-isync-serializer "mail.gandi.net" gandi-folder-mapping))

(define mailbox-isync-settings
  (generate-isync-serializer "imap.mailbox.org" mailbox-folder-mapping))

(define hosteurope-de-isync-settings
  (generate-isync-serializer "imap.hosteurope.de" hosteurope-de-folder-mapping))

(define* (get-ovh-pro-isync-settings
          #:key
          (folder-mapping #f)
          (host-number #f))
  (ensure-pred list? folder-mapping)
  (generate-isync-serializer
    (string-append "pro" host-number ".mail.ovh.net")
    folder-mapping
    #:auth-mechs 'LOGIN
    #:subfolders 'Legacy))

(define ovh-pro2-fr-isync-settings
  (get-ovh-pro-isync-settings
   #:host-number "2"
   #:folder-mapping outlook-fr-folder-mapping))

(define (generic-isync-settings mail-directory mail-account)
  (let* ((user     (mail-account-fqda mail-account)))
    `(,#~"# Do not know how to serialize generic accounts :("
      ,#~(format #f "# ~a wasn't configured by rde," #$user)
      ,#~"# Try to set another value for mail-account's type field.")))

(define %default-isync-serializers
  `((gmail . ,gmail-isync-settings)
    (gandi . ,gandi-isync-settings)
    (gmx-fr . ,gmx-fr-isync-settings)
    (ovh . ,ovh-isync-settings)
    (ovh-pro2-fr . ,ovh-pro2-fr-isync-settings)
    (mailbox . ,mailbox-isync-settings)
    (hosteurope-de . ,hosteurope-de-isync-settings)
    (generic . ,generic-isync-settings)))

(define default-isync-global-settings
  `((Create Both)
    (Expunge Both)
    (SyncState *)
    ,#~""))

(define* (feature-isync
          #:key
          (mail-account-ids #f)
          (isync-global-settings default-isync-global-settings)
          (isync-serializers %default-isync-serializers)
          (isync-verbose #f))
  "Setup and configure isync.  If MAIL-ACCOUNT-IDS not provided use all
mail accounts.  ISYNC-VERBOSE controls output verboseness of
@file{mbsync}."
  (ensure-pred maybe-list? mail-account-ids)
  (ensure-pred list? isync-serializers)
  (ensure-pred list? isync-global-settings)

  ;; Sync mail deletion
  ;; https://notmuchmail.org/pipermail/notmuch/2016/023112.html
  ;; http://tiborsimko.org/mbsync-duplicate-uid.html

  ;; https://notmuchmail.org/emacstips/#index25h2

  (define (get-home-services config)
    (require-value 'mail-accounts config
                   "feature-isync can't operate without mail-accounts.")

    (let* ((mail-accounts
            (filter (lambda (x) (eq? (mail-account-synchronizer x) 'isync))
                    (get-value 'mail-accounts config)))
           (mail-directory-fn (get-value 'mail-directory-fn config))
           (mail-directory    (mail-directory-fn config)))

      (define (serialize-mail-acc mail-acc)
        ((assoc-ref isync-serializers (mail-account-type mail-acc))
         mail-directory mail-acc))

      (list
       (simple-service
        'isync-ensure-mail-dirs-exists
        home-activation-service-type
        #~(map mkdir-p
               '#$(map (lambda (acc)
                         (string-append mail-directory "/accounts/"
                                        (mail-account-fqda acc)))
                       mail-accounts)))
       (service
        home-isync-service-type
        (home-isync-configuration
         (config
          (append
           isync-global-settings
           (append-map serialize-mail-acc mail-accounts))))))))

  ;; MAYBE: Wrap it in a program-file to make it possible to call it
  ;; with system*
  (define (isync-synchronize-cmd-fn mail-acc)
    (string-append "mbsync "
                   (if isync-verbose "-V " "")
                   (symbol->string (mail-account-id mail-acc))))

  (feature
   (name 'isync)
   (values `((isync . #t)
             (isync-synchronize-cmd-fn . ,isync-synchronize-cmd-fn)))
   (home-services-getter get-home-services)))