;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
;;; Copyright © 2018 Alex ter Weele <alex.ter.weele@gmail.com>
;;; Copyright © 2019, 2021, 2022 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2022 Attila Lendvai <attila@lendvai.name>
;;;
;;; 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 packages idris))

(use-modules
 (gnu)
 (guix gexp)
 (guix utils)
 (guix store)
 (guix derivations)
 (guix packages)
 (guix download)
 (guix git-download)
 (guix build-system gnu)
 (guix build-system haskell)
 (guix build utils)
 ((guix licenses) #:prefix license:))

(use-package-modules
 haskell-check
 haskell-web
 haskell-xyz
 libffi
 ncurses
 perl
 gcc
 multiprecision
 bash
 base
 linux
 python
 chez)

(define-public idris
  (package
    (name "idris")
    (version "1.3.4")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/idris-lang/Idris-dev.git")
                    (commit (string-append "v" version))))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "0cd2a92323hb9a6wy8sc0cqwnisf4pv8y9y2rxvxcbyv8cs1q8g2"))
              (patches (search-patches "idris-test-ffi008.patch"))))
    (build-system haskell-build-system)
    (native-inputs                      ;For tests
     (list perl ghc-cheapskate ghc-tasty ghc-tasty-golden
           ghc-tasty-rerun))
    (inputs
     (list gmp
           ncurses
           ghc-aeson
           ghc-annotated-wl-pprint
           ghc-ansi-terminal
           ghc-ansi-wl-pprint
           ghc-async
           ghc-base64-bytestring
           ghc-blaze-html
           ghc-blaze-markup
           ghc-cheapskate
           ghc-code-page
           ghc-fingertree
           ghc-fsnotify
           ghc-ieee754
           ghc-libffi
           ghc-megaparsec
           ghc-network
           ghc-optparse-applicative
           ghc-regex-tdfa
           ghc-safe
           ghc-split
           ghc-terminal-size
           ghc-uniplate
           ghc-unordered-containers
           ghc-utf8-string
           ghc-vector
           ghc-vector-binary-instances
           ghc-zip-archive))
    (arguments
     `(#:configure-flags
       (list (string-append "--datasubdir="
                            (assoc-ref %outputs "out") "/lib/idris")
             "-fFFI" "-fGMP")
       #:phases
       (modify-phases %standard-phases
         ;; This allows us to call the 'idris' binary before installing.
         (add-after 'unpack 'set-ld-library-path
           (lambda _
             (setenv "LD_LIBRARY_PATH" (string-append (getcwd) "/dist/build"))))
         (add-before 'configure 'update-constraints
           (lambda _
             (substitute* "idris.cabal"
               (("(aeson|ansi-terminal|haskeline|megaparsec|optparse-applicative)\\s+[^,]+" all dep)
                dep))))
         (add-before 'configure 'set-cc-command
           (lambda _
             (setenv "CC" ,(cc-for-target))))
         (add-after 'install 'fix-libs-install-location
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (lib (string-append out "/lib/idris"))
                    (modules (string-append lib "/libs")))
               (for-each
                (lambda (module)
                  (symlink (string-append modules "/" module)
                           (string-append lib "/" module)))
                '("prelude" "base" "contrib" "effects" "pruviloj")))))
         (delete 'check)                ;Run check later
         (add-after 'install 'check
           (lambda* (#:key outputs #:allow-other-keys #:rest args)
             (let ((out (assoc-ref outputs "out")))
               (chmod "test/scripts/timeout" #o755) ;must be executable
               (setenv "TASTY_NUM_THREADS" (number->string (parallel-job-count)))
               (setenv "IDRIS_CC" ,(cc-for-target)) ;Needed for creating executables
               (setenv "PATH" (string-append out "/bin:" (getenv "PATH")))
               (apply (assoc-ref %standard-phases 'check) args))))
         (add-before 'check 'restore-libidris_rts
           (lambda* (#:key outputs #:allow-other-keys)
             ;; The Haskell build system moves this library to the
             ;; "static" output.  Idris only knows how to find it in the
             ;; "out" output, so we restore it here.
             (let ((out (assoc-ref outputs "out"))
                   (static (assoc-ref outputs "static"))
                   (filename "/lib/idris/rts/libidris_rts.a"))
               (rename-file (string-append static filename)
                            (string-append out filename))))))))
    (native-search-paths
     (list (search-path-specification
            (variable "IDRIS_LIBRARY_PATH")
            (files '("lib/idris")))))
    (home-page "https://www.idris-lang.org")
    (synopsis "General purpose language with full dependent types")
    (description "Idris is a general purpose language with full dependent
types.  It is compiled, with eager evaluation.  Dependent types allow types to
be predicated on values, meaning that some aspects of a program's behaviour
can be specified precisely in the type.  The language is closely related to
Epigram and Agda.")
    (license license:bsd-3)))

(define-public idris2
  (package
    (name "idris2")
    (version "0.5.1")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/idris-lang/Idris2")
                    (commit (string-append "v" version))))
              (sha256
               (base32
                "09k5fxnplp6fv3877ynz1lwq9zapxcxbvfvkn6g68yb0ivrff978"))
              (file-name (git-file-name name version))))
    (build-system gnu-build-system)
    (arguments
     (list #:make-flags #~(list "SCHEME=chez-scheme"
                                (string-append "CC="
                                               #$(cc-for-target))
                                (string-append "PREFIX="
                                               #$output))
           #:phases #~(modify-phases %standard-phases
                        (add-after 'set-paths 'patch-paths
                          (lambda* _
                            (define (add value var)
                              (let ((prev (getenv var)))
                                (if prev
                                    (setenv var
                                            (string-join (list prev value) ":"))
                                    (setenv var value))))
                            (add (string-append #$output "/lib")
                                 "LD_LIBRARY_PATH")
                            (add (string-append #$output "/bin") "PATH")))
                        (add-after 'unpack 'patch-shebangs
                          (lambda* (#:key inputs #:allow-other-keys)
                            (substitute* '("src/Compiler/Scheme/ChezSep.idr"
                                           "src/Compiler/Scheme/Chez.idr"
                                           "src/Compiler/Scheme/Racket.idr"
                                           "bootstrap/idris2_app/idris2.rkt"
                                           "bootstrap/idris2_app/idris2.ss")
                              (("(#!) *(/bin/sh)" _ shebang exec)
                               (string-append shebang " "
                                              (assoc-ref inputs "bash-minimal")
                                              exec)))))
                        (delete 'bootstrap)
                        (delete 'configure)
                        (add-before 'build 'bootstrap
                          (lambda* (#:key make-flags #:allow-other-keys)
                            (apply invoke "make" "bootstrap" make-flags)
                            (apply invoke "make" "install" make-flags)))
                        (replace 'build
                          (lambda* (#:key make-flags #:allow-other-keys)
                            (apply invoke "make" "clean" make-flags)
                            (apply invoke "make" "all" make-flags)))
                        (add-after 'install 'patch-/bin/idris2
                          (lambda* _
                            (let ((idris2 (string-append #$output "/bin/"
                                                         #$name))
                                  (idris2_app (string-append #$output
                                               "/bin/idris2_app")))
                              (delete-file idris2)
                              (rename-file (string-append idris2_app
                                                          "/idris2.so") idris2)
                              (delete-file-recursively idris2_app))))
                        (add-after 'patch-/bin/idris2 'wrap-idris2
                          (lambda* (#:key inputs #:allow-other-keys)
                            (let* ((chez (string-append (assoc-ref inputs
                                                         "chez-scheme")
                                                        "/bin/chez-scheme"))
                                   (idris2-prefix #$output)
                                   (idris2-version (string-append
                                                    idris2-prefix "/"
                                                    #$name "-"
                                                    #$version))
                                   (idris2-lib (string-append idris2-version
                                                              "/lib"))
                                   (idris2-support (string-append
                                                    idris2-version "/support"))
                                   (idris2-bin (string-append idris2-prefix
                                                              "/bin/"
                                                              #$name)))
                              (wrap-program idris2-bin
                                            (list "CHEZ"
                                                  '=
                                                  (list chez))
                                            (list "IDRIS2_PREFIX"
                                                  '=
                                                  (list idris2-prefix))
                                            (list "IDRIS2_LIBS"
                                                  'suffix
                                                  (list idris2-lib))
                                            (list "IDRIS2_DATA"
                                                  'suffix
                                                  (list idris2-support))
                                            (list "IDRIS2_PACKAGE_PATH"
                                                  'suffix
                                                  (list idris2-version))
                                            (list "LD_LIBRARY_PATH"
                                                  'suffix
                                                  (list idris2-lib))
                                            (list "DYLD_LIBRARY_PATH"
                                                  'suffix
                                                  (list idris2-lib))))))
                        (add-before 'check 'set-INTERACTIVE-IDRIS2
                          (lambda* _
                            (setenv "INTERACTIVE" "")
                            (setenv "IDRIS2"
                                    (string-append #$output "/bin/"
                                                   #$name))))
                        (add-after 'build 'build-doc
                          (lambda* (#:key make-flags #:allow-other-keys)
                            (apply invoke "make" "install-libdocs" make-flags))))
           #:test-target "test"
           #:parallel-build? #f))
    (inputs (list gcc-12
                  chez-scheme
                  gmp
                  coreutils
                  bash-minimal
                  python))
    (home-page "https://www.idris-lang.org/")
    (synopsis
     "Programming language designed to encourage Type-Driven Development")
    (description
     "Idris is a programming language designed to encourage Type-Driven Development.

In type-driven development, types are tools for constructing programs.  We
treat the type as the plan for a program, and use the compiler and type
checker as our assistant, guiding us to a complete program that satisfies the
type.  The more expressive the type is that we give up front, the more
confidence we can have that the resulting program will be correct.")
    (license license:bsd-3)))

;; Idris modules use the gnu-build-system so that the IDRIS_LIBRARY_PATH is set.
(define (idris-default-arguments name)
  `(#:modules ((guix build gnu-build-system)
               (guix build utils)
               (ice-9 ftw)
               (ice-9 match))
    #:phases
    (modify-phases %standard-phases
      (delete 'configure)
      (delete 'build)
      (delete 'check)
      (replace 'install
        (lambda* (#:key inputs outputs #:allow-other-keys)
          (let* ((out (assoc-ref outputs "out"))
                 (idris (assoc-ref inputs "idris"))
                 (idris-bin (string-append idris "/bin/idris"))
                 (idris-libs (string-append idris "/lib/idris/libs"))
                 (module-name (and (string-prefix? "idris-" ,name)
                                   (substring ,name 6)))
                 (ibcsubdir (string-append out "/lib/idris/" module-name))
                 (ipkg (string-append module-name ".ipkg"))
                 (idris-library-path (getenv "IDRIS_LIBRARY_PATH"))
                 (idris-path (string-split idris-library-path #\:))
                 (idris-path-files (apply append
                                          (map (lambda (path)
                                                 (map (lambda (dir)
                                                        (string-append path "/" dir))
                                                      (scandir path))) idris-path)))
                 (idris-path-subdirs (filter (lambda (path)
                                               (and path (match (stat:type (stat path))
                                                           ('directory #t)
                                                           (_ #f))))
                                             idris-path-files))
                 (install-cmd (cons* idris-bin
                                     "--ibcsubdir" ibcsubdir
                                     "--build" ipkg
                                     ;; only trigger a build, as --ibcsubdir
                                     ;; already installs .ibc files.

                                     (apply append (map (lambda (path)
                                                          (list "--idrispath"
                                                                path))
                                                        idris-path-subdirs)))))
            ;; FIXME: Seems to be a bug in idris that causes a dubious failure.
            (apply system* install-cmd)))))))

(define-public idris-lightyear
  (let ((commit "6d65ad111b4bed2bc131396f8385528fc6b3678a"))
    (package
      (name "idris-lightyear")
      (version (git-version "0.1" "1" commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/ziman/lightyear")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "1pkxnn3ryr0v0cin4nasw7kgkc9dnnpja1nfbj466mf3qv5s98af"))))
      (build-system gnu-build-system)
      (native-inputs
       (list idris))
      (arguments (idris-default-arguments name))
      (home-page "https://github.com/ziman/lightyear")
      (synopsis "Lightweight parser combinator library for Idris")
      (description "Lightweight parser combinator library for Idris, inspired
by Parsec.  This package is used (almost) the same way as Parsec, except for one
difference: backtracking.")
      (license license:bsd-2))))

(define-public idris-wl-pprint
  (let ((commit "1d365fcf4ba075859844dbc5eb96a90f57b9f338"))
    (package
      (name "idris-wl-pprint")
      (version (git-version "0.1" "1" commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/shayan-najd/wl-pprint")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "0g7c3y9smifdz4sivi3qmvymhdr7v9kfq45fmfmmvkqcrix0spzn"))))
      (build-system gnu-build-system)
      (native-inputs
       (list idris))
      (arguments (idris-default-arguments name))
      (home-page "https://github.com/shayan-najd/wl-pprint")
      (synopsis "Pretty printing library")
      (description "A pretty printing library for Idris based on Phil Wadler's
paper A Prettier Printer and on Daan Leijen's extensions in the Haskell
wl-pprint library.")
      (license license:bsd-2))))

(define-public idris-bifunctors
  (let ((commit "53d06a6ccfe70c49c9ae8c8a4135981dd2173202"))
    (package
      (name "idris-bifunctors")
      (version (git-version "0.1" "1" commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/HuwCampbell/Idris-Bifunctors")
                      (commit commit)))
                (file-name (string-append name "-" version "-checkout"))
                (sha256
                 (base32
                  "02vbsd3rmgnj0l1qq787709qcxjbr9890cbad4ykn27f77jk81h4"))))
      (build-system gnu-build-system)
      (native-inputs
       (list idris))
      (arguments (idris-default-arguments name))
      (home-page "https://github.com/HuwCampbell/Idris-Bifunctors")
      (synopsis "Bifunctor library")
      (description "This is a bifunctor library for Idris based off the
excellent Haskell Bifunctors package from Edward Kmett.")
      (license license:bsd-3))))

(define-public idris-lens
  (let ((commit "26f012005f6849806cea630afe317e42cae97f29"))
    (package
      (name "idris-lens")
      (version (git-version "0.1" "1" commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/HuwCampbell/idris-lens")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "06jzfj6rad08rk92w8jk5byi79svmyg0mrcqhibgx8rkjjy6vmai"))))
      (build-system gnu-build-system)
      (native-inputs
       (list idris))
      (propagated-inputs
       (list idris-bifunctors))
      (arguments (idris-default-arguments name))
      (home-page "https://github.com/HuwCampbell/idris-lens")
      (synopsis "Van Laarhoven lenses for Idris")
      (description "Lenses are composable functional references.  They allow
accessing and modifying data within a structure.")
      (license license:bsd-3))))