(module menu racket/base

  (require json
           net/url)
  
  (provide wv-menu
           wv-menu-item
           is-wv-menu?
           wv-menu-set-callback!
           wv-menu-set-icon!
           wv-menu-set-title!
           wv-menu->json
           with-wv-menu-item
           wv-menu-for-each
           wv-menu-item-callback
           wv-menu-item-id
           wv-menu-id
           )


  
  (define-struct ww-menu-item*
    (id [title #:mutable] [icon-url #:mutable] [callback #:mutable] [submenu #:mutable] [separator #:mutable])
    #:transparent)
  
  (define-struct ww-menu*
    (id [items #:mutable])
    #:transparent
    )


  (define (wv-menu-item-callback mi)
    (ww-menu-item*-callback mi))

  (define (wv-menu-item-id mi)
    (ww-menu-item*-id mi))

  (define (wv-menu-id m)
    (ww-menu*-id m))
  
  (define (is-wv-menu? mnu)
    (if (ww-menu*? mnu)
        (if (list? (ww-menu*-items mnu))
            (letrec ((f (lambda (m)
                          (if (null? m)
                              #t
                              (if (ww-menu-item*? (car m))
                                  (if (eq? (ww-menu-item*-submenu (car m)) #f)
                                      (f (cdr m))
                                      (and (is-wv-menu? (ww-menu-item*-submenu (car m)))
                                           (f (cdr m))))
                                  #f)
                              ))
                        ))
              (f (ww-menu*-items mnu)))
            #f)
        #f))

  (define (wv-menu . items)
    (let ((menu-id #f))
      (when (symbol? (car items))
        (set! menu-id (car items))
        (set! items (cdr items)))
      (when (list? (car items))
        (set! items (car items)))
      (make-ww-menu* menu-id items)))

  (define (wv-menu-item id title
                     #:icon-url [icon-url #f]
                     #:callback [callback (lambda args #t)]
                     #:submenu [submenu #f]
                     #:separator [separator #f])
    (unless (symbol? id)
      (error "menu-item needs an id of symbol?"))
    (unless (string? title)
      (error "menu-item needs a title of string?"))
    (unless (or (eq? icon-url #f) (string? icon-url) (url? icon-url))
      (error "menu-item's optional argument icon-file must be #f,  string? or path?"))
    (unless (or (eq? submenu #f) (is-wv-menu? submenu))
      (error "menu-item's optional argument submenu must be #f or is-menu?"))
    (unless (boolean? separator)
      (error "menu-item's optional argument separator must be boolean?"))
    (let ((u (if (url? icon-url) (url->string icon-url) icon-url)))
      (make-ww-menu-item* id title u callback submenu separator))
    )

  (define (wv-menu->hash menu . for-json)
    (let ((fj (if (null? for-json) #f (car for-json))))
      (unless (is-wv-menu? menu)
        (error "menu->hash must be called with a menu"))
      (let* ((items (ww-menu*-items menu))
             (r (map (λ (item)
                       (let ((h (make-hasheq)))
                         (hash-set! h 'id (format "~a" (ww-menu-item*-id item)))
                         (hash-set! h 'name (ww-menu-item*-title item))
                         (unless (eq? (ww-menu-item*-icon-url item) #f)
                           (hash-set! h 'icon (ww-menu-item*-icon-url item)))
                         (unless (eq? (ww-menu-item*-submenu item) #f)
                           (hash-set! h 'submenu (wv-menu->hash (ww-menu-item*-submenu item) fj)))
                         (unless (eq? (ww-menu-item*-separator item) #f)
                           (hash-set! h 'separator #t))
                         h
                         )) items))
             )
        (let ((h (make-hasheq)))
          (hash-set! h 'menu r)
          (hash-set! h 'id (if fj (format "~a" (ww-menu*-id menu)) (ww-menu*-id menu)))
          h))))

  (define (wv-menu-for-each menu cb)
    (let ((items (ww-menu*-items menu)))
      (letrec ((f (λ (items)
                    (if (null? items)
                        #t
                        (let ((item (car items)))
                          (let ((submenu (ww-menu-item*-submenu item)))
                            (if (eq? submenu #f)
                                (cb item)
                                (wv-menu-for-each submenu cb)))
                          (f (cdr items))
                          )
                        )
                    )
                  ))
        (f items))))

  (define (wv-menu->json menu)
    (let ((o (open-output-string)))
      (write-json (wv-menu->hash menu #t) o)
      (get-output-string o)))

  (define (find-wv-menu-item menu id)
    (let ((items (ww-menu*-items menu)))
      (letrec ((f (λ (items)
                    (if (null? items)
                        #f
                        (let ((item (car items)))
                          (if (eq? (ww-menu-item*-id item) id)
                              item
                              (let ((submenu (ww-menu-item*-submenu item)))
                                (if (eq? submenu #f)
                                    (f (cdr items))
                                    (let ((found-item (find-wv-menu-item submenu id)))
                                      (if (eq? found-item #f)
                                          (f (cdr items))
                                          found-item))
                                    ))
                              ))
                        ))
                  ))
        (f items))))

  (define (with-wv-menu-item menu id cb)
    (unless (is-wv-menu? menu)
      (error "menu must be of is-menu?"))
    (unless (symbol? id)
      (error "id must be of symbol?"))
    (let ((item (find-wv-menu-item menu id)))
      (if (eq? item #f)
          (error (format "cannot find id'~a in given menu" id))
          (cb item)))
    menu)
      
  (define (wv-menu-set-title! menu id title)
    (unless (string? title)
      (error "title must be of string?"))
    (with-wv-menu-item menu id
      (λ (item)
        (set-ww-menu-item*-title! item title))))
  
  (define (wv-menu-set-icon! menu id icon-url)
    (unless (or (eq? icon-url #f) (url? icon-url) (string? icon-url))
      (error "title must be of #f, string? or path?"))
    (with-wv-menu-item menu id
      (λ (item)
        (let ((u (if (url? icon-url) (url->string icon-url) icon-url)))
          (set-ww-menu-item*-icon-url! item u)))))

  (define (wv-menu-set-callback! menu id cb)
    (unless (procedure? cb)
      (error "callback must be of procedure?"))
    (with-wv-menu-item menu id
      (λ (item)
        (set-ww-menu-item*-callback! item cb))))
          
  ); end of module