Spago support (#164)

* Add support for Spago globs * Turn args into a list and apply it to call-process * CHANGELOG and documentation for spago support
purescript-emacs · Jan 22, 2019 · 230101a · 230101a
1 parent 665d676
commit 230101a
Show file tree

Hide file tree

Showing 3 changed files with 62 additions and 29 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,8 +1,10 @@
 # CHANGELOG
 
+## 2019-01-22 Detect and handle spago projects
+
 ## 2019-01-15 No longer uses shell-expansion when calling the psc-package command
 
-- This might mean that Windows users that use a wrapped psc-package executable will 
+- This might mean that Windows users that use a wrapped psc-package executable will
   need to put the actual executable on the path
 
 ## 2018-09-29 Automatically detects psc-package projects and sets globs accordingly

diff --git a/README.org b/README.org
@@ -82,9 +82,9 @@
             . ("src/**/*.purs" "test/**/*.purs" "examples/**/*.purs")))))
     #+END_SRC
     Modify the globs accordingly and don't worry about dependency
-    globs for bower or psc-package projects. The plugin picks these up
-    by default. Check the doc-string for `psc-ide-source-globs` for
-    some advanced options.
+    globs for bower, psc-package or spago projects. The plugin picks
+    these up by default. Check the doc-string for
+    `psc-ide-source-globs` for some advanced options.
 
 *** Add an import for the identifier under cursor ~C-c C-i~
 

diff --git a/psc-ide.el b/psc-ide.el
@@ -251,34 +251,65 @@ COMMAND, ARG and IGNORED correspond to the standard company backend API."
   (psc-ide-send-sync psc-ide-command-quit))
 
 (defun psc-ide--server-start-globs ()
-  "Detects bower and psc-package projects and determines sensible source globs."
+  "Detects bower, psc-package and spago projects and determines sensible source globs."
 
-  (when (and (file-exists-p "psc-package.json") (file-exists-p "bower.json"))
-    (message "Detected both a \"psc-package.json\" and a \"bower.json\" file."))
+  (let* ((project-globs ["psc-package.json" "bower.json" "spago.dhall"])
+        (found-package-files (seq-filter 'file-exists-p project-globs)))
+    (when (> (length found-package-files) 1)
+      (message
+       (concat "Detected multiple project files: "
+               (mapconcat 'identity found-package-files ", ")))))
 
   (let ((server-globs psc-ide-source-globs))
-    (if (file-exists-p "psc-package.json")
-        (let ((results "*PSC-PACKAGE SOURCES*")
-              (err-file (make-temp-file "psc-package-errs")))
-          (unwind-protect
-              (if (zerop (call-process "psc-package" nil (list results err-file) nil "sources"))
-                  (progn
-                    (with-current-buffer (get-buffer results)
-                      (let ((globs (split-string (buffer-string) "[\r\n]+" t)))
-                        (setq server-globs (append server-globs globs))
-                        (delete-windows-on results)
-                        (kill-buffer results)))
-                    (message "Set source globs from psc-package. Starting server..."))
-                (with-current-buffer (get-buffer-create "*PSC-PACKAGE ERRORS*")
-                  (let ((inhibit-read-only t))
-                    (insert-file-contents err-file nil nil nil t))
-                  (special-mode)
-                  (display-buffer (current-buffer))
-                  (error "Error executing psc-package")))
-            (delete-file err-file)))
-      (if (file-exists-p "bower.json")
-          (setq server-globs (append server-globs '("bower_components/purescript-*/src/**/*.purs")))
-        (message "Couldn't find psc-package.json nor bower.json files, using just the user specified globs.")))
+    (cond ((file-exists-p "psc-package.json") (add-psc-package-globs))
+          ((file-exists-p "bower.json") (add-bower-globs))
+          ((file-exists-p "spago.dhall") (add-spago-globs))
+          (t (message "Couldn't find psc-package.json, bower.json nor spago.dhall files, using just the user specified globs.")))))
+
+(defun add-psc-package-globs ()
+  (add-globs
+   "*PSC-PACKAGE SOURCES*"
+   "*PSC-PACKAGE ERRORS*"
+   "psc-package-errs"
+   '(("cmd" . "psc-package")
+     ("args" . ("sources")))))
+
+(defun add-spago-globs ()
+  (add-globs
+   "*SPAGO SOURCES*"
+   "*SPAGO ERRORS*"
+   "spago-errs"
+   '(("cmd" . "spago")
+     ("args" . ("sources")))))
+
+(defun add-bower-globs ()
+  (append psc-ide-source-globs '("bower_components/purescript-*/src/**/*.purs")))
+
+(defun add-globs (results errors err-file cmd-alist)
+  "Takes
+  - a result buffer name
+  - an error buffer name
+  - an error file name
+  - a command name and its arguments as an alist, e.g. ((\"cmd\" . \"psc-package\") (\"args\" . (\"sources\")))"
+  (let ((server-globs psc-ide-source-globs)
+        (cmd      (cdr (assoc "cmd" cmd-alist)))
+        (cmd-args (cdr (assoc "args" cmd-alist))))
+    (unwind-protect
+        (if (zerop (apply 'call-process cmd nil (list results err-file) nil cmd-args))
+            (progn
+              (with-current-buffer (get-buffer results)
+                (let ((globs (split-string (buffer-string) "[\r\n]+" t)))
+                  (setq server-globs (append server-globs globs))
+                  (delete-windows-on results)
+                  (kill-buffer results)))
+              (message (format "Set source globs from %s. Starting server..." cmd)))
+          (with-current-buffer (get-buffer-create errors)
+            (let ((inhibit-read-only t))
+              (insert-file-contents err-file nil nil nil t))
+            (special-mode)
+            (display-buffer (current-buffer))
+            (error (format "Error executing %s" cmd))))
+      (delete-file err-file))
     server-globs))
 
 (defun psc-ide-load-module (module-name)