hindent 5.2.3 → 5.2.4
raw patch · 8 files changed
+701/−411 lines, 8 filesdep ~haskell-src-extsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskell-src-exts
API changes (from Hackage documentation)
Files
- CHANGELOG.md +17/−0
- README.md +0/−2
- TESTS.md +189/−14
- elisp/hindent.el +309/−325
- hindent.cabal +2/−2
- src/HIndent.hs +12/−2
- src/HIndent/Pretty.hs +126/−51
- src/main/Main.hs +46/−15
CHANGELOG.md view
@@ -1,3 +1,20 @@+5.2.4:++ * Pretty print imports+ * Fix pretty print for string literals for `DataKinds`+ * Support `--validate` option for checking the format without reformatting+ * Support parse `#include`, `#error`, `#warning` directives+ * Support read `LANGUAGE` pragma and parse the declared extensions from source+ * Treat `TypeApplications` extension as 'badExtensions' due to the `@` symbol+ * Improve pretty print for unboxed tuples+ * Fix many issues related to infix operators, includes TH name quotes,+ `INLINE`/`NOINLINE` pragmas, infix type operator and infix constructor+ * Fix pretty print for operators in `INLINE`/`NOINLINE` pragmas+ * Support for `EmptyCases` extension+ * Fix TH name quotes on operator names+ * Optimize pretty print for many fundeps+ * Fix extra linebreaks after short identifiers+ 5.2.3: * Sort explicit import lists
README.md view
@@ -2,8 +2,6 @@ Haskell pretty printer -[Demonstration site](http://chrisdone.com/hindent/)- [Examples](https://github.com/commercialhaskell/hindent/blob/master/TESTS.md) ## Install
TESTS.md view
@@ -9,6 +9,14 @@ # Modules +Extension pragmas++```haskell+{-# LANGUAGE TypeApplications #-}++fun @Int 12+```+ Module header ``` haskell@@ -72,11 +80,37 @@ ```haskell expect import qualified MegaModule as M- (Either, Maybe(Just, Nothing), MaybeT(..),- Monad((>>), (>>=), return), MonadBaseControl, (<<<), (>>>), join,- liftIO, void)+ ( Either+ , Maybe(Just, Nothing)+ , MaybeT(..)+ , Monad((>>), (>>=), return)+ , MonadBaseControl+ , (<<<)+ , (>>>)+ , join+ , liftIO+ , void+ ) ``` +Pretty import specification++```haskell+import A hiding+ ( foobarbazqux+ , foobarbazqux+ , foobarbazqux+ , foobarbazqux+ , foobarbazqux+ , foobarbazqux+ , foobarbazqux+ )++import Name hiding ()++import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)+```+ # Declarations Type declaration@@ -111,6 +145,7 @@ ``` GADT declarations+ ```haskell data Ty :: (* -> *) where TCon@@ -267,6 +302,8 @@ Type application ```haskell+{-# LANGUAGE TypeApplications #-}+ fun @Int 12 ``` @@ -929,8 +966,7 @@ ``` ```haskell expect-import ATooLongList- (alpha, beta, delta, epsilon, eta, gamma, theta, zeta)+import ATooLongList (alpha, beta, delta, epsilon, eta, gamma, theta, zeta) import B ``` @@ -1156,6 +1192,154 @@ -> [(ResB.BomEx, Maybe ResBS.BomSnapshotAggr)] ``` +NorfairKing Do as left-hand side of an infix operation #296++```haskell+-- https://github.com/commercialhaskell/hindent/issues/296+block =+ do ds <- inBraces $ inWhiteSpace declarations+ return $ Block ds+ <?> "block"+```++NorfairKing Hindent linebreaks after very short names if the total line length goes over 80 #405++```haskell+-- https://github.com/commercialhaskell/hindent/issues/405+t =+ f "this is a very loooooooooooooooooooooooooooong string that goes over the line length"+ argx+ argy+ argz++t =+ function+ "this is a very loooooooooooooooooooooooooooong string that goes over the line length"+ argx+ argy+ argz+```++ivan-timokhin No linebreaks for long functional dependency declarations #323++```haskell+-- https://github.com/commercialhaskell/hindent/issues/323+class Foo a b | a -> b where+ f :: a -> b++class Foo a b c d e f+ | a b c d e -> f+ , a b c d f -> e+ , a b c e f -> d+ , a b d e f -> c+ , a c d e f -> b+ , b c d e f -> a+ where+ foo :: a -> b -> c -> d -> e -> f+```++utdemir Hindent breaks TH name captures of operators #412++```haskell+-- https://github.com/commercialhaskell/hindent/issues/412+data T =+ (-)++q = '(-)++data (-)++q = ''(-)+```++utdemir Hindent can not parse empty case statements #414++```haskell+-- https://github.com/commercialhaskell/hindent/issues/414+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE LambdaCase #-}++f1 = case () of {}++f2 = \case {}+```++TimoFreiberg INLINE (and other) pragmas for operators are reformatted without parens #415++```haskell+-- https://github.com/commercialhaskell/hindent/issues/415+{-# NOINLINE (<>) #-}+```++NorfairKing Hindent breaks servant API's #417++```haskell+-- https://github.com/commercialhaskell/hindent/issues/417+type API = api1 :<|> api2+```++andersk Cannot parse @: operator #421++```haskell+-- https://github.com/commercialhaskell/hindent/issues/421+a @: b = a + b++main = print (2 @: 2)+```++andersk Corrupts parenthesized type operators #422++```haskell+-- https://github.com/commercialhaskell/hindent/issues/422+data T a =+ a :@ a++test = (:@)+```++NorfairKing Infix constructor pattern is broken #424++```haskell+-- https://github.com/commercialhaskell/hindent/issues/424+from $ \(author `InnerJoin` post) -> pure ()+```++NorfairKing Hindent can no longer parse type applications code #426++```haskell+-- https://github.com/commercialhaskell/hindent/issues/426+{-# LANGUAGE TypeApplications #-}++f :: Num a => a+f = id++x = f @Int 12+```++michalrus Multiline `GHC.TypeLits.Symbol`s are being broken #451++```haskell+-- https://github.com/commercialhaskell/hindent/issues/451+import GHC.TypeLits (Symbol)++data X (sym :: Symbol)+ deriving (Typeable)++type Y = X "abc\n\n\ndef"+```++DavidEichmann Existential Quantification reordered #443++```haskell+-- https://github.com/commercialhaskell/hindent/issues/443+{-# LANGUAGE ExistentialQuantification #-}++data D =+ forall a b c. D a+ b+ c+```+ # MINIMAL pragma Monad example@@ -1171,15 +1355,6 @@ class A where {-# MINIMAL averylongnamewithnoparticularmeaning | ananotherverylongnamewithnomoremeaning #-}-```--NorfairKing Do as left-hand side of an infix operation #296--```haskell-block =- do ds <- inBraces $ inWhiteSpace declarations- return $ Block ds- <?> "block" ``` # Behaviour checks
elisp/hindent.el view
@@ -1,325 +1,309 @@-;;; hindent.el --- Indent haskell code using the "hindent" program - -;; Copyright (c) 2014 Chris Done. All rights reserved. - -;; Author: Chris Done <chrisdone@gmail.com> -;; URL: https://github.com/chrisdone/hindent -;; Package-Requires: ((cl-lib "0.5")) - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides a minor mode and commands for easily using the "hindent" -;; program to reformat Haskell code. - -;; Add `hindent-mode' to your `haskell-mode-hook' and use the provided -;; keybindings as needed. Set `hindent-reformat-buffer-on-save' to -;; `t' globally or in local variables to have your code automatically -;; reformatted. - -;;; Code: - -(require 'cl-lib) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customization properties - -(defgroup hindent nil - "Integration with the \"hindent\" reformatting program." - :prefix "hindent-" - :group 'haskell) - -(defcustom hindent-style - nil - "The style to use for formatting. - -For hindent versions lower than 5, you must set this to a non-nil string." - :group 'hindent - :type 'string - :safe #'stringp) - -(make-obsolete-variable 'hindent-style nil "hindent 5") - - -(defcustom hindent-process-path - "hindent" - "Location where the hindent executable is located." - :group 'hindent - :type 'string - :safe #'stringp) - -(defcustom hindent-line-length - 80 - "Optionally override the line length." - :group 'hindent - :type '(choice (const :tag "Default: 80" 80) - (integer :tag "Override" 120)) - :safe (lambda (val) (or (integerp val) (not val)))) - -(defcustom hindent-indent-size - 2 - "Optionally override the indent size." - :group 'hindent - :type '(choice (const :tag "Default: 2" 2) - (integer :tag "Override" 4)) - :safe (lambda (val) (or (integerp val) (not val)))) - -(defcustom hindent-reformat-buffer-on-save nil - "Set to t to run `hindent-reformat-buffer' when a buffer in `hindent-mode' is saved." - :group 'hindent - :type 'boolean - :safe #'booleanp) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Minor mode - -(defvar hindent-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [remap indent-region] #'hindent-reformat-region) - (define-key map [remap fill-paragraph] #'hindent-reformat-decl-or-fill) - map) - "Keymap for `hindent-mode'.") - -;;;###autoload -(define-minor-mode hindent-mode - "Indent code with the hindent program. - -Provide the following keybindings: - -\\{hindent-mode-map}" - :init-value nil - :keymap hindent-mode-map - :lighter " HI" - :group 'hindent - :require 'hindent - (if hindent-mode - (add-hook 'before-save-hook 'hindent--before-save nil t) - (remove-hook 'before-save-hook 'hindent--before-save t))) - -(defun hindent--before-save () - "Optionally reformat the buffer on save." - (when hindent-reformat-buffer-on-save - (hindent-reformat-buffer))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Interactive functions - -;;;###autoload -(defun hindent-reformat-decl () - "Re-format the current declaration. - -The declaration is parsed and pretty printed. Comments are -preserved, although placement may be funky." - (interactive) - (let ((start-end (hindent-decl-points))) - (when start-end - (let ((beg (car start-end)) - (end (cdr start-end))) - (hindent-reformat-region beg end t))))) - -;;;###autoload -(defun hindent-reformat-buffer () - "Reformat the whole buffer." - (interactive) - (hindent-reformat-region (point-min) - (point-max))) - -;;;###autoload -(defun hindent-reformat-decl-or-fill (justify) - "Re-format current declaration, or fill paragraph. - -Fill paragraph if in a comment, otherwise reformat the current -declaration. When filling, the prefix argument JUSTIFY will -cause the text to be justified, as per `fill-paragraph'." - (interactive (progn - ;; Copied from `fill-paragraph' - (barf-if-buffer-read-only) - (list (if current-prefix-arg 'full)))) - (if (hindent-in-comment) - (fill-paragraph justify t) - (hindent-reformat-decl))) - -;;;###autoload -(defun hindent-reformat-region (beg end &optional drop-newline) - "Reformat the region from BEG to END, accounting for indentation. - -If DROP-NEWLINE is non-nil, don't require a newline at the end of -the file." - (interactive "r") - (if (= (save-excursion (goto-char beg) - (line-beginning-position)) - beg) - (hindent-reformat-region-as-is beg end drop-newline) - (let* ((column (- beg (line-beginning-position))) - (string (buffer-substring-no-properties beg end)) - (new-string (with-temp-buffer - (insert (make-string column ? ) string) - (hindent-reformat-region-as-is (point-min) - (point-max) - drop-newline) - (delete-region (point-min) (1+ column)) - (buffer-substring (point-min) - (point-max))))) - (save-excursion - (goto-char beg) - (delete-region beg end) - (insert new-string))))) - -;;;###autoload -(define-obsolete-function-alias 'hindent/reformat-decl 'hindent-reformat-decl) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal library - -(defun hindent-reformat-region-as-is (beg end &optional drop-newline) - "Reformat the given region from BEG to END as-is. - -This is the place where hindent is actually called. - -If DROP-NEWLINE is non-nil, don't require a newline at the end of -the file." - (let* ((original (current-buffer)) - (orig-str (buffer-substring-no-properties beg end))) - (with-temp-buffer - (let ((temp (current-buffer))) - (with-current-buffer original - (let ((ret (apply #'call-process-region - (append (list beg - end - hindent-process-path - nil ; delete - temp ; output - nil) - (hindent-extra-arguments))))) - (cond - ((= ret 1) - (let ((error-string - (with-current-buffer temp - (let ((string (progn (goto-char (point-min)) - (buffer-substring (line-beginning-position) - (line-end-position))))) - string)))) - (if (string= error-string "hindent: Parse error: EOF") - (message "language pragma") - (error error-string)))) - ((= ret 0) - (let* ((last-decl (= end (point-max))) - (new-str (with-current-buffer temp - (when (and drop-newline (not last-decl)) - (goto-char (point-max)) - (when (looking-back "\n" (1- (point))) - (delete-char -1))) - (buffer-string)))) - (if (not (string= new-str orig-str)) - (let ((line (line-number-at-pos)) - (col (current-column))) - (delete-region beg - end) - (let ((new-start (point))) - (insert new-str) - (let ((new-end (point))) - (goto-char (point-min)) - (forward-line (1- line)) - (goto-char (+ (line-beginning-position) col)) - (when (looking-back "^[ ]+" (line-beginning-position)) - (back-to-indentation)) - (delete-trailing-whitespace new-start new-end))) - (message "Formatted.")) - (message "Already formatted."))))))))))) - -(defun hindent-decl-points () - "Get the start and end position of the current declaration. - -This assumes that declarations start at column zero and that the -rest is always indented by one space afterwards, so Template -Haskell uses with it all being at column zero are not expected to -work." - (cond - ;; If we're in a block comment spanning multiple lines then let's - ;; see if it starts at the beginning of the line (or if any comment - ;; is at the beginning of the line, we don't care to treat it as a - ;; proper declaration. - ((and (hindent-in-comment) - (save-excursion (goto-char (line-beginning-position)) - (hindent-in-comment))) - nil) - ((save-excursion - (goto-char (line-beginning-position)) - (or (looking-at "^-}$") - (looking-at "^{-$"))) - nil) - ;; Otherwise we just do our line-based hack. - (t - (save-excursion - (let ((start - (or (cl-letf - (((symbol-function 'jump) - #'(lambda () - (search-backward-regexp "^[^ \n]" nil t 1) - (cond - ((save-excursion (goto-char (line-beginning-position)) - (looking-at "|]")) - (jump)) - (t (unless (or (looking-at "^-}$") - (looking-at "^{-$")) - (point))))))) - (goto-char (line-end-position)) - (jump)) - 0)) - (end - (progn - (goto-char (1+ (point))) - (or (cl-letf - (((symbol-function 'jump) - #'(lambda () - (when (search-forward-regexp "[\n]+[^ \n]" nil t 1) - (cond - ((save-excursion (goto-char (line-beginning-position)) - (looking-at "|]")) - (jump)) - (t (forward-char -1) - (search-backward-regexp "[^\n ]" nil t) - (forward-char) - (point))))))) - (jump)) - (point-max))))) - (cons start end)))))) - -(defun hindent-in-comment () - "Are we currently in a comment?" - (save-excursion - (when (and (= (line-end-position) - (point)) - (/= (line-beginning-position) (point))) - (forward-char -1)) - (and - (elt (syntax-ppss) 4) - ;; Pragmas {-# SPECIALIZE .. #-} etc are not to be treated as - ;; comments, even though they are highlighted as such - (not (save-excursion (goto-char (line-beginning-position)) - (looking-at "{-# ")))))) - -(defun hindent-extra-arguments () - "Extra command line arguments for the hindent invocation." - (append - (when (boundp 'haskell-language-extensions) - haskell-language-extensions) - (when hindent-style - (list "--style" hindent-style)))) - -(provide 'hindent) - -;;; hindent.el ends here +;;; hindent.el --- Indent haskell code using the "hindent" program++;; Copyright (c) 2014 Chris Done. All rights reserved.++;; Author: Chris Done <chrisdone@gmail.com>+;; URL: https://github.com/chrisdone/hindent+;; Package-Requires: ((cl-lib "0.5"))++;; This file is free software; you can redistribute it and/or modify+;; it under the terms of the GNU General Public License as published by+;; the Free Software Foundation; either version 3, or (at your option)+;; any later version.++;; This file is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with this program. If not, see <http://www.gnu.org/licenses/>.++;;; Commentary:++;; Provides a minor mode and commands for easily using the "hindent"+;; program to reformat Haskell code.++;; Add `hindent-mode' to your `haskell-mode-hook' and use the provided+;; keybindings as needed. Set `hindent-reformat-buffer-on-save' to+;; `t' globally or in local variables to have your code automatically+;; reformatted.++;;; Code:++(require 'cl-lib)++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Customization properties++(defgroup hindent nil+ "Integration with the \"hindent\" reformatting program."+ :prefix "hindent-"+ :group 'haskell)++(defcustom hindent-style+ nil+ "The style to use for formatting.++For hindent versions lower than 5, you must set this to a non-nil string."+ :group 'hindent+ :type 'string+ :safe #'stringp)++(make-obsolete-variable 'hindent-style nil "hindent 5")+++(defcustom hindent-process-path+ "hindent"+ "Location where the hindent executable is located."+ :group 'hindent+ :type 'string+ :safe #'stringp)++(defcustom hindent-reformat-buffer-on-save nil+ "Set to t to run `hindent-reformat-buffer' when a buffer in `hindent-mode' is saved."+ :group 'hindent+ :type 'boolean+ :safe #'booleanp)++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Minor mode++(defvar hindent-mode-map+ (let ((map (make-sparse-keymap)))+ (define-key map [remap indent-region] #'hindent-reformat-region)+ (define-key map [remap fill-paragraph] #'hindent-reformat-decl-or-fill)+ map)+ "Keymap for `hindent-mode'.")++;;;###autoload+(define-minor-mode hindent-mode+ "Indent code with the hindent program.++Provide the following keybindings:++\\{hindent-mode-map}"+ :init-value nil+ :keymap hindent-mode-map+ :lighter " HI"+ :group 'hindent+ :require 'hindent+ (if hindent-mode+ (add-hook 'before-save-hook 'hindent--before-save nil t)+ (remove-hook 'before-save-hook 'hindent--before-save t)))++(defun hindent--before-save ()+ "Optionally reformat the buffer on save."+ (when hindent-reformat-buffer-on-save+ (hindent-reformat-buffer)))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Interactive functions++;;;###autoload+(defun hindent-reformat-decl ()+ "Re-format the current declaration.++The declaration is parsed and pretty printed. Comments are+preserved, although placement may be funky."+ (interactive)+ (let ((start-end (hindent-decl-points)))+ (when start-end+ (let ((beg (car start-end))+ (end (cdr start-end)))+ (hindent-reformat-region beg end t)))))++;;;###autoload+(defun hindent-reformat-buffer ()+ "Reformat the whole buffer."+ (interactive)+ (hindent-reformat-region (point-min)+ (point-max)))++;;;###autoload+(defun hindent-reformat-decl-or-fill (justify)+ "Re-format current declaration, or fill paragraph.++Fill paragraph if in a comment, otherwise reformat the current+declaration. When filling, the prefix argument JUSTIFY will+cause the text to be justified, as per `fill-paragraph'."+ (interactive (progn+ ;; Copied from `fill-paragraph'+ (barf-if-buffer-read-only)+ (list (if current-prefix-arg 'full))))+ (if (hindent-in-comment)+ (fill-paragraph justify t)+ (hindent-reformat-decl)))++;;;###autoload+(defun hindent-reformat-region (beg end &optional drop-newline)+ "Reformat the region from BEG to END, accounting for indentation.++If DROP-NEWLINE is non-nil, don't require a newline at the end of+the file."+ (interactive "r")+ (if (= (save-excursion (goto-char beg)+ (line-beginning-position))+ beg)+ (hindent-reformat-region-as-is beg end drop-newline)+ (let* ((column (- beg (line-beginning-position)))+ (string (buffer-substring-no-properties beg end))+ (new-string (with-temp-buffer+ (insert (make-string column ? ) string)+ (hindent-reformat-region-as-is (point-min)+ (point-max)+ drop-newline)+ (delete-region (point-min) (1+ column))+ (buffer-substring (point-min)+ (point-max)))))+ (save-excursion+ (goto-char beg)+ (delete-region beg end)+ (insert new-string)))))++;;;###autoload+(define-obsolete-function-alias 'hindent/reformat-decl 'hindent-reformat-decl)+++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Internal library++(defun hindent-reformat-region-as-is (beg end &optional drop-newline)+ "Reformat the given region from BEG to END as-is.++This is the place where hindent is actually called.++If DROP-NEWLINE is non-nil, don't require a newline at the end of+the file."+ (let* ((original (current-buffer))+ (orig-str (buffer-substring-no-properties beg end)))+ (with-temp-buffer+ (let ((temp (current-buffer)))+ (with-current-buffer original+ (let ((ret (apply #'call-process-region+ (append (list beg+ end+ hindent-process-path+ nil ; delete+ temp ; output+ nil)+ (hindent-extra-arguments)))))+ (cond+ ((= ret 1)+ (let ((error-string+ (with-current-buffer temp+ (let ((string (progn (goto-char (point-min))+ (buffer-substring (line-beginning-position)+ (line-end-position)))))+ string))))+ (if (string= error-string "hindent: Parse error: EOF")+ (message "language pragma")+ (error error-string))))+ ((= ret 0)+ (let* ((last-decl (= end (point-max)))+ (new-str (with-current-buffer temp+ (when (and drop-newline (not last-decl))+ (goto-char (point-max))+ (when (looking-back "\n" (1- (point)))+ (delete-char -1)))+ (buffer-string))))+ (if (not (string= new-str orig-str))+ (let ((line (line-number-at-pos))+ (col (current-column)))+ (delete-region beg+ end)+ (let ((new-start (point)))+ (insert new-str)+ (let ((new-end (point)))+ (goto-char (point-min))+ (forward-line (1- line))+ (goto-char (+ (line-beginning-position) col))+ (when (looking-back "^[ ]+" (line-beginning-position))+ (back-to-indentation))+ (delete-trailing-whitespace new-start new-end)))+ (message "Formatted."))+ (message "Already formatted.")))))))))))++(defun hindent-decl-points ()+ "Get the start and end position of the current declaration.++This assumes that declarations start at column zero and that the+rest is always indented by one space afterwards, so Template+Haskell uses with it all being at column zero are not expected to+work."+ (cond+ ;; If we're in a block comment spanning multiple lines then let's+ ;; see if it starts at the beginning of the line (or if any comment+ ;; is at the beginning of the line, we don't care to treat it as a+ ;; proper declaration.+ ((and (hindent-in-comment)+ (save-excursion (goto-char (line-beginning-position))+ (hindent-in-comment)))+ nil)+ ((save-excursion+ (goto-char (line-beginning-position))+ (or (looking-at "^-}$")+ (looking-at "^{-$")))+ nil)+ ;; Otherwise we just do our line-based hack.+ (t+ (save-excursion+ (let ((start+ (or (cl-letf+ (((symbol-function 'jump)+ #'(lambda ()+ (search-backward-regexp "^[^ \n]" nil t 1)+ (cond+ ((save-excursion (goto-char (line-beginning-position))+ (looking-at "|]"))+ (jump))+ (t (unless (or (looking-at "^-}$")+ (looking-at "^{-$"))+ (point)))))))+ (goto-char (line-end-position))+ (jump))+ 0))+ (end+ (progn+ (goto-char (1+ (point)))+ (or (cl-letf+ (((symbol-function 'jump)+ #'(lambda ()+ (when (search-forward-regexp "[\n]+[^ \n]" nil t 1)+ (cond+ ((save-excursion (goto-char (line-beginning-position))+ (looking-at "|]"))+ (jump))+ (t (forward-char -1)+ (search-backward-regexp "[^\n ]" nil t)+ (forward-char)+ (point)))))))+ (jump))+ (point-max)))))+ (cons start end))))))++(defun hindent-in-comment ()+ "Are we currently in a comment?"+ (save-excursion+ (when (and (= (line-end-position)+ (point))+ (/= (line-beginning-position) (point)))+ (forward-char -1))+ (and+ (elt (syntax-ppss) 4)+ ;; Pragmas {-# SPECIALIZE .. #-} etc are not to be treated as+ ;; comments, even though they are highlighted as such+ (not (save-excursion (goto-char (line-beginning-position))+ (looking-at "{-# "))))))++(defun hindent-extra-arguments ()+ "Extra command line arguments for the hindent invocation."+ (append+ (when (boundp 'haskell-language-extensions)+ haskell-language-extensions)+ (when hindent-style+ (list "--style" hindent-style))))++(provide 'hindent)++;;; hindent.el ends here
hindent.cabal view
@@ -1,5 +1,5 @@ name: hindent-version: 5.2.3+version: 5.2.4 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. .@@ -34,7 +34,7 @@ HIndent.Pretty build-depends: base >= 4.7 && <5 , containers- , haskell-src-exts >= 1.18+ , haskell-src-exts >= 1.19 , monad-loops , mtl , bytestring
src/HIndent.hs view
@@ -68,7 +68,15 @@ let ls = S8.lines text prefix = findPrefix ls code = unlines' (map (stripPrefix prefix) ls)- in case parseModuleWithComments mode' (UTF8.toString code) of+ exts = readExtensions (UTF8.toString code)+ mode'' = case exts of+ Nothing -> mode'+ Just (Nothing, exts') ->+ mode' { extensions = exts' ++ extensions mode' }+ Just (Just lang, exts') ->+ mode' { baseLanguage = lang+ , extensions = exts' ++ extensions mode' }+ in case parseModuleWithComments mode'' (UTF8.toString code) of ParseOk (m, comments) -> fmap (S.lazyByteString . addPrefix prefix . S.toLazyByteString)@@ -168,7 +176,8 @@ cppLine src = any (`S8.isPrefixOf` src)- ["#if", "#end", "#else", "#define", "#undef", "#elif"]+ ["#if", "#end", "#else", "#define", "#undef", "#elif", "#include", "#error", "#warning"]+ -- Note: #ifdef and #ifndef are handled by #if unlines' :: [(Int, ByteString)] -> (Int, ByteString) unlines' [] = (0, S.empty) unlines' srcs@((line, _):_) =@@ -286,6 +295,7 @@ ,PatternSynonyms -- steals the pattern keyword ,RecursiveDo -- steals the rec keyword ,DoRec -- same+ ,TypeApplications -- since GHC 8 and haskell-src-exts-1.19 ]
src/HIndent/Pretty.hs view
@@ -359,11 +359,11 @@ (spaced (map pretty args)) PTuple _ boxed pats -> depend (write (case boxed of- Unboxed -> "(#"+ Unboxed -> "(# " Boxed -> "(")) (do commas (map pretty pats) write (case boxed of- Unboxed -> "#)"+ Unboxed -> " #)" Boxed -> ")")) PList _ ps -> brackets (commas (map pretty ps))@@ -415,6 +415,11 @@ PXRPats{} -> pretty' x PVar{} -> pretty' x +-- | Pretty infix application of a name (identifier or symbol).+prettyInfixName :: Name NodeInfo -> Printer ()+prettyInfixName (Ident _ n) = do write "`"; string n; write "`";+prettyInfixName (Symbol _ s) = string s+ -- | Pretty print a name for being an infix operator. prettyInfixOp :: QName NodeInfo -> Printer () prettyInfixOp x =@@ -423,10 +428,26 @@ case n of Ident _ i -> do write "`"; pretty mn; write "."; string i; write "`"; Symbol _ s -> do pretty mn; write "."; string s;+ UnQual _ n -> prettyInfixName n+ Special _ s -> pretty s++prettyQuoteName :: Name NodeInfo -> Printer ()+prettyQuoteName x =+ case x of+ Ident _ i -> string i+ Symbol _ s -> string ("(" ++ s ++ ")")++prettyQuoteQName :: QName NodeInfo -> Printer ()+prettyQuoteQName x =+ case x of+ Qual _ mn n ->+ case n of+ Ident _ i -> do pretty mn; write "."; string i;+ Symbol _ s -> do write "("; pretty mn; write "."; string s; write ")"; UnQual _ n -> case n of- Ident _ i -> string ("`" ++ i ++ "`")- Symbol _ s -> string s+ Ident _ i -> string i+ Symbol _ s -> do write "("; string s; write ")"; Special _ s -> pretty s instance Pretty Type where@@ -455,27 +476,31 @@ Just st -> put st -- | Space out tuples. exp (Tuple _ boxed exps) = do- let horVariant = parensB boxed $ inter (write ", ") (map pretty exps)- verVariant = parensB boxed $ prefixedLined "," (map (depend space . pretty) exps)+ let horVariant = parensHorB boxed $ inter (write ", ") (map pretty exps)+ verVariant = parensVerB boxed $ prefixedLined "," (map (depend space . pretty) exps) mst <- fitsOnOneLine horVariant case mst of Nothing -> verVariant Just st -> put st where- parensB Unboxed = wrap "(#" "#)"- parensB Boxed = parens+ parensHorB Boxed = parens+ parensHorB Unboxed = wrap "(# " " #)"+ parensVerB Boxed = parens+ parensVerB Unboxed = wrap "(#" "#)" -- | Space out tuples. exp (TupleSection _ boxed mexps) = do- let horVariant = parensB boxed $ inter (write ", ") (map (maybe (return ()) pretty) mexps)+ let horVariant = parensHorB boxed $ inter (write ", ") (map (maybe (return ()) pretty) mexps) verVariant =- parensB boxed $ prefixedLined "," (map (maybe (return ()) (depend space . pretty)) mexps)+ parensVerB boxed $ prefixedLined "," (map (maybe (return ()) (depend space . pretty)) mexps) mst <- fitsOnOneLine horVariant case mst of Nothing -> verVariant Just st -> put st where- parensB Unboxed = wrap "(#" "#)"- parensB Boxed = parens+ parensHorB Boxed = parens+ parensHorB Unboxed = wrap "(# " " #)"+ parensVerB Boxed = parens+ parensVerB Unboxed = wrap "(#" "#)" -- | Infix apps, same algorithm as ChrisDone at the moment. exp e@(InfixApp _ a op b) = infixApp e a op b Nothing@@ -509,10 +534,16 @@ case mst of Nothing -> do let (f:args) = flattened- pretty f- newline+ col <- gets psColumn spaces <- getIndentSpaces- indented spaces (lined (map pretty args))+ pretty f+ col' <- gets psColumn+ let diff = col' - col - if col == 0 then spaces else 0+ if diff + 1 <= spaces+ then space+ else newline+ spaces' <- getIndentSpaces+ indented spaces' (lined (map pretty args)) Just st -> put st where flatten (App label' op' arg') = flatten op' ++ [amap (addComments label') arg']@@ -595,8 +626,9 @@ do depend (write "case ") (do pretty e write " of")- newline- indentedBlock (lined (map (withCaseContext True . pretty) alts))+ if null alts+ then write " {}"+ else do indentedBlock (lined (map (withCaseContext True . pretty) alts)) exp (Do _ stmts) = depend (write "do ") (lined (map pretty stmts))@@ -635,10 +667,10 @@ (pretty t) exp (VarQuote _ x) = depend (write "'")- (pretty x)+ (prettyQuoteQName x) exp (TypQuote _ x) = depend (write "''")- (pretty x)+ (prettyQuoteQName x) exp (BracketExp _ b) = pretty b exp (SpliceExp _ s) = pretty s exp (QuasiQuote _ n s) =@@ -648,8 +680,10 @@ write "|")) exp (LCase _ alts) = do write "\\case"- newline- indentedBlock (lined (map (withCaseContext True . pretty) alts))+ if null alts+ then write " {}"+ else do newline+ indentedBlock (lined (map (withCaseContext True . pretty) alts)) exp (MultiIf _ alts) = withCaseContext True@@ -683,6 +717,8 @@ exp (IPVar _ q) = pretty q exp (Con _ q) = case q of Special _ Cons{} -> parens (pretty q)+ Qual _ _ (Symbol _ _) -> parens (pretty q)+ UnQual _ (Symbol _ _) -> parens (pretty q) _ -> pretty q exp x@XTag{} = pretty' x@@ -767,14 +803,7 @@ decl (FunBind _ matches) = lined (map pretty matches) decl (ClassDecl _ ctx dhead fundeps decls) =- do depend (write "class ")- (withCtx ctx- (depend (do pretty dhead)- (depend (unless (null fundeps)- (do write " | "- commas (map pretty fundeps)))- (unless (null (fromMaybe [] decls))- (write " where")))))+ do classHead ctx dhead fundeps decls unless (null (fromMaybe [] decls)) (do newline indentedBlock (lined (map pretty (fromMaybe [] decls))))@@ -880,7 +909,7 @@ Nothing -> return () Just (ActiveFrom _ x) -> write ("[" ++ show x ++ "] ") Just (ActiveUntil _ x) -> write ("[~" ++ show x ++ "] ")- pretty name+ prettyQuoteQName name write " #-}" decl (MinimalPragma _ (Just formula)) =@@ -888,6 +917,30 @@ depend (write "MINIMAL ") $ pretty formula decl x' = pretty' x' +classHead+ :: Maybe (Context NodeInfo)+ -> DeclHead NodeInfo+ -> [FunDep NodeInfo]+ -> Maybe [ClassDecl NodeInfo]+ -> Printer ()+classHead ctx dhead fundeps decls = shortHead `ifFitsOnOneLineOrElse` longHead+ where+ shortHead =+ depend+ (write "class ")+ (withCtx ctx $+ depend+ (pretty dhead)+ (depend (unless (null fundeps) (write " | " >> commas (map pretty fundeps)))+ (unless (null (fromMaybe [] decls)) (write " where"))))+ longHead = do+ depend (write "class ") (withCtx ctx $ pretty dhead)+ newline+ indentedBlock $ do+ depend (write "| ") $ prefixedLined ", " $ map pretty fundeps+ newline+ unless (null (fromMaybe [] decls)) (write "where")+ instance Pretty TypeEqn where prettyInternal (TypeEqn _ in_ out_) = do pretty in_@@ -1059,10 +1112,7 @@ InfixMatch _ pat1 name pats rhs' mbinds -> do depend (do pretty pat1 space- case name of- Ident _ i ->- string ("`" ++ i ++ "`")- Symbol _ s -> string s)+ prettyInfixName name) (do space spaced (map pretty pats)) withCaseContext False (pretty rhs')@@ -1089,7 +1139,7 @@ QualConDecl _ tyvars ctx d -> depend (unless (null (fromMaybe [] tyvars)) (do write "forall "- spaced (map pretty (fromMaybe [] tyvars))+ spaced (map pretty (reverse (fromMaybe [] tyvars))) write ". ")) (withCtx ctx (pretty d))@@ -1176,17 +1226,12 @@ instance Pretty DeclHead where prettyInternal x = case x of- DHead _ name -> pretty name+ DHead _ name -> prettyQuoteName name DHParen _ h -> parens (pretty h) DHInfix _ var name -> do pretty var space- case name of- Ident _ _ -> do- write "`"- pretty name- write "`"- Symbol _ _ -> pretty name+ prettyInfixName name DHApp _ dhead var -> depend (pretty dhead) (do space@@ -1463,9 +1508,9 @@ replicate (i - 1) ',' ++ ")") TupleCon _ Unboxed i ->- string ("(#" +++ string ("(# " ++ replicate (i - 1) ',' ++- "#)")+ " #)") Cons _ -> write ":" UnboxedSingleCon _ -> write "(##)" @@ -1492,14 +1537,43 @@ prettyInternal = pretty' instance Pretty ImportDecl where- prettyInternal = pretty'+ prettyInternal (ImportDecl _ name qualified source safe mpkg mas mspec) = do+ write "import"+ when source $ write " {-# SOURCE #-}"+ when safe $ write " safe"+ when qualified $ write " qualified"+ case mpkg of+ Nothing -> return ()+ Just pkg -> space >> write pkg+ space+ pretty name+ case mas of+ Nothing -> return ()+ Just asName -> do+ space+ write "as "+ pretty asName+ case mspec of+ Nothing -> return ()+ Just spec -> pretty spec instance Pretty ModuleName where prettyInternal (ModuleName _ name) = write name instance Pretty ImportSpecList where- prettyInternal = pretty'+ prettyInternal (ImportSpecList _ hiding spec) = do+ when hiding $ write " hiding"+ let verVar = do+ space+ parens (commas (map pretty spec))+ let horVar = do+ newline+ indentedBlock+ (do depend (write "( ") (prefixedLined ", " (map pretty spec))+ newline+ write ")")+ verVar `ifFitsOnOneLineOrElse` horVar instance Pretty ImportSpec where prettyInternal = pretty'@@ -1660,10 +1734,7 @@ match (InfixMatch _ pat1 name pats rhs' mbinds) = do depend (do pretty pat1 space- case name of- Ident _ i ->- string ("`" ++ i ++ "`")- Symbol _ s -> string s)+ prettyInfixName name) (do space spaced (map pretty pats)) withCaseContext False (pretty rhs')@@ -1763,6 +1834,10 @@ typ (TyPromoted _ (PromotedCon _ _ tname)) = do write "'" pretty tname+typ (TyPromoted _ (PromotedString _ _ raw)) = do+ do write "\""+ string raw+ write "\"" typ ty@TyPromoted{} = pretty' ty typ (TySplice _ splice) = pretty splice typ (TyWildCard _ name) =@@ -1911,7 +1986,7 @@ (map (depend space . pretty) fields)) write " }") conDecl (ConDecl _ name bangty) =- depend (do pretty name+ depend (do prettyQuoteName name unless (null bangty) space) (lined (map pretty bangty)) conDecl (InfixConDecl _ a f b) =
src/main/Main.hs view
@@ -30,6 +30,7 @@ import Paths_hindent (version) import qualified System.Directory as IO import System.Environment+import System.Exit (exitWith) import qualified System.IO as IO import Text.Read @@ -39,24 +40,30 @@ args <- getArgs config <- getConfig case consume (options config) (map T.pack args) of- Succeeded (style, exts, mfilepath) ->+ Succeeded (style, exts, action, mfilepath) -> case mfilepath of Just filepath -> do text <- S.readFile filepath case reformat style (Just exts) mfilepath text of Left e -> error e- Right out -> unless (L8.fromStrict text == S.toLazyByteString out) $ do- tmpDir <- IO.getTemporaryDirectory- (fp, h) <- IO.openTempFile tmpDir "hindent.hs"- L8.hPutStr h (S.toLazyByteString out)- IO.hFlush h- IO.hClose h- let exdev e =- if ioe_errno e == Just ((\(Errno a) -> a) eXDEV)- then IO.copyFile fp filepath >> IO.removeFile fp- else throw e- IO.copyPermissions filepath fp- IO.renameFile fp filepath `catch` exdev+ Right out ->+ unless (L8.fromStrict text == S.toLazyByteString out) $+ case action of+ Validate -> do+ IO.putStrLn $ filepath ++ " is not formatted"+ exitWith (ExitFailure 1)+ Reformat -> do+ tmpDir <- IO.getTemporaryDirectory+ (fp, h) <- IO.openTempFile tmpDir "hindent.hs"+ L8.hPutStr h (S.toLazyByteString out)+ IO.hFlush h+ IO.hClose h+ let exdev e =+ if ioe_errno e == Just ((\(Errno a) -> a) eXDEV)+ then IO.copyFile fp filepath >> IO.removeFile fp+ else throw e+ IO.copyPermissions filepath fp+ IO.renameFile fp filepath `catch` exdev Nothing -> L8.interact (either error S.toLazyByteString . reformat style (Just exts) Nothing . L8.toStrict)@@ -65,6 +72,26 @@ Failed (Wrap (Stopped Help) _) -> putStrLn (help defaultConfig) _ -> error (help defaultConfig) +-- -- | Main entry point.+-- testformat :: [String] -> IO ()+-- testformat args = do+-- config <- getConfig+-- case consume (options config) (map T.pack args) of+-- Succeeded (style, exts, mfilepath) ->+-- case mfilepath of+-- Just filepath -> do+-- text <- S.readFile filepath+-- case reformat style (Just exts) text of+-- Left e -> error (filepath ++ ": " ++ e)+-- Right out -> L8.putStrLn (S.toLazyByteString out)+-- Nothing ->+-- L8.interact+-- (either error S.toLazyByteString . reformat style (Just exts) . L8.toStrict)+-- Failed (Wrap (Stopped Version) _) ->+-- putStrLn ("hindent " ++ showVersion version)+-- Failed (Wrap (Stopped Help) _) -> putStrLn (help defaultConfig)+-- _ -> error (help defaultConfig)+ -- | Read config from a config file, or return 'defaultConfig'. getConfig :: IO Config getConfig = do@@ -99,11 +126,13 @@ | Help deriving (Show) +data Action = Validate | Reformat+ -- | Program options. options :: Monad m- => Config -> Consumer [Text] (Option Stoppers) m (Config, [Extension], Maybe FilePath)-options config = ver *> ((,,) <$> style <*> exts <*> file)+ => Config -> Consumer [Text] (Option Stoppers) m (Config, [Extension], Action, Maybe FilePath)+options config = ver *> ((,,,) <$> style <*> exts <*> action <*> file) where ver = stop (flag "version" "Print the version" Version) *>@@ -136,6 +165,8 @@ optional (constant "--sort-imports" "Sort imports in groups" True <|> constant "--no-sort-imports" "Don't sort imports" False)+ action = fromMaybe Reformat <$>+ optional (constant "--validate" "Check if files are formatted without changing them" Validate) makeStyle s mlen tabs trailing imports = s { configMaxColumns = fromMaybe (configMaxColumns s) mlen