;; disfluid, implementation of the Solid specification
;; Copyright (C) 2021  Vivien Kraus

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(define-module (webid-oidc client gui application)
  #:use-module (gi)
  #:use-module (gi types)
  #:use-module (gi util)
  #:use-module (ice-9 match)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 i18n)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 pretty-print)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-19)
  #:use-module (webid-oidc errors)
  #:use-module (webid-oidc web-i18n)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module ((webid-oidc stubs) #:prefix stubs:)
  #:use-module ((webid-oidc oidc-id-token) #:prefix id:)
  #:use-module ((webid-oidc jwk) #:prefix jwk:)
  #:use-module ((webid-oidc dpop-proof) #:prefix dpop:)
  #:use-module (webid-oidc client)
  #:use-module (webid-oidc client accounts)
  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
  #:use-module ((webid-oidc client gui client-widget) #:prefix client:)
  #:use-module ((webid-oidc client gui accounts-widget) #:prefix accounts:)
  #:use-module ((webid-oidc client gui authorizations-widget) #:prefix authorizations:)
  #:use-module (webid-oidc client gui application-hooks)
  #:use-module (webid-oidc client application)
  #:use-module (web uri)
  #:use-module (web response)
  #:use-module (rnrs bytevectors)
  #:use-module (oop goops)
  #:declarative? #t
  #:duplicates (merge-generics)
  #:export
  (
   application
   ))

(push-duplicate-handler! 'merge-generics)

;; This avoids a crash when compiling the module
(use-typelibs ("GdkPixbuf" "2.0"))

(use-typelibs (("Gio" "2.0") #:renamer (protect 'application:new))
              ("Gtk" "3.0")
              ("GLib" "2.0"))

(define gi:connect
  (@ (gi) connect))

(define goops:make
  (@ (oop goops) make))

(define gi:make
  (@ (gi) make))

(define application
  (application:new
   "eu.planete_kraus.Disfluid"
   (list->application-flags '(flags-none))))

(define app:client
  (@ (webid-oidc client application) client))

(define-method (->widget (application <application-state>))
  (let ((content (box:new (symbol->orientation 'horizontal) 12)))
    (call-with-values
        (lambda ()
          (client:->widget (app:client application)))
      (lambda (client-builder client)
        (call-with-values
            (lambda ()
              (accounts:->widget application))
          (lambda (accounts-builder accounts)
            (call-with-values
                (lambda ()
                  (authorizations:->widget application))
              (lambda (authorizations-builder authorizations)
                (box:pack-start content client #t #t 0)
                (box:pack-start content accounts #t #t 0)
                (box:pack-start content authorizations #t #t 0)
                (values
                 `(,client-builder ,accounts-builder ,authorizations-builder)
                 content)))))))))

(define main-window #f)

(define current-state #f)
(define current-state-widget #f)
(define additional-gc-roots '())

(define-method (set-state! (state <application-state>))
  (when (and main-window current-state-widget)
    (remove main-window current-state-widget))
  (set! current-state state)
  (call-with-values
      (lambda ()
        (->widget state))
    (lambda (roots widget)
      (set! current-state-widget widget)
      (set! additional-gc-roots roots)))
  (when main-window
    (add main-window current-state-widget)
    (show-all main-window)))

(define (on-activate application)
  (set! main-window
    (gi:make <GtkApplicationWindow>
      #:application application))
  (add-hook! application-state-changed-hook set-state! #t)
  (run-hook application-activated-hook application))

(gi:connect application activate on-activate)