;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; 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 kconfig)
  #:use-module  (ice-9 rdelim)
  #:use-module  (srfi srfi-1)
  #:use-module  (srfi srfi-26)
  #:export (modify-defconfig))

;; Commentary:
;;
;; Builder-side code to modify configurations for the Kconfig build system as
;; used by Linux and U-Boot.
;;
;; Code:

(define (modify-defconfig defconfig configs)
  "This function can modify a given DEFCONFIG file by adding, changing or
removing the list of strings in CONFIGS.  This allows an easy customization of
Kconfig based projects like the kernel Linux or the bootloader 'Das U-Boot'.

These are examples for CONFIGS to add (or change) and remove
configurations to/from DEFCONFIG:

'(\"CONFIG_A=\\\"a\\\"\"
  \"CONFIG_B=0\"
  \"CONFIG_C=y\"
  \"CONFIG_D=m\"
  \"CONFIG_E=\"
  \"CONFIG_F\")"

  (define (config-string->pair config-string)
    "Parse a config-string like \"CONFIG_NET=y\" into a key-value pair.
Spaces get trimmed.
\"CONFIG_EXAMPLE=y\"  -> '(\"CONFIG_EXAMPLE\" . \"y\")
\"CONFIG_EXAMPLE=\\\"\\\"\" -> '(\"CONFIG_EXAMPLE\" . \"\").
\"CONFIG_EXAMPLE=\"  -> '(\"CONFIG_EXAMPLE\" . #f).
\"CONFIG_EXAMPLE\"   -> '(\"CONFIG_EXAMPLE\" . #f)."
    (let ((pair (map string-trim-both (string-split config-string #\=))))
      (case (length pair)
        ((2)
         (cons (string-append (first pair))
               (if (string-null? (second pair))
                   #f
                   (second pair))))
        (else (cons (first pair) #f)))))

  (define (pair->config-string pair)
    "Convert a PAIR back to a config-string."
    (let* ((key (car pair))
           (value (cdr pair)))
      (if value
          (string-append key "=" value)
          key)))

  (define (disable-pair pair blacklist)
    "Turn the key of a key-value PAIR into an disabled key, if listed in
BLACKLIST."
    (let* ((key (car pair)))
      (if (member key blacklist)
          (cons (string-append "# disabled " key)
                (cdr pair))
          pair)))

  (define (disable-config-string config-string blacklist)
    "Turn the CONFIG-STRING into a disabled one, if listed in BLACKLIST."
    (pair->config-string (disable-pair (config-string->pair config-string)
                                       blacklist)))

  (define (unset-pair pair)
    "Turn the key of a key-value PAIR into an unset key, if its value is #f."
    (let* ((key (car pair))
           (value (cdr pair)))
      (if value
          pair
          (cons (string-append "# unset " key) value))))

  (define (unset-config-string config-string)
    "Turn the CONFIG-STRING into a proper unset one, if there is no assignment"
    (pair->config-string (unset-pair (config-string->pair config-string))))

  (define (write-modified-lines input modify-line)
    "Write all lines from the INPUT after applying MODIFY-LINE to the
 current-output-port."
    (let loop ((line (read-line input)))
      (when (not (eof-object? line))
        (display (modify-line line))
        (newline)
        (loop (read-line input)))))

  (let* ((modified-defconfig (string-append defconfig ".mod"))
         ;; Generate a blacklist of config keys from configs.
         (blacklist (map (lambda (config-string)
                           (first (config-string->pair config-string)))
                         configs))
         (disable-config-string (cut disable-config-string <> blacklist)))
    ;; Write to modified-defconfig file first the configs, and second
    ;; the content of the defconfig file with disabled lines.
    (call-with-output-file modified-defconfig
      (lambda (output)
        (with-output-to-port output
          (lambda ()
            (call-with-input-string (string-join configs "\n")
              (lambda (input)
                (write-modified-lines input unset-config-string)))
            (false-if-exception
              (call-with-input-file defconfig
                (lambda (input)
                  (write-modified-lines input disable-config-string))))))))
    ;; Ensure the modified-defconfig file is used.
    (false-if-exception (delete-file defconfig))
    (rename-file modified-defconfig defconfig)))