#lang racket/base

(require setup/getinfo
         racket/string
         )

(provide info-version
         set-info-version!
         git-next-version
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read a package version from info.rkt.
; pre    : dir contains a readable info.rkt.
; post   : info.rkt has only been inspected.
; result : A list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (info-version dir)
  (let* ((l (get-info/full dir))
         (re #px"([0-9]+)[.]([0-9]+)([.]([0-9]+))?")
         (v (with-handlers ([exn:fail?
                             (λ (e) "0.1")])
              (l 'version)))
         (m (regexp-match re v))
         )
    (map string->number
         (list (cadr m) (caddr m) (if (eq? (cadddr (cdr m)) #f)
                                      "0"
                                      (cadddr (cdr m)))))
    ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Store a package version in info.rkt.
; pre    : dir contains info.rkt and version parts are numbers.
; post   : The version definition has been replaced.
; result : #t after writing the file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (set-info-version! dir maj min patch)
  
  (define (write-version fh)
    (let ((str (if (= patch 0)
                   (format "(define version \"~a.~a\")" maj min)
                   (format "(define version \"~a.~a.~a\")" maj min patch))))
      (unless (eq? fh #f)
        (displayln str fh))
      str))

  (let ((info-file (build-path dir "info.rkt")))
    (unless (file-exists? info-file)
      (error (format "No info.rkt exists at ~a" info-file)))
    
    (let ((fh (open-input-file info-file)))
      (letrec ((reader (λ ()
                         (let ((line (read-line fh)))
                           (if (eof-object? line)
                               '()
                               (cons line (reader)))))))
        (let* ((text (string-join (reader) "\n")))
          (close-input-port fh)
          (let* ((re #px"[(]define\\s+version\\s+[\"][^\"]+[\"]\\s*[)]")
                 (ntext (regexp-replace re text (write-version #f)))
                 (fout (open-output-file info-file #:exists 'replace))
                 )
            (display ntext fout)
            (close-output-port fout)
            #t)))))
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Increment a package version.
; pre    : kind is maj, major, min, minor or patch.
; post   : The version definition in info.rkt has been updated.
; result : #t after writing the new version.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-next-version kind . dir*)
  (let ((dir (if (null? dir*)
                 "."
                 (car dir*))))
    (if (memq kind '(maj major min minor patch))
        (let ((v (info-version dir)))
          (cond
            ((or (eq? kind 'maj)
                 (eq? kind 'major))
             (apply set-info-version! (cons dir
                                            (list (+ (car v) 1) 0 0))))
            ((or (eq? kind 'min)
                 (eq? kind 'minor))
             (apply set-info-version! (cons dir
                                            (list (car v) (+ (cadr v) 1) 0))))
            (else
             (apply set-info-version! (cons dir
                                            (list (car v) (cadr v)
                                                  (+ (caddr v) 1)))))
            )
          )
        (error "kind must be 'maj, 'major, 'min, 'minor or 'patch")
        )
    )
  )