hindent 4.5.5 → 4.5.6
raw patch · 4 files changed
+207/−142 lines, 4 files
Files
- elisp/hindent.el +158/−123
- hindent.cabal +2/−1
- src/HIndent/Pretty.hs +28/−12
- src/main/Main.hs +19/−6
elisp/hindent.el view
@@ -23,6 +23,32 @@ (require 'cl-lib) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; 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 'haskell+ :require 'hindent)++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Customization properties+ (defcustom hindent-style "fundamental" "The style to use for formatting."@@ -37,68 +63,29 @@ :type 'string :safe #'stringp) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Interactive functions+ ;;;###autoload-(defun hindent/reformat-decl ()+(defun hindent-reformat-decl () "Re-format the current declaration by parsing and pretty printing it. Comments are preserved, although placement may be funky." (interactive) (let ((start-end (hindent-decl-points))) (when start-end- (let ((original (current-buffer))- (orig-str (buffer-substring-no-properties (car start-end)- (cdr start-end))))- (with-temp-buffer- (let ((temp (current-buffer)))- (with-current-buffer original- (let ((ret (apply #'call-process-region- (append (list (car start-end)- (cdr start-end)- hindent-process-path- nil ; delete- temp ; output- nil- "--style"- hindent-style)- (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 ((new-str (with-current-buffer temp- (buffer-string))))- (if (not (string= new-str orig-str))- (let ((line (line-number-at-pos))- (col (current-column)))- (delete-region (car start-end)- (cdr start-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 "^[ ]+")- (back-to-indentation))- (delete-trailing-whitespace new-start new-end)))- (message "Formatted."))- (message "Already formatted.")))))))))))))+ (let ((beg (car start-end))+ (end (cdr start-end)))+ (hindent-reformat-region beg end))))) -(defun hindent-extra-arguments ()- "Pass in extra arguments, such as extensions and optionally-other things later."- (if (boundp 'haskell-language-extensions)- haskell-language-extensions- '()))+;;;###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. @@ -112,6 +99,86 @@ (fill-paragraph justify t) (hindent/reformat-decl))) +;;;###autoload+(defun hindent-reformat-region (beg end)+ "Reformat the given region, accounting for indentation."+ (interactive "r")+ (if (= (save-excursion (goto-char beg)+ (line-beginning-position))+ beg)+ (hindent-reformat-region-as-is beg end)+ (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))+ (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+(defun hindent/reformat-decl ()+ "See `hindent-reformat-decl'."+ (hindent-reformat-decl))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Internal library++(defun hindent-reformat-region-as-is (beg end)+ "Reformat the given region as-is.++This is the place where hindent is actually called."+ (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+ "--style"+ hindent-style)+ (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 ((new-str (with-current-buffer temp+ (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 "^[ ]+")+ (back-to-indentation))+ (delete-trailing-whitespace new-start new-end)))+ (message "Formatted."))+ (message "Already formatted.")))))))))))+ (defun hindent-decl-points (&optional use-line-comments) "Get the start and end position of the current declaration. This assumes that declarations start at column zero@@ -136,33 +203,38 @@ ;; 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)))))+ (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 ()@@ -185,49 +257,12 @@ (not (save-excursion (goto-char (line-beginning-position)) (looking-at "{-# ")))))) -(defun hindent-reformat-region ()- (interactive)- (save-excursion- (save-restriction- (if (> (point) (mark))- (exchange-point-and-mark))- (while (< (point) (mark))- (hindent/reformat-decl)- (let ((dpoints (hindent-decl-points)))- (if dpoints ;; if we're in a comment hindent-decl-points returns nil- (goto-char (min (mark) (+ 1 (cdr dpoints))))- (forward-line 1)))- ;; might be on a blank line (which associates with the previous decl- (if (search-forward-regexp "^[\\s-]*[^\\]" (mark) t)- nil- (goto-char (mark)))))))--(defun hindent-reformat-buffer ()- (interactive)- (save-excursion- (save-restriction- (mark-whole-buffer)- (hindent-reformat-region))))--(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 'haskell- :require 'hindent)+(defun hindent-extra-arguments ()+ "Pass in extra arguments, such as extensions and optionally+other things later."+ (if (boundp 'haskell-language-extensions)+ haskell-language-extensions+ '())) (provide 'hindent)
hindent.cabal view
@@ -1,5 +1,5 @@ name: hindent-version: 4.5.5+version: 4.5.6 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. .@@ -60,6 +60,7 @@ , haskell-src-exts >= 1.16 , applicative-quoters , ghc-prim+ , directory executable hindent-generate-tests hs-source-dirs: src/main
src/HIndent/Pretty.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -1181,18 +1182,33 @@ prettyInternal x = case x of Module _ mayModHead pragmas imps decls ->- do case mayModHead of- Nothing -> return ()- Just modHead -> do- pretty modHead- unless (null pragmas && null imps && null decls) $ newline- inter newline (map pretty pragmas)- inter newline (map pretty imps)- inter newline (map pretty decls)- XmlPage{} ->- error "FIXME: No implementation for XmlPage."- XmlHybrid{} ->- error "FIXME: No implementation for XmlHybrid."+ inter (do newline+ newline)+ (mapMaybe (\(isNull,r) ->+ if isNull+ then Nothing+ else Just r)+ [(null pragmas,inter newline (map pretty pragmas))+ ,(case mayModHead of+ Nothing -> (True,return ())+ Just modHead -> (False,pretty modHead))+ ,(null imps,inter newline (map pretty imps))+ ,(null decls+ ,interOf newline+ (map (\case+ r@TypeSig{} -> (1,pretty r)+ r -> (2,pretty r))+ decls))])+ where interOf i ((c,p):ps) =+ case ps of+ [] -> p+ _ ->+ do p+ replicateM_ c i+ interOf i ps+ interOf _ [] = return ()+ XmlPage{} -> error "FIXME: No implementation for XmlPage."+ XmlHybrid{} -> error "FIXME: No implementation for XmlHybrid." instance Pretty Bracket where prettyInternal x =
src/main/Main.hs view
@@ -24,7 +24,9 @@ import GHC.Tuple import Language.Haskell.Exts.Annotated hiding (Style,style) import Paths_hindent (version)+import System.Directory import System.Environment+import System.IO import Text.Read -- | Main entry point.@@ -32,10 +34,20 @@ main = do args <- getArgs case consume options (map T.pack args) of- Succeeded (style,exts) ->- T.interact- (either error T.toLazyText .- reformat style (Just exts))+ Succeeded (style,exts,mfilepath) ->+ case mfilepath of+ Just filepath ->+ do text <- T.readFile filepath+ tmpDir <- getTemporaryDirectory+ (fp,h) <- openTempFile tmpDir "hindent.hs"+ T.hPutStrLn+ h+ (either error T.toLazyText (reformat style (Just exts) text))+ hFlush h+ hClose h+ renameFile fp filepath+ Nothing ->+ T.interact (either error T.toLazyText . reformat style (Just exts)) Failed (Wrap (Stopped Version) _) -> putStrLn ("hindent " ++ showVersion version) _ ->@@ -47,10 +59,10 @@ -- | Program options. options :: Monad m- => Consumer [Text] (Option Stoppers) m (Style,[Extension])+ => Consumer [Text] (Option Stoppers) m (Style,[Extension],Maybe FilePath) options = ver *>- [i|(,) style exts|]+ [i|(,,) style exts file|] where ver = stop (flag "version" "Print the version" Version) style =@@ -73,6 +85,7 @@ Just len -> s {styleDefConfig = (styleDefConfig s) {configMaxColumns = len}}+ file = fmap (fmap T.unpack) (optional (anyString "[<filename>]")) -------------------------------------------------------------------------------- -- Extensions stuff stolen from hlint