Add idris-start-idris2-project which uses idris2 --init to

generate new ipkg file.

Why:
Idris2 does better job to create the ipkg file than us.

Author: keram

idris-commands.el

@@ -1244,6 +1244,62 @@ of the term to replace."
            (find-file (car files)))
           (t (find-file (completing-read "Package file: " files nil t))))))
 
+(defun idris-start-idris2-project (&optional no-visit)
+  "Interactively create a new Idris2 project with ipkg file and source directory.
+
+When NO-VISIT is t does not open the generated ipkg file in other window."
+  (interactive)
+  (cl-flet ((project-name ()
+              (let ((project-name (string-trim (read-string "Project name: "))))
+                (when (string-match-p "[^a-zA-Z0-9_ ]" project-name)
+                  (user-error "Project name should consist only of letters, numbers, spaces and underscores"))
+                (when (string= "" project-name)
+                  (user-error "Project name can not be empty"))
+                project-name))
+            (project-directory (default-filename)
+              (let ((dir (read-directory-name "Create in: " nil default-filename nil default-filename)))
+                (when (string= "" dir)
+                  (user-error "Project directory can not be empty"))
+                (when (file-exists-p dir)
+                  (user-error "%s already exists" dir))
+                dir)))
+    (let* ((project-name (project-name))
+           (default-filename (downcase (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" project-name)))
+           (package-name (replace-regexp-in-string "[^a-zA-Z0-9_]" "" project-name))
+           (create-in (project-directory default-filename))
+           (src-dir (string-trim (read-string "Source directory (src): " nil nil "src")))
+           (authors (string-trim (read-string (format "Authors (%s): " (user-full-name)) nil nil (user-full-name))))
+           (options (string-trim (read-string "Options: ")))
+           (ipkg-file (file-truename (concat (file-name-as-directory create-in)
+                                             (concat default-filename ".ipkg"))))
+           (output-buffer (generate-new-buffer "*Idris Script Output*"))
+           (input-buffer (generate-new-buffer "*Idris Script Input*")))
+      (make-directory (concat (file-name-as-directory create-in) src-dir) t)
+      (with-current-buffer input-buffer
+        (insert package-name "\n")
+        (insert authors "\n")
+        (insert options "\n")
+        (insert src-dir "\n")
+        (call-process-region (point-min) (point-max)
+                             idris-interpreter-path
+                             nil
+                             output-buffer
+                             nil
+                             "--init"
+                             ipkg-file))
+      (let ((output (with-current-buffer output-buffer
+                      (buffer-string))))
+        (when (string-match-p "error" output)
+          (message "Idris: %s" output)))
+
+      (kill-buffer output-buffer)
+      (kill-buffer input-buffer)
+      (when (file-exists-p ipkg-file)
+        (with-current-buffer (find-file-noselect ipkg-file)
+          (insert "-- " project-name "\n"))
+
+        (when (null no-visit) (find-file-other-window ipkg-file))))))
+
 (defun idris-start-project ()
   "Interactively create a new Idris project, complete with ipkg file."
   (interactive)

test/idris-commands-test.el

@@ -313,6 +313,59 @@ myReverse xs = revAcc [] xs where
       (delete-directory mock-directory-name t)
       (idris-quit))))
 
+(defmacro idris-generate-mock-read (clauses &optional default)
+  "Generate a function with cond expression from CLAUSES and optional DEFAULT."
+  `(lambda (prompt &optional &rest _)
+     (cond
+      ,@(mapcar (lambda (clause)
+                  `((string-match-p ,(if (symbolp (car clause))
+                                         ;; Convert symbol to string and
+                                         ;; remove leading colon and
+                                         ;; replace dashes with a space
+                                         (replace-regexp-in-string
+                                          "^\\:" ""
+                                          (replace-regexp-in-string "-" " " (symbol-name (car clause))))
+                                       (car clause))
+                                    prompt)
+                    ,(cdr clause)))
+                clauses)
+      (t (or ,default "")))))
+
+(when (string-match-p "idris2$" idris-interpreter-path)
+  (ert-deftest idris-start-idris2-project ()
+    "Test `idris-start-idris2-project' creating a project."
+    (cl-flet ((read-string-stub (idris-generate-mock-read ((:project-name . "Idris2 Test Project")
+                                                           (:author . "Joe Doe")
+                                                           (:source-dir . "mysrc")
+                                                           (:options . "--some-option"))))
+              (read-dir-stub
+                (idris-generate-mock-read
+                 ((:create-in . (idris-file-name-concat "test-data" "Idris2TestProject"))))))
+      (advice-add 'read-string :override #'read-string-stub)
+      (advice-add 'read-directory-name :override #'read-dir-stub)
+      (unwind-protect
+          (progn
+            (idris-start-idris2-project t)
+            (let* ((ipkg-file-path (idris-file-name-concat "test-data"
+                                                           "Idris2TestProject"
+                                                           "idris2_test_project.ipkg"))
+                   (ipkg-buffer (find-file-noselect ipkg-file-path))
+                   (ipkg-content (with-current-buffer ipkg-buffer
+                                   (buffer-substring-no-properties (point-min) (point-max)))))
+
+              (should (string-match-p "-- Idris2 Test Project" ipkg-content))
+              (should (string-match-p "package Idris2TestProject" ipkg-content))
+              (should (string-match-p "authors = \"Joe Doe\"" ipkg-content))
+              (should (string-match-p "opts = \"--some-option\"" ipkg-content))
+              (should (string-match-p "sourcedir = \"mysrc\"" ipkg-content)))
+
+            (should (file-exists-p (idris-file-name-concat "test-data"
+                                                           "Idris2TestProject"
+                                                           "mysrc"))))
+        (advice-remove 'read-string #'read-string-stub)
+        (advice-remove 'read-directory-name #'read-dir-stub)
+        (delete-directory (idris-file-name-concat "test-data" "Idris2TestProject") t)))))
+
 ;; Tests by Yasuhiko Watanabe
 ;; https://github.com/idris-hackers/idris-mode/pull/537/files
 (idris-ert-command-action "test-data/CaseSplit.idr" idris-case-split idris-test-eq-buffer)