;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@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 (gnu installer newt partition)
  #:use-module (gnu installer parted)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer utils)
  #:use-module (gnu installer newt page)
  #:use-module (gnu installer newt utils)
  #:use-module (guix i18n)
  #:use-module (guix utils)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (newt)
  #:use-module (parted)
  #:export (run-partitioning-page))

(define (button-exit-action)
  "Abort the installer step."
  (abort-to-prompt 'installer-step 'abort))

(define (run-scheme-page)
  "Run a page asking the user for a partitioning scheme."
  (let* ((items
          `((root . ,(G_ "Everything is one partition"))
            (root-home . ,(G_ "Separate /home partition"))))
         (result (run-listbox-selection-page
                  #:info-text (G_ "Please select a partitioning scheme.")
                  #:title (G_ "Partition scheme")
                  #:listbox-items items
                  #:listbox-item->text cdr
                  #:listbox-height 4
                  #:sort-listbox-items? #f       ;keep the 'root' option first
                  #:button-text (G_ "Exit")
                  #:button-callback-procedure button-exit-action)))
    (car result)))

(define (draw-formatting-page partitions)
  "Draw a page asking for confirmation, and then indicating that partitions
are being formatted."
  ;; TRANSLATORS: The ~{ and ~} format specifiers are used to iterate the list
  ;; of device names of the user partitions that will be formatted.
  (run-confirmation-page (format #f (G_ "We are about to write the configured \
partition table to the disk and format the partitions listed below.  Their \
data will be lost.  Do you wish to continue?~%~%~{ - ~a~%~}")
                                 (map user-partition-file-name
                                      (filter user-partition-need-formatting?
                                              partitions)))
                         (G_ "Format disk?")
                         #:exit-button-procedure button-exit-action)
  (draw-info-page
   (format #f (G_ "Partition formatting is in progress, please wait."))
   (G_ "Preparing partitions")))

(define (run-device-page devices)
  "Run a page asking the user to select a device among those in the given
DEVICES list."
  (define (device-items)
    (map (lambda (device)
           `(,device . ,(device-description device)))
         devices))

  (let* ((result (run-listbox-selection-page
                  #:info-text (G_ "Please select a \
disk.  The installation device as well as the small devices are filtered.")
                  #:title (G_ "Disk")
                  #:listbox-items (device-items)
                  #