(define-module (zynqmp packages images)
  #:use-module (zynqmp packages bootloader)
  #:use-module (zynqmp packages linux)
  #:use-module (guix packages)
  #:use-module (guix modules)
  #:use-module (guix gexp)
  #:use-module (guix build-system trivial)
  #:use-module (gnu services base)
  #:use-module (gnu packages base)
  #:use-module (gnu system)
  #:use-module (gnu system shadow)
  #:use-module (gnu system nss)
  #:use-module (gnu system image)
  #:use-module (gnu image)
  #:use-module (gnu bootloader extlinux)
  #:use-module (gnu bootloader))

(define root-offset (+ 512 (* 256 1024 1024)))

;; TODO: FDT
(define* (install-xilinx-bootloader fdt)
  (with-imported-modules '((zynqmp build bootloader))
    #~(begin
        (use-modules (zynqmp build bootloader))

        (lambda (bootloader device mount-point)
          (let* ((bootcfg-file (string-append (getcwd) "/" mount-point "/bootcfg"))
                 (bootcfg (load bootcfg-file)))

            ;; Configuration
            (mkdir-p (string-append mount-point "/extlinux"))
            (call-with-output-file
                (string-append mount-point "/extlinux/extlinux.conf")
              (lambda (port)
                (display (apply string-append (map bootcfg-entry->config-menu-entry bootcfg)) port)))

            ;; GNU store needed files
            (for-each
             (lambda (source-file)
               (let* ((dest-file (string-append mount-point source-file)))
                 (mkdir-p (dirname dest-file))
                 (copy-recursively source-file dest-file)))
             (get-required-files bootcfg))


            (copy-file (string-append bootloader "/libexec/boot.bin")
                       (string-append mount-point "/boot.bin"))
            (copy-file (string-append bootloader "/libexec/u-boot.itb")
                       (string-append mount-point "/u-boot.itb"))

            ;; From the first element extract linux.
            ;; There can be just one fdt file... the first element should be the newest...
            (let* ((entry (list-ref bootcfg 0))
                   (linux (list-ref entry 1))
                   (linux-dir (dirname linux)))
              (copy-file (string-append linux-dir "/lib/dtbs/" #$fdt ".dtb")
                         (string-append mount-point "/system.dtb"))))))))

;; This is just a configuration stub. Actually it will write the bootcfg to a file.
;; This file is then consumed by the install bootloader script. And this script
;; will generate the proper configuration
(define* (xilinx-external-bootloader-configuration config entries #:key #:allow-other-keys)
  (define all-entries
    (append entries (bootloader-configuration-menu-entries config)))

  (define (menu-entry->gexp entry)
    (let ((label (menu-entry-label entry))
          (kernel (menu-entry-linux entry))
          (kernel-arguments (menu-entry-linux-arguments entry))
          (initrd (menu-entry-initrd entry)))
      #~(list #$label #$kernel (list #$@kernel-arguments) #$initrd)))

  (define builder
    #~(call-with-output-file #$output
        (lambda (port)
          (write '(list #$@(map menu-entry->gexp all-entries)) port))))

  (computed-file "bootcfg" builder))

(define xilinx-bootloader
  (bootloader
   (inherit extlinux-bootloader)
   (name 'xilinx-uboot)
   (package u-boot-for-kr260)
   (configuration-file-generator xilinx-external-bootloader-configuration)
   (installer (install-xilinx-bootloader "xilinx/zynqmp-smk-k26-revA-sck-kr-g-revB"))
   (configuration-file "/bootcfg")))

(define root-partition
  (partition
   (size 'guess)
   (label "root")
   (file-system "ext4")
   (offset root-offset)
   ;; Disable the metadata_csum and 64bit features of ext4, for compatibility
   ;; with U-Boot.
   (file-system-options (list "-O" "^metadata_csum,^64bit"))
   (flags '(boot))
   (initializer
    #~(lambda* (root #:key
                 (copy-closures? #t)
                 (deduplicate? #t)
                 references-graphs
                 (register-closures? #t)
                 system-directory
                 make-device-nodes
                 (wal-mode? #t)
                 #:allow-other-keys)
        (initialize-root-partition root
                                   #:bootcfg #f
                                   #:bootcfg-location #f
                                   #:bootloader-package #f
                                   #:bootloader-installer #f
                                   #:copy-closures? copy-closures?
                                   #:deduplicate? deduplicate?
                                   #:references-graphs references-graphs
                                   #:system-directory system-directory
                                   #:make-device-nodes make-device-nodes
                                   #:wal-mode? wal-mode?)))))

(define boot-partition
  (partition
   (size (* 256 1024 1024))
   (label "BOOT")
   (file-system "vfat")
   (offset 512)
   (flags '(boot))
   (initializer
    (with-imported-modules (source-module-closure
                            '((guix build utils)
                              (gnu build install)))
      #~(lambda* (root #:key
                   bootcfg
                   bootcfg-location
                   bootloader-package
                   bootloader-installer
                   (copy-closures? #t)
                   (deduplicate? #t)
                   references-graphs
                   (register-closures? #t)
                   system-directory
                   make-device-nodes
                   (wal-mode? #t)
                   #:allow-other-keys)
          (use-modules (gnu build install))
          (mkdir-p root)
          (when bootcfg
            (install-boot-config bootcfg bootcfg-location root))
          (when bootloader-installer
            (display "installing bootloader...\n")
            (bootloader-installer bootloader-package #f root)
            (display "bootloader installed...\n")))))))

(define os
  (operating-system
    (host-name "guix")
    (timezone "Europe/Prague")
    (bootloader
     (bootloader-configuration
      (bootloader xilinx-bootloader)))
    (kernel-arguments '("console=ttyPS1,115200"))
    (kernel xilinx-linux-for-zynqmp)
    (initrd-modules '())
    (file-systems (list)) ; Doesn't matter as replaced by image
    (users %base-user-accounts)
    (packages %base-packages)
    (services %base-services)
    (name-service-switch %mdns-host-lookup-nss)))

(define-public zynqmp-base-image
  (image
   (operating-system os)
   (format 'disk-image)
   (partition-table-type 'mbr) ;; TODO
   (volatile-root? #f)
   (partitions
    (list root-partition
          boot-partition))))

(define-public zynqmp-base-system-image
  (package
    (name "zynqmp-base-system-image.img")
    (version "0")
    (source #f)
    (build-system trivial-build-system)
    (arguments
     (list
      #:modules '((guix build utils))
      #:builder
      #~(begin
          (use-modules (guix build utils))
          (symlink
           #$(system-image zynqmp-base-image)
           #$output))))
    (synopsis #f)
    (home-page #f)
    (license #f)
    (description #f)))