;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix 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 General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-logs)
  #:use-module (guix config)
  #:use-module (guix store)
  #:use-module (srfi srfi-1)
  #:use-module (guix utils)
  #:use-module (ice-9 match)
  #:use-module (ice-9 ftw)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 rdelim)
  #:export (%log-directory
            log-file-build-phases
            log-file-build-time
            estimated-build-time))

(define %log-directory
  (string-append (dirname %state-directory) ; XXX
                 "/log/guix/drvs"))

(define %end-of-phase-rx
  (make-regexp "^phase [`']([[:graph:]]+)' succeeded after ([0-9.]+) seconds$"))

(define (log-file-build-phases file)
  "Interpret the build log in FILE and return an alist of name/duration pairs
for each build phase, such as:

  ((unpack . 1.3) (configure . 4.2) (build . 383.8) …)

Duration is expressed in seconds.  Return the empty list if no build phase
information could be extracted from FILE."
  (define compression
    (cond ((string-suffix? ".gz" file) 'gzip)
          ((string-suffix? ".bz2" file) 'bzip2)
          ((string-suffix? ".xz" file) 'xz)
          (else 'none)))

  (call-with-input-file file
    (lambda (input)
      (call-with-decompressed-port compression input
        (lambda (port)
          (set-port-conversion-strategy! port 'substitute)
          (let loop ((result '()))
            (match (read-line port)
              ((? eof-object?)
               (reverse result))
              (line
               (match (regexp-exec %end-of-phase-rx line)
                 (#f
                  (loop result))
                 (hit
                  (loop (alist-cons (string->symbol
                                     (match:substring hit 1))
                                    (string->number
                                     (match:substring hit 2))
                                    result))))))))))))

(define (log-file-build-time file)
  "Return the total build time described by FILE, a build log, or zero if
build phase information was not found."
  (match (log-file-build-phases file)
    (((names . durations) ...)
     (if (memq 'install names)
         (reduce + 0 durations)
         0))))

(define (matching-log-files package)
  (define noop
    (lambda (file stat result) result))

  (file-system-fold (const #t)
                    (lambda (file stat result)    ;leaf
                      (let* ((base (basename
                                    (file-sans-extension
                                     (file-sans-extension file))))
                             (dash (string-index base #\-))
                             (full (string-drop base (+ dash 1))))
                        (call-with-values
                            (lambda ()
                              (package-name->name+version full #\-))
                          (lambda (p v)
                            (if (and (string=? p package)
                                     (not (string-suffix? ".gz" v))
                                     (not (string-suffix? ".bz2" v))
                                     (not (string-suffix? ".xz" v))
                                     (not (string-suffix? ".lz" v))
                                     (not (string-suffix? ".zip" v)))
                                (cons (list file p v) result)
                                result)))))
                    noop                          ;down
                    noop                          ;up
                    noop                          ;skip
                    (lambda (file stat error result) ;error
                      result)
                    '()
                    %log-directory))



(define %not-dot
  (char-set-complement (char-set #\.)))

(define (version-distance version reference)
  "Compute a super rough estimate of the distance of VERSION to REFERENCE,
both of which being version strings."
  (let* ((reference (string-tokenize reference %not-dot))
         (version   (string-tokenize version %not-dot))
         (len       (length reference)))
    (let loop ((i len)
               (reference reference)
               (version version)
               (distance 0))
      (match version
        (() distance)
        ((head . tail)
         (match reference
           (()
            distance)
           ((ref-head . ref-tail)
            (loop (- i 1) ref-tail tail
                  (if (string=? ref-head head)
                      distance
                      (+ distance i))))))))))

(define (estimated-build-time package version)
  "Return the estimate time it takes to build PACKAGE at VERSION, or #f if no
such estimate is available."
  (let ((logs (sort (matching-log-files package)
                    (match-lambda*
                      (((file1 _ version1) (file2 _ version2))
                       (< (version-distance version1 version)
                          (version-distance version2 version)))))))
    (any (match-lambda
           ((log package version)
            (let ((duration (log-file-build-time log)))
              (and (not (zero? duration))
                   duration))))
         logs)))