├── .ert-runner
├── .gitignore
├── Cask
├── .travis.yml
├── LICENSE-MIT
├── run_tests.sh
├── README.md
├── reason-mode.el
├── reason-interaction.el
├── LICENSE-APACHE
├── refmt.el
├── test
    └── reason-test.el
└── reason-indent.el


/.ert-runner:
--------------------------------------------------------------------------------
1 | -L .
2 | --quiet
3 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | # Compiled
2 | *.elc
3 | 
4 | # Packaging
5 | .cask
6 | 


--------------------------------------------------------------------------------
/Cask:
--------------------------------------------------------------------------------
 1 | (source gnu)
 2 | (source melpa)
 3 | 
 4 | (package-file "reason-mode.el")
 5 | 
 6 | (files "*.el"(:exclude ".dir-locals.el"))
 7 | 
 8 | (development
 9 |  (depends-on "ert-runner"))
10 | 


--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
 1 | language: generic
 2 | sudo: false
 3 | before_install:
 4 |   - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh
 5 |   - evm install $EVM_EMACS --use --skip
 6 |   - cask
 7 | env:
 8 |   - EVM_EMACS=emacs-24.3-travis
 9 |   - EVM_EMACS=emacs-24.4-travis
10 |   - EVM_EMACS=emacs-24.5-travis
11 |   - EVM_EMACS=emacs-25.1-travis
12 |   - EVM_EMACS=emacs-25.2-travis
13 |   - EVM_EMACS=emacs-25.3-travis
14 | script:
15 |   - emacs --version
16 |   - cask install
17 |   - cask exec ./run_tests.sh
18 | 


--------------------------------------------------------------------------------
/LICENSE-MIT:
--------------------------------------------------------------------------------
 1 | Copyright (c) 2015 The Rust Project Developers
 2 | 
 3 | Permission is hereby granted, free of charge, to any
 4 | person obtaining a copy of this software and associated
 5 | documentation files (the "Software"), to deal in the
 6 | Software without restriction, including without
 7 | limitation the rights to use, copy, modify, merge,
 8 | publish, distribute, sublicense, and/or sell copies of
 9 | the Software, and to permit persons to whom the Software
10 | is furnished to do so, subject to the following
11 | conditions:
12 | 
13 | The above copyright notice and this permission notice
14 | shall be included in all copies or substantial portions
15 | of the Software.
16 | 
17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
18 | ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
19 | TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
20 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT
21 | SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
22 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
23 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR
24 | IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25 | DEALINGS IN THE SOFTWARE.
26 | 


--------------------------------------------------------------------------------
/run_tests.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/sh -x
 2 | # Copyright 2014 The Rust Project Developers. See the COPYRIGHT
 3 | # file at the top-level directory of this distribution and at
 4 | # http://rust-lang.org/COPYRIGHT.
 5 | # Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
 6 | #
 7 | # Licensed under the Apache License, Version 2.0 <LICENSE-APACHE or
 8 | # http://www.apache.org/licenses/LICENSE-2.0> or the MIT license
 9 | # <LICENSE-MIT or http://opensource.org/licenses/MIT>, at your
10 | # option. This file may not be copied, modified, or distributed
11 | # except according to those terms.
12 | #
13 | # This runs the test for emacs reason-mode.
14 | # Either $EMACS must be set, or it must be possible to find emacs via PATH.
15 | 
16 | if [ -z "$EMACS" ]; then
17 |     EMACS=emacs
18 | fi
19 | 
20 | $EMACS --batch || {
21 |    echo "You must set EMACS to a program that runs emacs."
22 |    exit 1
23 | }
24 | 
25 | $( $EMACS -batch > /dev/null 2>&1 ) || {
26 |     echo "Your emacs command ($EMACS) does not run properly."
27 |     exit 2
28 | };
29 | 
30 | $( $EMACS -batch --eval "(require 'ert)" > /dev/null 2>&1 ) || {
31 |     echo 'You must install the `ert` dependency; see README.md'
32 |     exit 3
33 | };
34 | 
35 | # All the files reason-mode depends on (in dependency order!)
36 | DEPS_INCLUDES="-l refmt.el -l reason-indent.el -l reason-interaction.el"
37 | 
38 | rm *.elc
39 | WARNINGS="$($EMACS -Q -batch $DEPS_INCLUDES -f batch-byte-compile reason-mode.el 2>&1 | grep -v '^Wrote ')"
40 | if [ -n "$WARNINGS" ]; then
41 |     echo "Byte-compilation failed:"
42 |     # echo "$WARNINGS"
43 |     exit 4
44 | else
45 |     rm *.elc
46 |     echo "Byte-compilation passed."
47 | fi
48 | 
49 | TEST_INCLUDES=$(ls test/*.el | sed -e 's/^/-l /' | xargs)
50 | 
51 | # Note that the order of the -l counts, reason-mode.el goes before the test
52 | # .el files.
53 | $EMACS -batch -l ert $DEPS_INCLUDES -l reason-mode.el $TEST_INCLUDES -f ert-run-tests-batch-and-exit
54 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # reason-mode
  2 | ![Build Status](https://travis-ci.org/reasonml-editor/reason-mode.svg?branch=master)
  3 | 
  4 | An Emacs major mode for [ReasonML](https://reasonml.github.io/).
  5 | 
  6 | ## Installation
  7 | 
  8 | ### Prerequisites
  9 | 
 10 | **Note**: the following setup assumes Reason and Merlin are installed. This can be achieved by installing them from OPAM (`opam install reason merlin`). 
 11 | 
 12 | If you are using bucklescript, make sure you are using a compatible OCaml version (you can find the version of ocaml compatible with your bucklescript installation by running `npm bsc -version`).
 13 | At the time of writing this documentation, install OCaml 4.06.1 (for bucklescript 7.\*)
 14 | 
 15 | **Please verify your installation**:
 16 | 
 17 | ```sh
 18 | ocamlc -version # 4.06.1 if you are using bucklescript
 19 | which ocamlmerlin # a valid path to the ocamlmerlin binary, mandatorily
 20 | which ocamlmerlin-reason # a valid path to the ocamlmerlin-reason binary, mandatorily
 21 | ```
 22 | 
 23 | ### MELPA
 24 | 
 25 | If your Emacs has `package.el` (which is automatically the case for Emacs >= 24), you can install `reason-mode` from the package in [MELPA](https://melpa.org/#/getting-started).
 26 | 
 27 | ### QUELPA
 28 | Alternatively, you can use [quelpa](https://github.com/quelpa/quelpa) and the following recipe:
 29 | 
 30 | ```lisp
 31 | (quelpa '(reason-mode :repo "reasonml-editor/reason-mode" :fetcher github :stable t))
 32 | ```
 33 | 
 34 | ### Manual Installation
 35 | 
 36 | Download `reason-indent.el`, `reason-interaction.el`, `reason-mode.el` and `refmt.el` at the root of this repository and place it in a `vendor` file next to your Emacs configuration files. Then place the following somewhere in your `.emacs.el`:
 37 | 
 38 | ```lisp
 39 | (add-to-list 'load-path "/path/to/vendor")
 40 | ```
 41 | 
 42 | 
 43 | Add the following to your `~/.emacs` or `~/.emacs.d/init.el` file:
 44 | 
 45 | ```elisp
 46 | ;;----------------------------------------------------------------------------
 47 | ;; Reason setup
 48 | ;;----------------------------------------------------------------------------
 49 | 
 50 | (defun shell-cmd (cmd)
 51 |   "Returns the stdout output of a shell command or nil if the command returned
 52 |    an error"
 53 |   (car (ignore-errors (apply 'process-lines (split-string cmd)))))
 54 | 
 55 | (defun reason-cmd-where (cmd)
 56 |   (let ((where (shell-cmd cmd)))
 57 |     (if (not (string-equal "unknown flag ----where" where))
 58 |       where)))
 59 | 
 60 | (let* ((refmt-bin (or (reason-cmd-where "refmt ----where")
 61 |                       (shell-cmd "which refmt")
 62 |                       (shell-cmd "which bsrefmt")))
 63 |        (merlin-bin (or (reason-cmd-where "ocamlmerlin ----where")
 64 |                        (shell-cmd "which ocamlmerlin")))
 65 |        (merlin-base-dir (when merlin-bin
 66 |                           (replace-regexp-in-string "bin/ocamlmerlin$" "" merlin-bin))))
 67 |   ;; Add merlin.el to the emacs load path and tell emacs where to find ocamlmerlin
 68 |   (when merlin-bin
 69 |     (add-to-list 'load-path (concat merlin-base-dir "share/emacs/site-lisp/"))
 70 |     (setq merlin-command merlin-bin))
 71 | 
 72 |   (when refmt-bin
 73 |     (setq refmt-command refmt-bin)))
 74 | 
 75 | (require 'reason-mode)
 76 | (require 'merlin)
 77 | (add-hook 'reason-mode-hook (lambda ()
 78 |                               (add-hook 'before-save-hook 'refmt-before-save)
 79 |                               (merlin-mode)))
 80 | 
 81 | (setq merlin-ac-setup t)
 82 | ```
 83 | 
 84 | If you have iedit mode set up:
 85 | 
 86 | ```lisp
 87 | (require 'merlin-iedit)
 88 | (defun evil-custom-merlin-iedit ()
 89 |   (interactive)
 90 |   (if iedit-mode (iedit-mode)
 91 |     (merlin-iedit-occurrences)))
 92 | (define-key merlin-mode-map (kbd "C-c C-e") 'evil-custom-merlin-iedit)
 93 | ```
 94 | 
 95 | (Thanks @sgrove: [https://gist.github.com/sgrove/c9bdfed77f4da8db108dfb2c188f7baf](https://gist.github.com/sgrove/c9bdfed77f4da8db108dfb2c188f7baf))
 96 | 
 97 | This associates `reason-mode` with `.re` and `.rei` files. To enable it explicitly, do <kbd>M-x reason-mode</kbd>.
 98 | 
 99 | ### Project specific version of `refmt`
100 | 
101 | If you're using different versions of `refmt` between projects, you can use the project-specific installed version via the special config values:
102 | - `'npm` (calls `npx refmt ...` to use the version of `refmt` installed in the project's `node_modules`) 
103 | - `'opam` (calls `opam exec -- refmt ...` to use the version of `refmt` on the current `opam` switch):
104 | 
105 | ```lisp
106 | ;; can also be set via M-x `customize-mode`
107 | (setq refmt-command 'npm)
108 | ```
109 | 
110 | ### Utop
111 | 
112 | Reason-mode provides (opt-in) `rtop` support. At the moment only the native workflow is supported.
113 | 
114 | First of all you need to install the [Utop Emacs integration](https://github.com/diml/utop#integration-with-emacs). Make sure it is latest `master` because the feature is fairly new.
115 | 
116 | Then in your Emacs init file add:
117 | 
118 | ```lisp
119 | (require 'utop)
120 | (setq utop-command "opam config exec -- rtop -emacs")
121 | (add-hook 'reason-mode-hook #'utop-minor-mode) ;; can be included in the hook above as well
122 | ```
123 | 
124 | After this, the function `utop` (`C-c C-s`) will start `rtop` in Reason buffers.
125 | 
126 | ### Spacemacs
127 | 
128 | The [`reasonml`](https://develop.spacemacs.org/layers/+lang/reasonml/README.html) layer is available in the develop version of spacemacs.
129 | 
130 | 
131 | For the stable version of spacemacs, you can install the `reason-mode` package automatically.
132 | 
133 | ```lisp
134 | dotspacemacs-additional-packages
135 |   '(
136 |     (reason-mode
137 |       :location (recipe
138 |         :repo "reasonml-editor/reason-mode"
139 |         :fetcher github
140 |         :files ("reason-mode.el" "refmt.el" "reason-indent.el" "reason-interaction.el")))
141 | )
142 | ```
143 | 
144 | Afterwards add the [snippet](#manual-installation) to your `dotspacemacs/user-config`.
145 | 
146 | ### Features
147 | 
148 | #### Auto-format before saving
149 | 
150 | If you have refmt installed, you can add this to your `.emacs` file to enable
151 | auto-format:
152 | 
153 | ```lisp
154 | (add-hook 'reason-mode-hook (lambda ()
155 |           (add-hook 'before-save-hook #'refmt-before-save)))
156 | ```
157 | 
158 | ### Tests via Cask + ERT
159 | 
160 | The `test` folder contains tests that can be run via [Cask](https://github.com/cask/cask).
161 | Once you install `cask`, if it is the first time run:
162 | 
163 | ```
164 | cask install
165 | cask exec ./run_tests.sh
166 | ```
167 | 
168 | If it is not the first time you can omit the first line and execute the tests with the second one only.
169 | The environment variable EMACS controls the program that runs emacs.
170 | 
171 | ## License
172 | 
173 | `reason-mode` is distributed under the terms of both the MIT license and the
174 | Apache License (Version 2.0).
175 | 
176 | See [LICENSE-MIT](LICENSE-MIT) and [LICENSE-APACHE](LICENSE-APACHE) for details.
177 | 


--------------------------------------------------------------------------------
/reason-mode.el:
--------------------------------------------------------------------------------
  1 | ;;; reason-mode.el --- A major mode for editing ReasonML -*-lexical-binding: t-*-
  2 | ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
  3 | 
  4 | ;; Version: 0.4.0
  5 | ;; Author: Mozilla
  6 | ;; Url: https://github.com/reasonml-editor/reason-mode
  7 | ;; Keywords: languages, ocaml
  8 | ;; Package-Requires: ((emacs "24.3"))
  9 | 
 10 | ;; This file is NOT part of GNU Emacs.
 11 | 
 12 | ;; This file is distributed under the terms of both the MIT license and the
 13 | ;; Apache License (version 2.0).
 14 | 
 15 | ;;; Commentary:
 16 | ;; This project provides useful functions and helpers for developing code
 17 | ;; using the Reason programming language (https://facebook.github.io/reason).
 18 | ;;
 19 | ;; Reason is an umbrella project that provides a curated layer for OCaml.
 20 | ;;
 21 | ;; It offers:
 22 | ;;  - A new, familiar syntax for the battle-tested language that is OCaml.
 23 | ;;  - A workflow for compiling to JavaScript and native code.
 24 | ;;  - A set of friendly documentations, libraries and utilities.
 25 | ;;
 26 | ;; See the README.md for more details.
 27 | 
 28 | ;;; Code:
 29 | 
 30 | (require 'reason-indent)
 31 | (require 'refmt)
 32 | (require 'reason-interaction)
 33 | 
 34 | (eval-when-compile (require 'rx)
 35 |                    (require 'find-file)
 36 |                    (require 'compile)
 37 |                    (require 'url-vars))
 38 | 
 39 | ;; Syntax definitions and helpers
 40 | (defvar reason-mode-syntax-table
 41 |   (let ((table (make-syntax-table)))
 42 | 
 43 |     ;; Operators
 44 |     (dolist (i '(?+ ?- ?* ?/ ?& ?| ?^ ?! ?< ?> ?~ ?@))
 45 |       (modify-syntax-entry i "." table))
 46 | 
 47 |     ;; Strings
 48 |     (modify-syntax-entry ?\" "\"" table)
 49 |     (modify-syntax-entry ?\\ "\\" table)
 50 |     (modify-syntax-entry ?\' "_"  table)
 51 | 
 52 |     ;; Comments
 53 |     (modify-syntax-entry ?/  ". 124b" table)
 54 |     (modify-syntax-entry ?*  ". 23n"  table)
 55 |     (modify-syntax-entry ?\n "> b"    table)
 56 |     (modify-syntax-entry ?\^m "> b"   table)
 57 | 
 58 |     table))
 59 | 
 60 | (defgroup reason nil
 61 |   "Support for Reason code."
 62 |   :link '(url-link "http://facebook.github.io/reason/")
 63 |   :group 'languages)
 64 | 
 65 | (defcustom reason-mode-hook nil
 66 |   "Hook called by `reason-mode'."
 67 |   :type 'hook
 68 |   :group 'reason)
 69 | 
 70 | ;; Font-locking definitions and helpers
 71 | (defconst reason-mode-keywords
 72 |   '("and" "as" "asr" "assert"
 73 |     "begin"
 74 |     "class" "constraint"
 75 |     "do" "done" "downto"
 76 |     "else" "end" "esfun"
 77 |     "exception" "external"
 78 |     "for" "fun" "function" "functor"
 79 |     "if" "in" "include" "inherit" "initializer"
 80 |     "land" "lazy" "let" "lor" "lsl" "lsr" "lxor"
 81 |     "mod" "module" "mutable"
 82 |     "new" "nonrec"
 83 |     "object" "of" "open" "or"
 84 |     "pri" "pub"
 85 |     "rec" "ref"
 86 |     "sig" "struct" "switch"
 87 |     "then" "to" "try" "type"
 88 |     "val" "virtual"
 89 |     "when" "while" "with"
 90 | 
 91 |     ;; these used to be keywords but no longer are
 92 |     "match"))
 93 | 
 94 | (defconst reason-mode-consts
 95 |   '("true" "false"))
 96 | 
 97 | (defconst reason-special-types
 98 |   '("int" "float" "string" "char"
 99 |     "bool" "unit" "list" "array" "exn"
100 |     "option" "ref"))
101 | 
102 | (defconst reason-camel-case
103 |   (rx symbol-start
104 |       (group upper (0+ (any word nonascii digit "_")))
105 |       symbol-end))
106 | 
107 | (eval-and-compile
108 |   (defconst reason--char-literal-rx
109 |     (rx (seq (group "'")
110 |              (or (seq "\\" anything)
111 |                  (not (any "'\\")))
112 |              (group "'")))))
113 | 
114 | (defun reason-re-word (inner)
115 |   "Build a word regexp given INNER."
116 |   (concat "\\<" inner "\\>"))
117 | 
118 | (defun reason-re-grab (inner)
119 |   "Build a grab regexp given INNER."
120 |   (concat "\\(" inner "\\)"))
121 | 
122 | (defun reason-regexp-opt-symbols (words)
123 |   "Like `(regexp-opt words 'symbols)`, but will work on Emacs 23.
124 | See rust-mode PR #42.
125 | Argument WORDS argument to pass to `regexp-opt`."
126 |   (concat "\\_<" (regexp-opt words t) "\\_>"))
127 | 
128 | ;;; Syntax highlighting for Reason
129 | (defvar reason-font-lock-keywords
130 |   `((,(reason-regexp-opt-symbols reason-mode-keywords) . font-lock-keyword-face)
131 |     (,(reason-regexp-opt-symbols reason-special-types) . font-lock-builtin-face)
132 |     (,(reason-regexp-opt-symbols reason-mode-consts) . font-lock-constant-face)
133 | 
134 |     (,reason-camel-case 1 font-lock-type-face)
135 | 
136 |     ;; Field names like `foo:`, highlight excluding the :
137 |     (,(concat (reason-re-grab reason-re-ident) ":[^:]") 1 font-lock-variable-name-face)
138 |     ;; Module names like `foo::`, highlight including the ::
139 |     (,(reason-re-grab (concat reason-re-ident "::")) 1 font-lock-type-face)
140 |     ;; Name punned labeled args like ::foo
141 |     (,(concat "[[:space:]]+" (reason-re-grab (concat "::" reason-re-ident))) 1 font-lock-type-face)
142 | 
143 |     ;; TODO jsx attribs?
144 |     (,
145 |      (concat "<[/]?" (reason-re-grab reason-re-ident) "[^>]*" ">")
146 |      1 font-lock-type-face)))
147 | 
148 | (defalias 'reason-mode-find-alternate-file #'ff-get-other-file
149 |   "Switch to implementation/interface file.")
150 | 
151 | (defun reason--syntax-propertize-multiline-string (end)
152 |   "Propertize Reason multiline string.
153 | Argument END marks the end of the string."
154 |   (let ((ppss (syntax-ppss)))
155 |     (when (eq t (nth 3 ppss))
156 |       (let ((key (save-excursion
157 |                    (goto-char (nth 8 ppss))
158 |                    (and (looking-at "{\\([a-z]*\\)|")
159 |                         (match-string 1)))))
160 |         (when (search-forward (format "|%s}" key) end 'move)
161 |           (put-text-property (1- (match-end 0)) (match-end 0)
162 |                              'syntax-table (string-to-syntax "|")))))))
163 | 
164 | (defun reason-syntax-propertize-function (start end)
165 |   "Propertize Reason function.
166 | Argument START marks the beginning of the function.
167 | Argument END marks the end of the function."
168 |   (goto-char start)
169 |   (reason--syntax-propertize-multiline-string end)
170 |   (funcall
171 |    (syntax-propertize-rules
172 |     (reason--char-literal-rx (1 "\"") (2 "\""))
173 |     ;; multi line strings
174 |     ("\\({\\)[a-z]*|"
175 |      (1 (prog1 "|"
176 |           (goto-char (match-end 0))
177 |           (reason--syntax-propertize-multiline-string end)))))
178 |    (point) end))
179 | 
180 | (defvar reason-mode-map
181 |   (let ((map (make-sparse-keymap)))
182 |     (define-key map "\C-c\C-a" #'reason-mode-find-alternate-file)
183 |     (define-key map "\C-c\C-r" #'refmt-region-ocaml-to-reason)
184 |     (define-key map "\C-c\C-o" #'refmt-region-reason-to-ocaml)
185 |     map))
186 | 
187 | (defvar reason-mode-search-directories '("."))
188 | 
189 | (defvar reason-mode-other-file-alist
190 |   '(("\\.rei\\'" (".re"))
191 |     ("\\.re\\'" (".rei"))
192 |     ("\\.resi\\'" (".res"))
193 |     ("\\.res\\'" (".resi"))))
194 | 
195 | ;;;###autoload
196 | (define-derived-mode reason-mode prog-mode "Reason"
197 |   "Major mode for Reason code.
198 | 
199 | \\{reason-mode-map}"
200 |   :group 'reason
201 |   :syntax-table reason-mode-syntax-table
202 |   :keymap reason-mode-map
203 | 
204 |   ;; Syntax
205 |   (setq-local syntax-propertize-function #'reason-syntax-propertize-function)
206 |   ;; Indentation
207 |   (setq-local indent-line-function 'reason-mode-indent-line)
208 |   ;; Fonts
209 |   (setq-local font-lock-defaults '(reason-font-lock-keywords))
210 |   ;; Misc
211 |   (setq-local comment-start "/* ")
212 |   (setq-local comment-end   " */")
213 |   (setq-local indent-tabs-mode nil)
214 |   (setq-local ff-search-directories reason-mode-search-directories)
215 |   (setq-local ff-other-file-alist reason-mode-other-file-alist)
216 |   ;; Allow paragraph fills for comments
217 |   (setq-local comment-start-skip "/\\*+[ \t]*")
218 |   (setq-local paragraph-start
219 |               (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter))
220 |   (setq-local paragraph-separate paragraph-start)
221 |   (setq-local require-final-newline t)
222 |   (setq-local normal-auto-fill-function nil)
223 |   (setq-local comment-multi-line t)
224 | 
225 |   (setq-local beginning-of-defun-function 'reason-beginning-of-defun)
226 |   (setq-local end-of-defun-function 'reason-end-of-defun)
227 |   (setq-local parse-sexp-lookup-properties t))
228 | 
229 | ;;;###autoload
230 | (add-to-list 'auto-mode-alist '("\\.\\(resi?\\|rei?\\)$" . reason-mode))
231 | 
232 | (defun reason-mode-reload ()
233 |   "Reload Reason mode."
234 |   (interactive)
235 |   (unload-feature 'reason-mode)
236 |   (unload-feature 'reason-indent)
237 |   (unload-feature 'reason-interaction)
238 |   (require 'reason-mode)
239 |   (reason-mode))
240 | 
241 | (provide 'reason-mode)
242 | 
243 | ;;; reason-mode.el ends here
244 | 


--------------------------------------------------------------------------------
/reason-interaction.el:
--------------------------------------------------------------------------------
  1 | ;;; reason-interaction.el --- Phrase navitagion for rtop -*-lexical-binding: t-*-
  2 | 
  3 | ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
  4 | 
  5 | ;;; Commentary:
  6 | 
  7 | ;; Phrase navigation for utop and maybe other REPLs.
  8 | 
  9 | ;; The utop compatibility layer for Reason was mainly taken from:
 10 | ;; https://github.com/ocaml/tuareg/blob/master/tuareg-light.el (big thanks!)
 11 | 
 12 | ;;; Code:
 13 | 
 14 | (defun reason-backward-char (&optional step)
 15 |   "Go back one char.
 16 | Similar to `backward-char` but it does not signal errors
 17 | `beginning-of-buffer` and `end-of-buffer`.  It optionally takes a
 18 | STEP parameter for jumping back more than one character."
 19 |   (when step (goto-char (- (point) step))
 20 |         (goto-char (1- (point)))))
 21 | 
 22 | (defun reason-forward-char (&optional step)
 23 |   "Go forward one char.
 24 | Similar to `forward-char` but it does not signal errors
 25 | `beginning-of-buffer` and `end-of-buffer`.  It optionally takes a
 26 | STEP parameter for jumping back more than one character."
 27 |   (when step (goto-char (+ (point) step))
 28 |     (goto-char (1+ (point)))))
 29 | 
 30 | (defun reason-in-literal-p ()
 31 |   "Return non-nil if point is inside an Reason literal."
 32 |   (nth 3 (syntax-ppss)))
 33 | 
 34 | (defconst reason-comment-delimiter-regexp "\\*/\\|/\\*"
 35 |   "Regex for identify either open or close comment delimiters.")
 36 | 
 37 | (defun reason-in-between-comment-chars-p ()
 38 |   "Return non-nil iff point is in between the comment delimiter chars.
 39 | It returns non-nil if point is between the chars only (*|/ or /|*
 40 | where | is point)."
 41 |   (and (not (bobp)) (not (eobp))
 42 |        (or (and (char-equal ?/ (char-before)) (char-equal ?* (char-after)))
 43 |            (and (char-equal ?* (char-before)) (char-equal ?/ (char-after))))))
 44 | 
 45 | (defun reason-looking-at-comment-delimiters-p ()
 46 |   "Return non-nil iff point in between comment delimiters."
 47 |   (looking-at-p reason-comment-delimiter-regexp))
 48 | 
 49 | (defun reason-in-between-comment-delimiters-p ()
 50 |   "Return non-nil if inside /* and */."
 51 |   (nth 4 (syntax-ppss)))
 52 | 
 53 | (defun reason-in-comment-p ()
 54 |   "Return non-nil iff point is inside or right before a comment."
 55 |   (or (reason-in-between-comment-delimiters-p)
 56 |       (reason-in-between-comment-chars-p)
 57 |       (reason-looking-at-comment-delimiters-p)))
 58 | 
 59 | (defun reason-beginning-of-literal-or-comment ()
 60 |   "Skip to the beginning of the current literal or comment (or buffer)."
 61 |   (interactive)
 62 |   (goto-char (or (nth 8 (syntax-ppss)) (point))))
 63 | 
 64 | (defun reason-inside-block-scope-p ()
 65 |   "Skip to the beginning of the current literal or comment (or buffer)."
 66 |   (and (> (nth 0 (syntax-ppss)) 0)
 67 |        (let ((delim-start (nth 1 (syntax-ppss))))
 68 |          (save-excursion
 69 |            (goto-char delim-start)
 70 |            (char-equal ?{ (following-char))))))
 71 | 
 72 | (defun reason-at-phrase-break-p ()
 73 |   "Is the underlying `;' a phrase break?"
 74 |   ;; Difference from OCaml, the phrase separator is a single semi-colon
 75 |   (and (not (eobp))
 76 |        (char-equal ?\; (following-char))))
 77 | 
 78 | (defun reason-skip-to-close-delimiter (&optional limit)
 79 |   "Skip to the end of a Reason block.
 80 | It basically calls `re-search-forward` in order to go to any
 81 | closing delimiter, not concerning itself with balancing of any
 82 | sort.  Client code needs to check that.
 83 | LIMIT is passed to `re-search-forward` directly."
 84 |   (re-search-forward "\\s)" limit 'move))
 85 | 
 86 | (defun reason-skip-back-to-open-delimiter (&optional limit)
 87 |   "Skip to the beginning of a Reason block backwards.
 88 | It basically calls `re-search-backward` in order to go to any
 89 | opening delimiter, not concerning itself with balancing of any
 90 | sort.  Client code needs to check that.
 91 | LIMIT is passed to `re-search-backward` directly."
 92 |   (re-search-backward "\\s(" limit 'move))
 93 | 
 94 | (defun reason-find-phrase-end ()
 95 |   "Skip to the end of a phrase."
 96 |   (while (and (not (eobp))
 97 |               (not (reason-at-phrase-break-p)))
 98 |     (if (re-search-forward ";" nil 'move)
 99 |         (progn (when (reason-inside-block-scope-p)
100 |                  (reason-skip-to-close-delimiter))
101 |                (goto-char (1- (point))))
102 |       ;; avoid infinite loop at the end of the buffer
103 |       (re-search-forward "[[:space:]\\|\n]+" nil 'move)))
104 |   (min (goto-char (1+ (point))) (point-max)))
105 | 
106 | (defun reason-skip-blank-and-comments ()
107 |   "Skip blank spaces and comments."
108 |   (cond
109 |    ((eobp) (point))
110 |    ((or (reason-in-between-comment-chars-p)
111 |         (reason-looking-at-comment-delimiters-p)) (progn
112 |                                                     (reason-forward-char 1)
113 |                                                     (reason-skip-blank-and-comments)))
114 |    ((reason-in-between-comment-delimiters-p) (progn
115 |                                                (search-forward "*/" nil t)
116 |                                                (reason-skip-blank-and-comments)))
117 |    ((eolp) (progn
118 |              (reason-forward-char 1)
119 |              (reason-skip-blank-and-comments)))
120 |    (t (progn (skip-syntax-forward " ")
121 |              (point)))))
122 | 
123 | (defun reason-skip-back-blank-and-comments ()
124 |   "Skip blank spaces and comments backwards."
125 |   (cond
126 |    ((bobp) (point))
127 |    ((looking-back reason-comment-delimiter-regexp) (progn
128 |                                                      (reason-backward-char 1)
129 |                                                      (reason-skip-back-blank-and-comments)))
130 |    ((reason-in-between-comment-delimiters-p) (progn
131 |                                                (search-backward "/*" nil t)
132 |                                                (reason-backward-char 1)
133 |                                                (reason-skip-back-blank-and-comments)))
134 |    ((or (reason-in-between-comment-chars-p)
135 |         (reason-looking-at-comment-delimiters-p)) (progn
136 |                                                     (reason-backward-char 1)
137 |                                                     (reason-skip-back-blank-and-comments)))
138 |    ((bolp) (progn
139 |              (reason-backward-char 1)
140 |              (reason-skip-back-blank-and-comments)))
141 |    (t (progn (skip-syntax-backward " ")
142 |              (point)))))
143 | 
144 | (defun reason-ro (&rest words)
145 |   "Build a regex matching iff at least a word in WORDS is present."
146 |   (concat "\\<" (regexp-opt words t) "\\>"))
147 | 
148 | (defconst reason-find-phrase-beginning-regexp
149 |   (concat (reason-ro "end" "type" "module" "sig" "struct" "class"
150 |                      "exception" "open" "let")
151 |           "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;"))
152 | 
153 | (defun reason-at-phrase-start-p ()
154 |   "Return t if is looking at the beginning of a phrase.
155 | A phrase starts when a toplevel keyword is at the beginning of a line."
156 |   (or (looking-at "#")
157 |       (looking-at reason-find-phrase-beginning-regexp)))
158 | 
159 | (defun reason-find-phrase-beginning-backward ()
160 |   "Find the beginning of a phrase and return point.
161 | It scans code backwards, therefore the caller can assume that the
162 | beginning of the phrase (if found) is always before the starting
163 | point.  No error is signalled and (point-min) is returned when a
164 | phrease cannot be found."
165 |   (beginning-of-line)
166 |   (while (and (not (bobp)) (not (reason-at-phrase-start-p)))
167 |     (if (reason-inside-block-scope-p)
168 |         (reason-skip-back-to-open-delimiter)
169 |       (re-search-backward reason-find-phrase-beginning-regexp nil 'move)))
170 |   (point))
171 | 
172 | (defun reason-discover-phrase ()
173 |   "Discover a Reason phrase in the buffer."
174 |   ;; TODO reason-with-internal-syntax ;; tuareg2 modifies the syntax table (removed for now)
175 |   ;; TODO stop-at-and feature for phrase detection (do we need it?)
176 |   ;; TODO tuareg2 has some custom logic for module and class (do we need it?)
177 |   (save-excursion
178 |     (let ((case-fold-search nil))
179 |       (reason-skip-blank-and-comments)
180 |       (list (reason-find-phrase-beginning-backward) ;; beginning
181 |             (reason-find-phrase-end)                ;; end
182 |             (save-excursion                         ;; end-with-comment
183 |               (reason-skip-blank-and-comments)
184 |               (point))))))
185 | 
186 | (defun reason-discover-phrase-debug ()
187 |   "Discover a Reason phrase in the buffer (debug mode)."
188 |   (let ((triple (reason-discover-phrase)))
189 |     (message (concat "Evaluating: \"" (reason-fetch-phrase triple) "\""))
190 |     triple))
191 | 
192 | (defun reason-fetch-phrase (triple)
193 |   "Fetch the phrase text given a TRIPLE."
194 |   (let* ((start (nth 0 triple))
195 |          (end (nth 1 triple))) ;; we don't need end-with-comment
196 |     (buffer-substring-no-properties start end)))
197 | 
198 | (defun reason-next-phrase ()
199 |   "Skip to the beginning of the next phrase."
200 |   (cond
201 |    ((reason-at-phrase-start-p) (point))
202 |    ((eolp) (progn
203 |              (forward-char 1)
204 |              (reason-skip-blank-and-comments)
205 |              (reason-next-phrase)))
206 |    ((reason-inside-block-scope-p) (progn (reason-skip-to-close-delimiter)
207 |                                          (reason-next-phrase)))
208 |    ((looking-at ";") (progn
209 |                        (forward-char 1)
210 |                        (reason-next-phrase)))
211 |    (t (progn (end-of-line)
212 |              (reason-next-phrase)))))
213 | 
214 | (provide 'reason-interaction)
215 | 
216 | ;;; reason-interaction.el ends here
217 | 


--------------------------------------------------------------------------------
/LICENSE-APACHE:
--------------------------------------------------------------------------------
  1 |                               Apache License
  2 |                         Version 2.0, January 2004
  3 |                      http://www.apache.org/licenses/
  4 | 
  5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
  6 | 
  7 | 1. Definitions.
  8 | 
  9 |    "License" shall mean the terms and conditions for use, reproduction,
 10 |    and distribution as defined by Sections 1 through 9 of this document.
 11 | 
 12 |    "Licensor" shall mean the copyright owner or entity authorized by
 13 |    the copyright owner that is granting the License.
 14 | 
 15 |    "Legal Entity" shall mean the union of the acting entity and all
 16 |    other entities that control, are controlled by, or are under common
 17 |    control with that entity. For the purposes of this definition,
 18 |    "control" means (i) the power, direct or indirect, to cause the
 19 |    direction or management of such entity, whether by contract or
 20 |    otherwise, or (ii) ownership of fifty percent (50%) or more of the
 21 |    outstanding shares, or (iii) beneficial ownership of such entity.
 22 | 
 23 |    "You" (or "Your") shall mean an individual or Legal Entity
 24 |    exercising permissions granted by this License.
 25 | 
 26 |    "Source" form shall mean the preferred form for making modifications,
 27 |    including but not limited to software source code, documentation
 28 |    source, and configuration files.
 29 | 
 30 |    "Object" form shall mean any form resulting from mechanical
 31 |    transformation or translation of a Source form, including but
 32 |    not limited to compiled object code, generated documentation,
 33 |    and conversions to other media types.
 34 | 
 35 |    "Work" shall mean the work of authorship, whether in Source or
 36 |    Object form, made available under the License, as indicated by a
 37 |    copyright notice that is included in or attached to the work
 38 |    (an example is provided in the Appendix below).
 39 | 
 40 |    "Derivative Works" shall mean any work, whether in Source or Object
 41 |    form, that is based on (or derived from) the Work and for which the
 42 |    editorial revisions, annotations, elaborations, or other modifications
 43 |    represent, as a whole, an original work of authorship. For the purposes
 44 |    of this License, Derivative Works shall not include works that remain
 45 |    separable from, or merely link (or bind by name) to the interfaces of,
 46 |    the Work and Derivative Works thereof.
 47 | 
 48 |    "Contribution" shall mean any work of authorship, including
 49 |    the original version of the Work and any modifications or additions
 50 |    to that Work or Derivative Works thereof, that is intentionally
 51 |    submitted to Licensor for inclusion in the Work by the copyright owner
 52 |    or by an individual or Legal Entity authorized to submit on behalf of
 53 |    the copyright owner. For the purposes of this definition, "submitted"
 54 |    means any form of electronic, verbal, or written communication sent
 55 |    to the Licensor or its representatives, including but not limited to
 56 |    communication on electronic mailing lists, source code control systems,
 57 |    and issue tracking systems that are managed by, or on behalf of, the
 58 |    Licensor for the purpose of discussing and improving the Work, but
 59 |    excluding communication that is conspicuously marked or otherwise
 60 |    designated in writing by the copyright owner as "Not a Contribution."
 61 | 
 62 |    "Contributor" shall mean Licensor and any individual or Legal Entity
 63 |    on behalf of whom a Contribution has been received by Licensor and
 64 |    subsequently incorporated within the Work.
 65 | 
 66 | 2. Grant of Copyright License. Subject to the terms and conditions of
 67 |    this License, each Contributor hereby grants to You a perpetual,
 68 |    worldwide, non-exclusive, no-charge, royalty-free, irrevocable
 69 |    copyright license to reproduce, prepare Derivative Works of,
 70 |    publicly display, publicly perform, sublicense, and distribute the
 71 |    Work and such Derivative Works in Source or Object form.
 72 | 
 73 | 3. Grant of Patent License. Subject to the terms and conditions of
 74 |    this License, each Contributor hereby grants to You a perpetual,
 75 |    worldwide, non-exclusive, no-charge, royalty-free, irrevocable
 76 |    (except as stated in this section) patent license to make, have made,
 77 |    use, offer to sell, sell, import, and otherwise transfer the Work,
 78 |    where such license applies only to those patent claims licensable
 79 |    by such Contributor that are necessarily infringed by their
 80 |    Contribution(s) alone or by combination of their Contribution(s)
 81 |    with the Work to which such Contribution(s) was submitted. If You
 82 |    institute patent litigation against any entity (including a
 83 |    cross-claim or counterclaim in a lawsuit) alleging that the Work
 84 |    or a Contribution incorporated within the Work constitutes direct
 85 |    or contributory patent infringement, then any patent licenses
 86 |    granted to You under this License for that Work shall terminate
 87 |    as of the date such litigation is filed.
 88 | 
 89 | 4. Redistribution. You may reproduce and distribute copies of the
 90 |    Work or Derivative Works thereof in any medium, with or without
 91 |    modifications, and in Source or Object form, provided that You
 92 |    meet the following conditions:
 93 | 
 94 |    (a) You must give any other recipients of the Work or
 95 |        Derivative Works a copy of this License; and
 96 | 
 97 |    (b) You must cause any modified files to carry prominent notices
 98 |        stating that You changed the files; and
 99 | 
100 |    (c) You must retain, in the Source form of any Derivative Works
101 |        that You distribute, all copyright, patent, trademark, and
102 |        attribution notices from the Source form of the Work,
103 |        excluding those notices that do not pertain to any part of
104 |        the Derivative Works; and
105 | 
106 |    (d) If the Work includes a "NOTICE" text file as part of its
107 |        distribution, then any Derivative Works that You distribute must
108 |        include a readable copy of the attribution notices contained
109 |        within such NOTICE file, excluding those notices that do not
110 |        pertain to any part of the Derivative Works, in at least one
111 |        of the following places: within a NOTICE text file distributed
112 |        as part of the Derivative Works; within the Source form or
113 |        documentation, if provided along with the Derivative Works; or,
114 |        within a display generated by the Derivative Works, if and
115 |        wherever such third-party notices normally appear. The contents
116 |        of the NOTICE file are for informational purposes only and
117 |        do not modify the License. You may add Your own attribution
118 |        notices within Derivative Works that You distribute, alongside
119 |        or as an addendum to the NOTICE text from the Work, provided
120 |        that such additional attribution notices cannot be construed
121 |        as modifying the License.
122 | 
123 |    You may add Your own copyright statement to Your modifications and
124 |    may provide additional or different license terms and conditions
125 |    for use, reproduction, or distribution of Your modifications, or
126 |    for any such Derivative Works as a whole, provided Your use,
127 |    reproduction, and distribution of the Work otherwise complies with
128 |    the conditions stated in this License.
129 | 
130 | 5. Submission of Contributions. Unless You explicitly state otherwise,
131 |    any Contribution intentionally submitted for inclusion in the Work
132 |    by You to the Licensor shall be under the terms and conditions of
133 |    this License, without any additional terms or conditions.
134 |    Notwithstanding the above, nothing herein shall supersede or modify
135 |    the terms of any separate license agreement you may have executed
136 |    with Licensor regarding such Contributions.
137 | 
138 | 6. Trademarks. This License does not grant permission to use the trade
139 |    names, trademarks, service marks, or product names of the Licensor,
140 |    except as required for reasonable and customary use in describing the
141 |    origin of the Work and reproducing the content of the NOTICE file.
142 | 
143 | 7. Disclaimer of Warranty. Unless required by applicable law or
144 |    agreed to in writing, Licensor provides the Work (and each
145 |    Contributor provides its Contributions) on an "AS IS" BASIS,
146 |    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
147 |    implied, including, without limitation, any warranties or conditions
148 |    of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
149 |    PARTICULAR PURPOSE. You are solely responsible for determining the
150 |    appropriateness of using or redistributing the Work and assume any
151 |    risks associated with Your exercise of permissions under this License.
152 | 
153 | 8. Limitation of Liability. In no event and under no legal theory,
154 |    whether in tort (including negligence), contract, or otherwise,
155 |    unless required by applicable law (such as deliberate and grossly
156 |    negligent acts) or agreed to in writing, shall any Contributor be
157 |    liable to You for damages, including any direct, indirect, special,
158 |    incidental, or consequential damages of any character arising as a
159 |    result of this License or out of the use or inability to use the
160 |    Work (including but not limited to damages for loss of goodwill,
161 |    work stoppage, computer failure or malfunction, or any and all
162 |    other commercial damages or losses), even if such Contributor
163 |    has been advised of the possibility of such damages.
164 | 
165 | 9. Accepting Warranty or Additional Liability. While redistributing
166 |    the Work or Derivative Works thereof, You may choose to offer,
167 |    and charge a fee for, acceptance of support, warranty, indemnity,
168 |    or other liability obligations and/or rights consistent with this
169 |    License. However, in accepting such obligations, You may act only
170 |    on Your own behalf and on Your sole responsibility, not on behalf
171 |    of any other Contributor, and only if You agree to indemnify,
172 |    defend, and hold each Contributor harmless for any liability
173 |    incurred by, or claims asserted against, such Contributor by reason
174 |    of your accepting any such warranty or additional liability.
175 | 
176 | END OF TERMS AND CONDITIONS
177 | 
178 | APPENDIX: How to apply the Apache License to your work.
179 | 
180 |    To apply the Apache License to your work, attach the following
181 |    boilerplate notice, with the fields enclosed by brackets "[]"
182 |    replaced with your own identifying information. (Don't include
183 |    the brackets!)  The text should be enclosed in the appropriate
184 |    comment syntax for the file format. We also recommend that a
185 |    file or class name and description of purpose be included on the
186 |    same "printed page" as the copyright notice for easier
187 |    identification within third-party archives.
188 | 
189 | Copyright [yyyy] [name of copyright owner]
190 | 
191 | Licensed under the Apache License, Version 2.0 (the "License");
192 | you may not use this file except in compliance with the License.
193 | You may obtain a copy of the License at
194 | 
195 | 	http://www.apache.org/licenses/LICENSE-2.0
196 | 
197 | Unless required by applicable law or agreed to in writing, software
198 | distributed under the License is distributed on an "AS IS" BASIS,
199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
200 | See the License for the specific language governing permissions and
201 | limitations under the License.
202 | 


--------------------------------------------------------------------------------
/refmt.el:
--------------------------------------------------------------------------------
  1 | ;;; refmt.el --- utility functions to format reason code
  2 | 
  3 | ;; Copyright (c) 2014 The go-mode Authors. All rights reserved.
  4 | ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
  5 | 
  6 | ;; Redistribution and use in source and binary forms, with or without
  7 | ;; modification, are permitted provided that the following conditions are
  8 | ;; met:
  9 | 
 10 | ;; * Redistributions of source code must retain the above copyright
 11 | ;; notice, this list of conditions and the following disclaimer.
 12 | ;; * Redistributions in binary form must reproduce the above
 13 | ;; copyright notice, this list of conditions and the following disclaimer
 14 | ;; in the documentation and/or other materials provided with the
 15 | ;; distribution.
 16 | ;; * Neither the name of the copyright holder nor the names of its
 17 | ;; contributors may be used to endorse or promote products derived from
 18 | ;; this software without specific prior written permission.
 19 | 
 20 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 21 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 22 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 23 | ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 24 | ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 25 | ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 26 | ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 27 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 28 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 29 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 30 | ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.)
 31 | 
 32 | ;;; Commentary:
 33 | ;;
 34 | 
 35 | ;;; Code:
 36 | 
 37 | (require 'cl-lib)
 38 | 
 39 | (defvar-local refmt-opam-bin-dir nil)
 40 | 
 41 | (defcustom refmt-command "refmt"
 42 |   "The 'refmt' command."
 43 |   :type '(choice (file :tag "Filename (default binary is \"refmt\")")
 44 |                  (const :tag "Use current opam switch" opam)
 45 |                  (const :tag "Use current npm version (via npx)" npm)
 46 |                  (const :tag "Use current esy version (via esy exec-command)" esy))
 47 |   :group 're-fmt)
 48 | 
 49 | (defcustom refmt-show-errors 'buffer
 50 |     "Where to display refmt error output.
 51 | It can either be displayed in its own buffer, in the echo area, or not at all.
 52 | Please note that Emacs outputs to the echo area when writing
 53 | files and will overwrite refmt's echo output if used from inside
 54 | a `before-save-hook'."
 55 |     :type '(choice
 56 |             (const :tag "Own buffer" buffer)
 57 |             (const :tag "Echo area" echo)
 58 |             (const :tag "None" nil))
 59 |       :group 're-fmt)
 60 | 
 61 | (defcustom refmt-width-mode nil
 62 |   "Specify width when formatting buffer contents."
 63 |   :type '(choice
 64 |           (const :tag "Window width" window)
 65 |           (const :tag "Fill column" fill)
 66 |           (const :tag "None" nil))
 67 |   :group 're-fmt)
 68 | 
 69 | ;;;###autoload
 70 | (defun refmt-before-save ()
 71 |   "Add this to .emacs to run refmt on the current buffer when saving:
 72 |  (add-hook 'before-save-hook 'refmt-before-save)."
 73 |     (interactive)
 74 |       (when (eq major-mode 'reason-mode) (refmt)))
 75 | 
 76 | (defun reason--goto-line (line)
 77 |   (goto-char (point-min))
 78 |     (forward-line (1- line)))
 79 | 
 80 | (defun reason--delete-whole-line (&optional arg)
 81 |     "Delete the current line without putting it in the `kill-ring'.
 82 | Derived from function `kill-whole-line'.  ARG is defined as for that
 83 | function."
 84 |     (setq arg (or arg 1))
 85 |     (if (and (> arg 0)
 86 |              (eobp)
 87 |              (save-excursion (forward-visible-line 0) (eobp)))
 88 |         (signal 'end-of-buffer nil))
 89 |     (if (and (< arg 0)
 90 |              (bobp)
 91 |              (save-excursion (end-of-visible-line) (bobp)))
 92 |         (signal 'beginning-of-buffer nil))
 93 |     (cond ((zerop arg)
 94 |            (delete-region (progn (forward-visible-line 0) (point))
 95 |                           (progn (end-of-visible-line) (point))))
 96 |           ((< arg 0)
 97 |            (delete-region (progn (end-of-visible-line) (point))
 98 |                           (progn (forward-visible-line (1+ arg))
 99 |                                  (unless (bobp)
100 |                                    (backward-char))
101 |                                  (point))))
102 |           (t
103 |            (delete-region (progn (forward-visible-line 0) (point))
104 |                                                   (progn (forward-visible-line arg) (point))))))
105 | 
106 | (defun reason--apply-rcs-patch (patch-buffer &optional start-pos)
107 |   "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer."
108 |   (setq start-pos (or start-pos (point-min)))
109 |   (let ((first-line (line-number-at-pos start-pos))
110 |         (target-buffer (current-buffer))
111 |         ;; Relative offset between buffer line numbers and line numbers
112 |         ;; in patch.
113 |         ;;
114 |         ;; Line numbers in the patch are based on the source file, so
115 |         ;; we have to keep an offset when making changes to the
116 |         ;; buffer.
117 |         ;;
118 |         ;; Appending lines decrements the offset (possibly making it
119 |         ;; negative), deleting lines increments it. This order
120 |         ;; simplifies the forward-line invocations.
121 |         (line-offset 0))
122 |     (save-excursion
123 |       (with-current-buffer patch-buffer
124 |         (goto-char (point-min))
125 |         (while (not (eobp))
126 |           (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)")
127 |             (error "invalid rcs patch or internal error in reason--apply-rcs-patch"))
128 |           (forward-line)
129 |           (let ((action (match-string 1))
130 |                 (from (string-to-number (match-string 2)))
131 |                 (len  (string-to-number (match-string 3))))
132 |             (cond
133 |              ((equal action "a")
134 |               (let ((start (point)))
135 |                 (forward-line len)
136 |                 (let ((text (buffer-substring start (point))))
137 |                   (with-current-buffer target-buffer
138 |                     (cl-decf line-offset len)
139 |                     (goto-char start-pos)
140 |                     (forward-line (- from len line-offset))
141 |                     (insert text)))))
142 |              ((equal action "d")
143 |               (with-current-buffer target-buffer
144 |                 (reason--goto-line (- (1- (+ first-line from)) line-offset))
145 |                 (cl-incf line-offset len)
146 |                 (reason--delete-whole-line len)))
147 |              (t
148 |               (error "invalid rcs patch or internal error in reason--apply-rcs-patch")))))))))
149 | 
150 | (defun refmt--process-errors (filename tmpfile errorfile errbuf)
151 |   (with-current-buffer errbuf
152 |     (if (eq refmt-show-errors 'echo)
153 |         (progn
154 |           (message "%s" (buffer-string))
155 |           (refmt--kill-error-buffer errbuf))
156 |       (insert-file-contents errorfile nil nil nil)
157 |       ;; Convert the refmt stderr to something understood by the compilation mode.
158 |       (goto-char (point-min))
159 |       (insert "refmt errors:\n")
160 |       (while (search-forward-regexp (regexp-quote tmpfile) nil t)
161 |         (replace-match (file-name-nondirectory filename)))
162 |       (compilation-mode)
163 |       (display-buffer errbuf))))
164 | 
165 | (defun refmt--kill-error-buffer (errbuf)
166 |   (let ((win (get-buffer-window errbuf)))
167 |     (if win
168 |         (quit-window t win)
169 |       (with-current-buffer errbuf
170 |         (erase-buffer))
171 |       (kill-buffer errbuf))))
172 | 
173 | (defun apply-refmt (&optional start end from to)
174 |   (setq start (or start (point-min))
175 |         end (or end (point-max))
176 |         from (or from "re")
177 |         to (or to "re"))
178 |    (let* ((ext (file-name-extension buffer-file-name t))
179 |           (bufferfile (make-temp-file "refmt" nil ext))
180 |           (outputfile (make-temp-file "refmt" nil ext))
181 |           (errorfile (make-temp-file "refmt" nil ext))
182 |           (errbuf (if refmt-show-errors (get-buffer-create "*Refmt Errors*")))
183 |           (patchbuf (get-buffer-create "*Refmt patch*"))
184 |           (coding-system-for-read 'utf-8)
185 |           (coding-system-for-write 'utf-8)
186 |           (width-args
187 |            (cond
188 |             ((equal refmt-width-mode 'window)
189 |              (list "--print-width" (number-to-string (window-body-width))))
190 |             ((equal refmt-width-mode 'fill)
191 |              (list "--print-width" (number-to-string fill-column)))
192 |             (t
193 |              '()))))
194 |      (unwind-protect
195 |          (save-restriction
196 |            (widen)
197 |            (write-region start end bufferfile)
198 |            (if errbuf
199 |                (with-current-buffer errbuf
200 |                  (setq buffer-read-only nil)
201 |                  (erase-buffer)))
202 |            (with-current-buffer patchbuf
203 |              (erase-buffer))
204 |            (if (zerop (let* ((files (list (list :file outputfile) errorfile))
205 |                              (args (append width-args (list "--parse" from "--print" to bufferfile))))
206 |                         (cond ((equal refmt-command 'opam)
207 |                                ;; this was originally done via `opam exec' but that does not
208 |                                ;; work for opam 1, and added a performance hit
209 |                                (progn
210 |                                  (when (not refmt-opam-bin-dir)
211 |                                    (setq-local
212 |                                     refmt-opam-bin-dir
213 |                                     (with-temp-buffer
214 |                                       (when (eq (call-process-shell-command
215 |                                                  "opam config var bin" nil (current-buffer) nil) 0)
216 |                                         (replace-regexp-in-string "\n$" "" (buffer-string))))))
217 | 
218 |                                  (apply 'call-process (concat refmt-opam-bin-dir "/refmt") nil files nil args)))
219 | 
220 |                               ((equal refmt-command 'npm)
221 |                                (apply 'call-process
222 |                                       "npx" nil files nil (append '("refmt") args)))
223 | 
224 |                               ((equal refmt-command 'esy)
225 |                                (apply 'call-process
226 |                                       "esy" nil files nil (append '("exec-command" "refmt") args)))
227 | 
228 |                               (t
229 |                                (apply 'call-process
230 |                                       refmt-command nil files nil args)))))
231 |                (progn
232 |                  (call-process-region start end "diff" nil patchbuf nil "-n" "-"
233 |                                       outputfile)
234 |                  (reason--apply-rcs-patch patchbuf start)
235 |                  (message "Applied refmt")
236 |                  (if errbuf (refmt--kill-error-buffer errbuf)))
237 |              (message "Could not apply refmt")
238 |              (if errbuf
239 |                  (refmt--process-errors (buffer-file-name) bufferfile errorfile errbuf)))))
240 |      (kill-buffer patchbuf)
241 |      (delete-file errorfile)
242 |      (delete-file bufferfile)
243 |      (delete-file outputfile)))
244 | 
245 | (defun refmt ()
246 |   "Format the current buffer according to the refmt tool."
247 |   (interactive)
248 |   (apply-refmt))
249 | 
250 | (defun refmt-region-ocaml-to-reason (start end)
251 |   (interactive "r")
252 |   (apply-refmt start end "ml"))
253 | 
254 | (defun refmt-region-reason-to-ocaml (start end)
255 |   (interactive "r")
256 |   (apply-refmt start end "re" "ml"))
257 | 
258 | (provide 'refmt)
259 | 
260 | ;;; refmt.el ends here
261 | 


--------------------------------------------------------------------------------
/test/reason-test.el:
--------------------------------------------------------------------------------
  1 | ;;; reason-mode-tests.el --- ERT tests for reason-mode.el
  2 | ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
  3 | 
  4 | ;;; Commentary:
  5 | 
  6 | ;; Tests for reason-mode.
  7 | 
  8 | ;;; Code:
  9 | 
 10 | (message "Running tests on Emacs %s" emacs-version)
 11 | 
 12 | (require 'ert-x)
 13 | (require 'reason-mode)
 14 | (require 'cl)
 15 | 
 16 | (setq reason-test-fill-column 32)
 17 | 
 18 | (defun reason-compare-code-after-manip (original point-pos manip-func expected got)
 19 |   (equal expected got))
 20 | 
 21 | (defun reason-test-explain-bad-manip (original point-pos manip-func expected got)
 22 |   (if (equal expected got)
 23 |       nil
 24 |     (list
 25 |      ;; The (goto-char) and (insert) business here is just for
 26 |      ;; convenience--after an error, you can copy-paste that into emacs eval to
 27 |      ;; insert the bare strings into a buffer
 28 |      "Reason code was manipulated wrong after:"
 29 |      `(insert ,original)
 30 |      `(goto-char ,point-pos)
 31 |      'expected `(insert ,expected)
 32 |      'got `(insert ,got)
 33 |      (loop for i from 0 to (max (length original) (length expected))
 34 |            for oi = (if (< i (length got)) (elt got i))
 35 |            for ei = (if (< i (length expected)) (elt expected i))
 36 |            while (equal oi ei)
 37 |            finally return `(first-difference-at
 38 |                             (goto-char ,(+ 1 i))
 39 |                             expected ,(char-to-string ei)
 40 |                             got ,(char-to-string oi))))))
 41 | (put 'reason-compare-code-after-manip 'ert-explainer
 42 |      'reason-test-explain-bad-manip)
 43 | 
 44 | (defun reason-test-manip-code (original point-pos manip-func expected)
 45 |   (with-temp-buffer
 46 |     (reason-mode)
 47 |     (insert original)
 48 |     (goto-char point-pos)
 49 |     (funcall manip-func)
 50 |     (should (reason-compare-code-after-manip
 51 |              original point-pos manip-func expected (buffer-string)))))
 52 | 
 53 | (defun test-indent (indented &optional deindented)
 54 |   (let ((deindented (or deindented (replace-regexp-in-string "^[[:blank:]]*" "      " indented))))
 55 |     (reason-test-manip-code
 56 |      deindented
 57 |      1
 58 |      (lambda ()
 59 |        ;; The indentation will fail in some cases if the syntax properties are
 60 |        ;; not set.  This only happens when font-lock fontifies the buffer.
 61 |        (font-lock-fontify-buffer)
 62 |        (indent-region 1 (+ 1 (buffer-size))))
 63 |      indented)))
 64 | 
 65 | 
 66 | (ert-deftest indent-struct-fields-aligned ()
 67 |   (test-indent
 68 |    "
 69 | type foo { bar: int,
 70 |            baz: int};
 71 | 
 72 | type blah {x:int,
 73 |            y:int,
 74 |            z:string};"))
 75 | 
 76 | ;; Reason will also eventually support line comments, which are not supported in OCaml.
 77 | ;; (ert-deftest indent-inside-braces ()
 78 | ;;   (test-indent
 79 | ;;    "
 80 | ;; // struct fields out one level:
 81 | ;; struct foo {
 82 | ;;     a:int,
 83 | ;;     // comments too
 84 | ;;     b:char
 85 | ;; }
 86 | 
 87 | ;; fun bar(x:Box<int>) {   // comment here should not affect the next indent
 88 | ;;     bla();
 89 | ;;     bla();
 90 | ;; }"))
 91 | 
 92 | (ert-deftest indent-top-level ()
 93 |   (test-indent
 94 |    "
 95 | /* Everything here is at the top level and should not be indented*/
 96 | let greeting = \"hello!\";
 97 | let score = 10;
 98 | let newScore = 10 + score;
 99 | "))
100 | 
101 | ;; TODO how to align these
102 | (ert-deftest indent-params-no-align ()
103 |   (test-indent
104 |    "
105 | /* Indent out one level because no params appear on the first line */
106 | fun xyzzy(
107 |   a:int,
108 |   b:char) => {};
109 | 
110 | fun abcdef(
111 |   a:int,
112 |   b:char)
113 |   :int =>
114 |   { 1 };
115 | "))
116 | 
117 | (ert-deftest indent-params-align1 ()
118 |   (test-indent
119 |    "
120 | /* Align the second line of params to the first */
121 | fun foo(a:int,
122 |         b:char) => {};
123 | "))
124 | 
125 | (ert-deftest indent-params-align2 ()
126 |   (test-indent
127 |    "
128 | /* Align the second line of params to the first */
129 | fun foo2(   a:int,
130 |             b:char)
131 |             :int =>
132 |   { 1 };
133 | "))
134 | 
135 | (ert-deftest indent-params-align3 ()
136 |   (test-indent
137 |    "
138 | /* Align the second line of params to the first */
139 | fun foo3(   a:int,  /* should work with a comment here */
140 |             b:char)
141 |             :int =>
142 |   { 1 };
143 | "))
144 | 
145 | (ert-deftest indent-open-after-arrow1 ()
146 |   (test-indent
147 |    "
148 | /* Indent function body only one level after `=> {` */
149 | fun foo1(a:int) (b:char) :int => {
150 |   let body = \"hello\";
151 |   1
152 | };
153 | "))
154 | 
155 | (ert-deftest indent-open-after-arrow2 ()
156 |   (test-indent
157 |    "
158 | /* Indent function body only one level after `=> {` */
159 | fun foo2 (a:int)
160 |          (b:char) :int => {
161 |   let body = \"hello\";
162 |   1
163 | };
164 | "))
165 | 
166 | (ert-deftest indent-open-after-arrow3 ()
167 |   (test-indent
168 |    "
169 | /* Indent function body only one level after `=> {` */
170 | fun foo3(a:int,
171 |          b:char)
172 |         :int => {
173 |   let body = \"hello\";
174 |   1
175 | };
176 | "))
177 | 
178 | (ert-deftest indent-square-bracket-alignment ()
179 |   (test-indent
180 |    "
181 | fun args_on_the_next_line( /* with a comment */
182 |                               a:int,
183 |                               b:String) => {
184 |   let aaaaaa = [
185 |     1,
186 |     2,
187 |     3];
188 |   let bbbbbbb = [1, 2, 3,
189 |                  4, 5, 6];
190 |   let ccc = [   10, 9, 8,
191 |                 7, 6, 5];
192 | };
193 | "))
194 | 
195 | ;; TODO: uncomment
196 | ;; TODO fix alignment of curly braces when down a line
197 | ;; (ert-deftest indent-multi-line-expr ()
198 | ;;   (test-indent
199 | ;;    "
200 | ;; fun foo() =>
201 | ;;   {
202 | ;;     x();
203 | ;;     let a =
204 | ;;       b()
205 | ;;   };
206 | ;; "))
207 | 
208 | (ert-deftest indent-switch ()
209 |   (test-indent
210 |    "
211 | fun foo() => {
212 |   switch blah {
213 |   | Pattern => stuff()
214 |   | _ => whatever
215 |   }
216 | };
217 | "))
218 | 
219 | (ert-deftest indent-if ()
220 |   (test-indent
221 |    "
222 | fun foo() => {
223 |   if (blah) {
224 |     stuff
225 |   } else {
226 |     otherStuff
227 |   }
228 | }"))
229 | 
230 | (ert-deftest indent-switch-multiline-pattern ()
231 |   (test-indent
232 |    "
233 | fun foo() => {
234 |   switch blah {
235 |   | Pattern => \"dada\"
236 |   | Pattern2 => {
237 |       hello()
238 |     }
239 |   | _ => \"whatever\"
240 |   }
241 | };
242 | "))
243 | 
244 | (ert-deftest indent-normal-switch ()
245 |   (test-indent
246 |    "
247 | let hasExactlyTwoCars lst =>
248 |   switch lst {
249 |   | NoMore => false                              /* 0 */
250 |   | List p NoMore => false                       /* 1 */
251 |   | List p (List p2 NoMore) => true              /* 2 */
252 |   | List p (List p2 (List p3 theRest)) => false  /* 3+ */
253 |   };
254 | "))
255 | 
256 | (ert-deftest indent-indented-switch ()
257 |   (test-indent
258 |    "
259 | fun foo() => {
260 |   let x = {
261 |     switch blah {
262 |     | Pattern => \"dada\"
263 |     | Pattern2 => {
264 |         hello()
265 |       }
266 |     | _ => \"whatever\"
267 |     }
268 |   };
269 |   y();
270 | };
271 | "))
272 | 
273 | (ert-deftest indent-indented-object-func ()
274 |   (test-indent
275 | "
276 | module MyApp = {
277 |   type state = {db:db};
278 |   type action = Click;
279 |   let component = ReasonReact.reducerComponent(\"MyApp\");
280 |   let make = (_children) => {
281 |     ...component,
282 |     initialState: () => {db:[||]},
283 |     reducer: (a: action, s:state) =>
284 |       switch(a) {
285 |       | Click => ReasonReact.Update(s)
286 |       },
287 |     render: _self => {
288 |       let a = 20;
289 |       <Text value=\"foo\" />
290 |     }
291 |   }
292 | };
293 | "))
294 | 
295 | (ert-deftest indented-multi-expr-switch ()
296 |   (test-indent
297 |    "
298 | fun foo() => {
299 |   let x = {
300 |     switch blah {
301 |     | Pattern => \"dada\"
302 |     | Pattern2 =>
303 |       hello();
304 |       other();
305 |     | _ => \"whatever\"
306 |     }
307 |   };
308 |   y();
309 | };
310 | "))
311 | 
312 | ;; Make sure that in effort to cover switch patterns we don't mistreat || or expressions
313 | (ert-deftest indent-nonswitch-or-expression ()
314 |   (test-indent
315 |    "
316 | fun foo() => {
317 |   let x = foo() ||
318 |     bar();
319 | };
320 | "))
321 | 
322 | ;; Closing braces in single char literals and strings should not confuse the indentation
323 | ;; TODO In Reason it does confuse indentation
324 | (ert-deftest indent-closing-braces-in-char-literals ()
325 |   (test-indent
326 |    "
327 | fun foo() => {
328 |   bar('}');
329 |   bar(']');
330 |   bar(')');
331 | };
332 | "))
333 | 
334 | (ert-deftest indent-jsx ()
335 |   (test-indent
336 |    "
337 | fun foo() => {
338 |   <div attr=\"bar\">
339 |     <img src=\"foo.png\"/>
340 |   </div>
341 | };
342 | "))
343 | 
344 | (ert-deftest indent-jsx-2 ()
345 |   (test-indent
346 |    "
347 | let make keyInfo::k=? _children => {
348 |   ...component,
349 |   render: fun _ =>
350 |     <div className=\"App\">
351 |       <div className=\"header\">
352 |         <h2> foobar </h2>
353 |         <h3> bar baz quz </h3>
354 |       </div>
355 |       <div className=\"footer\">
356 |         <p> more here </p>
357 |       </div>
358 |     </div>
359 | };
360 | "))
361 | 
362 | (ert-deftest indent-jsx-3 ()
363 |   (test-indent
364 |    "
365 | let make = (_children) => {
366 |   ...component,
367 |   render: self => {
368 |     let name = \"foo\";
369 |     let children = List.map(el => <Text value=el />, [\"foo\", \"bar\"]);
370 |     <View>
371 |       <Text value=name />
372 |       <View>
373 |         ...children
374 |       </View>
375 |     </View>
376 |   }
377 | };
378 | "))
379 | 
380 | (ert-deftest indent-jsx-4 ()
381 |   (test-indent
382 |    "
383 | let make = (name, children) => {
384 |   ...component,
385 |   render: self =>
386 |     <View>
387 |       <Text value=name />
388 |       <View>
389 |         ...children
390 |       </View>
391 |     </View>
392 | };
393 | "))
394 | 
395 | (defun reason-get-buffer-pos (pos-symbol)
396 |   "Get buffer position from POS-SYMBOL.
397 | 
398 | POS-SYMBOL is a symbol found in `reason-test-positions-alist'.
399 | Convert the line-column information from that list into a buffer position value."
400 |   (interactive "P")
401 |   (let* (
402 |          (line-and-column (cadr (assoc pos-symbol reason-test-positions-alist)))
403 |          (line (nth 0 line-and-column))
404 |          (column (nth 1 line-and-column)))
405 |     (save-excursion
406 |       (goto-line line)
407 |       (move-to-column column)
408 |       (point))))
409 | 
410 | (defun reason-test-fontify-string (str)
411 |   (with-temp-buffer
412 |     (reason-mode)
413 |     (insert str)
414 |     (font-lock-fontify-buffer)
415 |     (buffer-string)))
416 | 
417 | (defun reason-test-group-str-by-face (str)
418 |   "Fontify `STR' in reason-mode and group it by face, returning a
419 | list of substrings of `STR' each followed by its face."
420 |   (loop with fontified = (reason-test-fontify-string str)
421 |         for start = 0 then end
422 |         while start
423 |         for end   = (next-single-property-change start 'face fontified)
424 |         for prop  = (get-text-property start 'face fontified)
425 |         for text  = (substring-no-properties fontified start end)
426 |         if prop
427 |         append (list text prop)))
428 | 
429 | (defun reason-test-font-lock (source face-groups)
430 |   "Test that `SOURCE' fontifies to the expected `FACE-GROUPS'"
431 |   (should (equal (reason-test-group-str-by-face source)
432 |                  face-groups)))
433 | 
434 | (ert-deftest font-lock-attribute-inside-string ()
435 |   (reason-test-font-lock
436 |    "\"#[foo]\""
437 |    '("\"#[foo]\"" font-lock-string-face)))
438 | 
439 | (ert-deftest font-lock-attribute-inside-comment ()
440 |   (reason-test-font-lock
441 |    "/* #[foo] */"
442 |    '("/* " font-lock-comment-delimiter-face
443 |      "#[foo] " font-lock-comment-face
444 |      "*/" font-lock-comment-delimiter-face)))
445 | 
446 | (ert-deftest font-lock-double-quote-character-literal ()
447 |   (reason-test-font-lock
448 |    "'\"'; let"
449 |    '("'\"'" font-lock-string-face
450 |      "let" font-lock-keyword-face)))
451 | 
452 | (ert-deftest font-lock-fun-contains-capital ()
453 |   (reason-test-font-lock
454 |    "fun foo_Bar() => {}"
455 |    '("fun" font-lock-keyword-face)))
456 | 
457 | (ert-deftest font-lock-single-quote-character-literal ()
458 |   (reason-test-font-lock
459 |    "fun main() => { let ch = '\\''; }"
460 |    '("fun" font-lock-keyword-face
461 |      "let" font-lock-keyword-face
462 |      "'\\''" font-lock-string-face)))
463 | 
464 | (ert-deftest font-lock-escaped-double-quote-character-literal ()
465 |   (reason-test-font-lock
466 |    "fun main() => { let ch = '\\\"'; }"
467 |    '("fun" font-lock-keyword-face
468 |      "let" font-lock-keyword-face
469 |      "'\\\"'" font-lock-string-face)))
470 | 
471 | (ert-deftest font-lock-escaped-backslash-character-literal ()
472 |   (reason-test-font-lock
473 |    "fun main() => { let ch = '\\\\'; }"
474 |    '("fun" font-lock-keyword-face
475 |      "let" font-lock-keyword-face
476 |      "'\\\\'" font-lock-string-face)))
477 | 
478 | (ert-deftest font-lock-string-ending-with-r-not-raw-string ()
479 |   (reason-test-font-lock
480 |    "fun f() => {
481 |     \"Er\";
482 | };
483 | 
484 | fun g() {
485 |     \"xs\";
486 | };"
487 |    '("fun" font-lock-keyword-face
488 |      "\"Er\"" font-lock-string-face
489 |      "fun" font-lock-keyword-face
490 |      "\"xs\"" font-lock-string-face)))
491 | 
492 | (ert-deftest reason-test-two-character-quotes-in-a-row ()
493 |   (with-temp-buffer
494 |     (reason-mode)
495 |     (font-lock-fontify-buffer)
496 |     (insert "'\\n','a', fun")
497 |     (font-lock-after-change-function 1 12 0)
498 | 
499 |     (should (equal 'font-lock-string-face (get-text-property 3 'face)))
500 |     (should (equal nil (get-text-property 5 'face)))
501 |     (should (equal 'font-lock-string-face (get-text-property 7 'face)))
502 |     (should (equal nil (get-text-property 9 'face)))
503 |     (should (equal 'font-lock-keyword-face (get-text-property 12 'face)))))
504 | 
505 | (ert-deftest single-quote-null-char ()
506 |   (reason-test-font-lock
507 |    "'\\0' 'a' fun"
508 |    '("'\\0'" font-lock-string-face
509 |      "'a'" font-lock-string-face
510 |      "fun" font-lock-keyword-face)))
511 | 
512 | (ert-deftest r-in-string-after-single-quoted-double-quote ()
513 |   (reason-test-font-lock
514 |    "'\"';\n\"r\";\n\"oops\";"
515 |    '("'\"'" font-lock-string-face
516 |      "\"r\"" font-lock-string-face
517 |      "\"oops\"" font-lock-string-face)))
518 | 


--------------------------------------------------------------------------------
/reason-indent.el:
--------------------------------------------------------------------------------
  1 | ;;; reason-indent.el --- Indentation functions for ReasonML -*-lexical-binding: t-*-
  2 | 
  3 | ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
  4 | 
  5 | ;;; Commentary:
  6 | 
  7 | ;; Indentation functions for Reason.
  8 | 
  9 | ;;; Code:
 10 | 
 11 | (defconst reason-re-ident "[[:word:][:multibyte:]_][[:word:][:multibyte:]_[:digit:]]*")
 12 | 
 13 | (defcustom reason-indent-offset 2
 14 |   "Indent Reason code by this number of spaces."
 15 |   :type 'integer
 16 |   :group 'reason-mode
 17 |   :safe #'integerp)
 18 | 
 19 | (defun reason-looking-back-str (str)
 20 |   "Like `looking-back' but for fixed strings rather than regexps.
 21 | Works around some regexp slowness.
 22 | Argument STR string to search for."
 23 |   (let ((len (length str)))
 24 |     (and (> (point) len)
 25 |          (equal str (buffer-substring-no-properties (- (point) len) (point))))))
 26 | 
 27 | (defun reason-paren-level ()
 28 |   "Get the level of nesting inside parentheses."
 29 |   (nth 0 (syntax-ppss)))
 30 | 
 31 | (defun reason-in-str-or-cmnt ()
 32 |   "Return whether point is currently inside a string or a comment."
 33 |   (nth 8 (syntax-ppss)))
 34 | 
 35 | (defun reason-rewind-past-str-cmnt ()
 36 |   "Rewind past string or comment."
 37 |   (goto-char (nth 8 (syntax-ppss))))
 38 | 
 39 | (defun reason-rewind-irrelevant ()
 40 |   "Rewind past irrelevant characters (whitespace of inside comments)."
 41 |   (interactive)
 42 |   (let ((starting (point)))
 43 |     (skip-chars-backward "[:space:]\n")
 44 |     (if (reason-looking-back-str "*/") (backward-char))
 45 |     (if (reason-in-str-or-cmnt)
 46 |         (reason-rewind-past-str-cmnt))
 47 |     (if (/= starting (point))
 48 |         (reason-rewind-irrelevant))))
 49 | 
 50 | (defun reason-align-to-expr-after-brace ()
 51 |   "Align the expression at point to the expression after the previous brace."
 52 |   (save-excursion
 53 |     (forward-char)
 54 |     ;; We don't want to indent out to the open bracket if the
 55 |     ;; open bracket ends the line
 56 |     (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$"))
 57 |       (when (looking-at "[[:space:]]")
 58 |         (forward-word 1)
 59 |         (backward-word 1))
 60 |       (current-column))))
 61 | 
 62 | (defun reason-align-to-prev-expr ()
 63 |   "Align the expression at point to the previous expression."
 64 |   (let ((alignment (save-excursion
 65 |                      (forward-char)
 66 |                      ;; We don't want to indent out to the open bracket if the
 67 |                      ;; open bracket ends the line
 68 |                      (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$"))
 69 |                        (if (looking-at "[[:space:]]")
 70 |                            (progn
 71 |                              (forward-word 1)
 72 |                              (backward-word 1))
 73 |                          (backward-char))
 74 |                        (current-column)))))
 75 |     (if (not alignment)
 76 |         (save-excursion
 77 |           (forward-char)
 78 |           (forward-line)
 79 |           (back-to-indentation)
 80 |           (current-column))
 81 |       alignment)))
 82 | 
 83 | ;;; Start of a reason binding
 84 | (defvar reason-binding
 85 |   (regexp-opt '("let" "type" "module" "fun")))
 86 | 
 87 | (defun reason-beginning-of-defun (&optional arg)
 88 |   "Move backward to the beginning of the current defun.
 89 | 
 90 | With ARG, move backward multiple defuns.  Negative ARG means
 91 | move forward.
 92 | 
 93 | This is written mainly to be used as `beginning-of-defun-function'.
 94 | Don't move to the beginning of the line.  `beginning-of-defun',
 95 | which calls this, does that afterwards."
 96 |   (interactive "p")
 97 |   (re-search-backward (concat "^\\(" reason-binding "\\)\\_>")
 98 |                       nil 'move (or arg 1)))
 99 | 
100 | (defun reason-end-of-defun ()
101 |   "Move forward to the next end of defun.
102 | 
103 | With argument, do it that many times.
104 | Negative argument -N means move back to Nth preceding end of defun.
105 | 
106 | Assume that this is called after ‘beginning-of-defun’.  So point is
107 | at the beginning of the defun body.
108 | 
109 | This is written mainly to be used as `end-of-defun-function' for Reason."
110 |   (interactive)
111 |   ;; Find the opening brace
112 |   (if (re-search-forward "[{]" nil t)
113 |       (progn
114 |         (goto-char (match-beginning 0))
115 |         ;; Go to the closing brace
116 |         (condition-case nil
117 |             (forward-sexp)
118 |           (scan-error
119 |            ;; The parentheses are unbalanced; instead of being unable to fontify, just jump to the end of the buffer
120 |            (goto-char (point-max)))))
121 |     ;; There is no opening brace, so consider the whole buffer to be one "defun"
122 |     (goto-char (point-max))))
123 | 
124 | (defun reason-rewind-to-beginning-of-current-level-expr ()
125 |   "Rewind to the beginning of the expression on the current level of nesting."
126 |   (interactive)
127 |   (let ((current-level (reason-paren-level)))
128 |     (back-to-indentation)
129 |     (when (looking-at "=>")
130 |       (reason-rewind-irrelevant)
131 |       (back-to-indentation))
132 |     (while (> (reason-paren-level) current-level)
133 |       (backward-up-list)
134 |       (back-to-indentation))))
135 | 
136 | (defun reason-mode-indent-line ()
137 |   "Indent current line."
138 |   (interactive)
139 |   (let ((indent
140 |          (save-excursion
141 |            (back-to-indentation)
142 |            ;; Point is now at beginning of current line
143 |            (let* ((level (reason-paren-level))
144 |                   (baseline
145 |                    ;; Our "baseline" is one level out from the indentation of the expression
146 |                    ;; containing the innermost enclosing opening bracket. That
147 |                    ;; way if we are within a block that has a different
148 |                    ;; indentation than this mode would give it, we still indent
149 |                    ;; the inside of it correctly relative to the outside.
150 |                    (if (= 0 level)
151 |                        0
152 |                      (save-excursion
153 |                        ;; jsx, end of previous tag
154 |                        (reason-rewind-irrelevant)
155 |                        (if (save-excursion
156 |                              (reason-rewind-to-beginning-of-current-level-expr)
157 |                              ;; beginning of previous tag
158 |                              (looking-at "\\(<\\|\\.\\.\\.\\)"))
159 |                            (progn
160 |                              (reason-rewind-to-beginning-of-current-level-expr)
161 |                              ;; beginning of previous tag
162 |                              (cond
163 |                               ((looking-at ".*\\(<.*/>\\|</.*>\\)") ;; (self) closing tag
164 |                                (current-column))
165 |                               ((looking-at "<")
166 |                                (+ (current-column) reason-indent-offset))
167 |                               (t (current-column))))
168 |                            (progn
169 |                              (unless (and (looking-at "[[:space:]\n]*<")
170 |                                           (reason-looking-back-str "=>"))
171 |                                (backward-up-list))
172 |                              (reason-rewind-to-beginning-of-current-level-expr)
173 | 
174 |                              (cond
175 |                               ((looking-at "switch")
176 |                                (current-column))
177 | 
178 |                               ((looking-at "if")
179 |                                (+ (current-column) reason-indent-offset))
180 | 
181 |                               ((looking-at "|")
182 |                                (+ (current-column) (* reason-indent-offset 2)))
183 | 
184 |                               ((looking-at "[[:word:]]+:.*=> ?{?$")
185 |                                (+ (current-column) reason-indent-offset))
186 | 
187 |                               (t
188 |                                (let ((current-level (reason-paren-level)))
189 |                                  (save-excursion
190 |                                    (while (and (= current-level (reason-paren-level))
191 |                                                (not (looking-at reason-binding)))
192 |                                      (reason-rewind-irrelevant)
193 |                                      (reason-rewind-to-beginning-of-current-level-expr))
194 |                                    (+ (current-column) reason-indent-offset)))))))))))
195 |              (cond
196 |               ;; A function return type is indented to the corresponding function arguments
197 |               ((looking-at "=>")
198 |                (+ baseline reason-indent-offset))
199 | 
200 |               ((reason-in-str-or-cmnt)
201 |                (cond
202 |                 ;; In the end of the block -- align with star
203 |                 ((looking-at "*/") (+ baseline 1))
204 |                 ;; Indent to the following shape:
205 |                 ;; /* abcd
206 |                 ;;  * asdf
207 |                 ;;  */
208 |                 ;;
209 |                 ((looking-at "*") (+ baseline 1))
210 |                 ;; Indent to the following shape:
211 |                 ;; /* abcd
212 |                 ;;    asdf
213 |                 ;;  */
214 |                 ;;
215 |                 (t (+ baseline (+ reason-indent-offset 1)))))
216 | 
217 |               ((looking-at "</") (- baseline reason-indent-offset))
218 |               ((looking-at "<") baseline)
219 |               ((looking-at "<.*/>") baseline)
220 |               ((looking-at "\\.\\.\\.") baseline)
221 | 
222 |               ;; A closing brace is 1 level unindented
223 |               ((looking-at "}\\|)\\|\\]")
224 |                (save-excursion
225 |                  (reason-rewind-irrelevant)
226 |                  (let ((jsx? (reason-looking-back-str ">")))
227 |                    (backward-up-list)
228 |                    (reason-rewind-to-beginning-of-current-level-expr)
229 |                    (cond
230 |                     ((looking-at "switch") baseline)
231 | 
232 |                     (jsx? (current-column))
233 | 
234 |                     (t (- baseline reason-indent-offset))))))
235 | 
236 |               ;; Doc comments in /** style with leading * indent to line up the *s
237 |               ((and (nth 4 (syntax-ppss)) (looking-at "*"))
238 |                (+ 1 baseline))
239 | 
240 |               ;; If we're in any other token-tree / sexp, then:
241 |               (t
242 |                (or
243 |                 ;; If we are inside a pair of braces, with something after the
244 |                 ;; open brace on the same line and ending with a comma, treat
245 |                 ;; it as fields and align them.
246 |                 (when (> level 0)
247 |                   (save-excursion
248 |                     (reason-rewind-irrelevant)
249 |                     (backward-up-list)
250 |                     ;; Point is now at the beginning of the containing set of braces
251 |                     (reason-align-to-expr-after-brace)))
252 | 
253 |                 (progn
254 |                   (back-to-indentation)
255 |                   (cond ((looking-at (regexp-opt '("and" "type")))
256 |                          baseline)
257 |                         ((save-excursion
258 |                            (reason-rewind-irrelevant)
259 |                            (= (point) 1))
260 |                          baseline)
261 |                         ((save-excursion
262 |                            (while (looking-at "|")
263 |                              (reason-rewind-irrelevant)
264 |                              (back-to-indentation))
265 |                            (looking-at (regexp-opt '("type"))))
266 |                          (+ baseline reason-indent-offset))
267 |                         ((looking-at "|\\|/[/*]")
268 |                          baseline)
269 |                         ((and (> level 0)
270 |                               (save-excursion
271 |                                 (reason-rewind-irrelevant)
272 |                                 (backward-up-list)
273 |                                 (reason-rewind-to-beginning-of-current-level-expr)
274 |                                 (looking-at "switch")))
275 |                          (+ baseline reason-indent-offset))
276 |                         ((save-excursion
277 |                            (reason-rewind-irrelevant)
278 |                            (looking-back "[{;,\\[(]" (- (point) 2)))
279 |                          baseline)
280 |                         ((and
281 |                           (save-excursion
282 |                             (reason-rewind-irrelevant)
283 |                             (reason-rewind-to-beginning-of-current-level-expr)
284 |                             (and (looking-at reason-binding)
285 |                                  (not (progn
286 |                                         (forward-sexp)
287 |                                         (forward-sexp)
288 |                                         (skip-chars-forward "[:space:]\n")
289 |                                         (looking-at "=")))))
290 |                           (not (save-excursion
291 |                                  (skip-chars-backward "[:space:]\n")
292 |                                  (reason-looking-back-str "=>"))))
293 |                          (save-excursion
294 |                            (reason-rewind-irrelevant)
295 |                            (backward-sexp)
296 |                            (reason-align-to-prev-expr)))
297 |                         ((save-excursion
298 |                            (reason-rewind-irrelevant)
299 |                            (looking-back "<\/.*?>" (- (point) 30)))
300 |                          baseline)
301 |                         (t
302 |                          (save-excursion
303 |                            (reason-rewind-irrelevant)
304 |                            (reason-rewind-to-beginning-of-current-level-expr)
305 | 
306 |                            (if (looking-at "|")
307 |                                baseline
308 |                              (+ baseline reason-indent-offset)))))
309 |                   ;; Point is now at the beginning of the current line
310 |                   ))))))))
311 | 
312 |     (when indent
313 |       ;; If we're at the beginning of the line (before or at the current
314 |       ;; indentation), jump with the indentation change.  Otherwise, save the
315 |       ;; excursion so that adding the indentations will leave us at the
316 |       ;; equivalent position within the line to where we were before.
317 |       (if (<= (current-column) (current-indentation))
318 |           (indent-line-to indent)
319 |         (save-excursion (indent-line-to indent))))))
320 | 
321 | (provide 'reason-indent)
322 | 
323 | ;;; reason-indent.el ends here
324 | 


--------------------------------------------------------------------------------