diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,199 @@ +# hindent [![Hackage](https://img.shields.io/hackage/v/hindent.svg?style=flat)](https://hackage.haskell.org/package/hindent) + +Extensible Haskell pretty printer. Both a library and an +executable. Currently a work in progress (see +[FIXME items](https://github.com/chrisdone/hindent/blob/master/src/HIndent/Pretty.hs)). + +[Haddock API documentation](http://chrisdone.github.io/hindent/). + +## Install + + $ cabal install hindent + +## Usage + + $ hindent + hindent: arguments: --style [fundamental|chris-done|johan-tibell|gibiansky] + +## Emacs + +In +[elisp/hindent.el](https://github.com/chrisdone/hindent/blob/master/elisp/hindent.el), +there is the function `hindent/reformat-decl` which you can run with +`M-x hindent/reformat-decl`. Or alternatively define a keybinding, +e.g.: + +``` lisp +(define-key haskell-mode-map (kbd "C-c i") 'hindent/reformat-decl) +``` + +By default it uses the style called `fundamental`, if you want to use +another, `johan-tibell`, run `M-x customize-variable +hindent-style`. If you want to configure per-project, make a file +called `.dir-locals.el` in the project root directory like this: + +``` lisp +((nil . ((hindent-style . "johan-tibell")))) +``` + +## Vim + +Basic support is provided through [vim/hindent.vim](https://github.com/chrisdone/hindent/blob/master/vim/hindent.vim), +which sets hindent as the formatter used by `gq` for haskell files. The formatting style +defaults to `fundamental` but can be configured by setting `g:hindent_style` to the desired style. + +Note that unlike in emacs you have to take care of selecting a sensible buffer region as input to +hindent yourself. If that is too much trouble you can try [vim-textobj-haskell](https://github.com/gilligan/vim-textobj-haskell) which provides a text object for top level bindings. + +## Contributing your own printer style + +This package comes with a basic fundamental pretty printer, which is +probably not desirable to use. + +It comes with other styles implemented on top of this fundamental +printer, in the modules in `HIndent.Styles.*`. + +Make a module `HIndent.Styles.YourName` in which to place the printer. + +To define your own, see +[HIndent.Styles.Fundamental](https://github.com/chrisdone/hindent/blob/master/src/HIndent/Styles/Fundamental.hs) +for a starting point. This module defines a blank style, adds no +additional extensions. Customizations are specified via the +`styleExtenders` property. See +[HIndent.Styles.ChrisDone](https://github.com/chrisdone/hindent/blob/master/src/HIndent/Styles/ChrisDone.hs) +for an example of a non-trivial style. + +Useful combinators can be found in +[HIndent.Pretty](https://github.com/chrisdone/hindent/blob/master/src/HIndent/Pretty.hs) +for defining printers. When you want to use a fundamental printer, use +`prettyNoExt` instead of `pretty`. Comments will still be inserted by +`prettyNoExt`. + +If you want to contribute it to the package, add it to the list of +styles in +[HIndent](https://github.com/chrisdone/hindent/blob/master/src/HIndent.hs) +and export it, and open a pull request. Use +[the Erlang git commit guide](https://github.com/erlang/otp/wiki/Writing-good-commit-messages) +for your commits. + +## Remaining issues + +* Add test suite. +* Flesh out more obscure parts of the AST. +* Improve comment re-insertion. +* Possibly: Support formatting whole modules. +* Implement some operator-specific layouts: e.g. + + Foo <$> foo + <*> bar + <*> mu + +## Example + +Input code: + +``` haskell +foo = do print "OK, go"; foo (foo bar) -- Yep. + (if bar then bob else pif) (case mu {- cool -} zot of + Just x -> return (); Nothing -> do putStrLn "yay"; return 1) bill -- Etc + where potato Cakes {} = 2 * x foo * bar / 5 +``` + +### Fundamental + +This is an intentionally very dumb style that demands extension. + +``` haskell +foo = + do print + "OK, go" + foo + (foo + bar) + (if bar + then bob + else pif) + (case mu {- cool -} + zot of + Just x -> + return + () + Nothing -> + do putStrLn + "yay" + return + 1) + bill -- Etc + where potato Cakes{} = + 2 * x + foo * bar / 5 +``` + +### Johan Tibell + +Documented in +[the style guide](https://github.com/tibbe/haskell-style-guide). +This printer style uses some simple heuristics in deciding when to go +to a new line or not, and custom handling of do, if, case alts, rhs, +etc. + +``` haskell +foo = do + print "OK, go" + foo + (foo bar) + (if bar + then bob + else pif) + (case mu {- cool -} zot of + Just x -> + return () + Nothing -> do + putStrLn "yay" + return 1) + bill -- Etc + where + potato Cakes{} = + 2 * x foo * bar / 5 +``` + +### Chris Done + +My style is documented in +[the style guide](https://github.com/chrisdone/haskell-style-guide). +This printer style uses some simple heuristics in deciding when to go +to a new line or not. + +``` haskell +foo = + do print "OK, go" + foo (foo bar) + (if bar + then bob + else pif) + (case mu {- cool -} zot of + Just x -> return () + Nothing -> + do putStrLn "yay" + return 1) + bill -- Etc + where potato Cakes{} = 2 * x foo * bar / 5 +``` + +### Andrew Gibiansky + +``` haskell +foo = do + print "OK, go" + foo (foo bar) -- Yep. + (if bar + then bob + else pif) (case mu {- cool -} zot of + Just x -> return () + Nothing -> do + putStrLn "yay" + return 1) bill -- Etc + + where + potato Cakes{} = 2 * x foo * bar / 5 +``` diff --git a/elisp/hindent.el b/elisp/hindent.el --- a/elisp/hindent.el +++ b/elisp/hindent.el @@ -1,4 +1,4 @@ -;;; hindent.el --- Haskell indenter. +;;; hindent.el --- Indent haskell code using the "hindent" program ;; Copyright (c) 2014 Chris Done. All rights reserved. @@ -53,11 +53,15 @@ hindent-style))) (cond ((= ret 1) - (error (with-current-buffer temp + (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)))) @@ -150,6 +154,30 @@ ;; comments, even though they are highlighted as such (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)))) (provide 'hindent) diff --git a/hindent.cabal b/hindent.cabal --- a/hindent.cabal +++ b/hindent.cabal @@ -1,5 +1,5 @@ name: hindent -version: 4.1.0 +version: 4.1.1 synopsis: Extensible Haskell pretty printer description: Extensible Haskell pretty printer. Both a library and an executable. . @@ -14,6 +14,7 @@ build-type: Simple cabal-version: >=1.8 data-files: elisp/hindent.el vim/hindent.vim +extra-source-files: README.md library hs-source-dirs: src/ diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -62,7 +62,7 @@ import Data.Int import Data.List import Data.Maybe -import Data.Monoid +import Data.Monoid hiding (Alt) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as LT @@ -690,7 +690,7 @@ do write "\\case" indentSpaces <- getIndentSpaces newline - indented indentSpaces (lined (map pretty alts)) + indented indentSpaces (lined (map (withCaseContext True . pretty) alts)) exp (MultiIf _ alts) = depend (write "if ") (lined (map (\p -> diff --git a/src/HIndent/Styles/Gibiansky.hs b/src/HIndent/Styles/Gibiansky.hs --- a/src/HIndent/Styles/Gibiansky.hs +++ b/src/HIndent/Styles/Gibiansky.hs @@ -184,6 +184,7 @@ exprs _ exp@(InfixApp _ _ (QVarOp _ (UnQual _ (Symbol _ "<*>"))) _) = applicativeExpr exp exprs _ exp@Lambda{} = lambdaExpr exp exprs _ exp@Case{} = caseExpr exp +exprs _ exp@LCase{} = lambdaCaseExpr exp exprs _ (RecUpdate _ exp updates) = recUpdateExpr (pretty exp) updates exprs _ (RecConstr _ qname updates) = recUpdateExpr (pretty qname) updates exprs _ (Tuple _ _ exps) = parens $ inter (write ", ") $ map pretty exps @@ -373,13 +374,26 @@ caseExpr :: Exp NodeInfo -> Printer () caseExpr (Case _ exp alts) = do - allSingle <- and <$> mapM isSingle alts depend (write "case ") $ do pretty exp write " of" newline + writeCaseAlts alts +caseExpr _ = error "Not a case" + +lambdaCaseExpr :: Exp NodeInfo -> Printer () +lambdaCaseExpr (LCase _ alts) = do + write "\\case" + newline + writeCaseAlts alts +lambdaCaseExpr _ = error "Not a lambda case" + + +writeCaseAlts :: [Alt NodeInfo] -> Printer () +writeCaseAlts alts = do + allSingle <- and <$> mapM isSingle alts withCaseContext True $ indented indentSpaces $ if allSingle then do @@ -425,13 +439,14 @@ indented indentSpaces $ depend (write "where ") (pretty binds) -caseExpr _ = error "Not a case" recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer () recUpdateExpr expWriter updates = do expWriter write " " - attemptSingleLine single mult + if null updates + then write "{}" + else attemptSingleLine single mult where single = do @@ -442,7 +457,11 @@ col <- getColumn column col $ do write "{ " - inter (newline >> write ", ") $ map pretty updates + pretty (head updates) + forM_ (tail updates) $ \update -> do + newline + write ", " + pretty update newline write "}" diff --git a/src/HIndent/Styles/JohanTibell.hs b/src/HIndent/Styles/JohanTibell.hs --- a/src/HIndent/Styles/JohanTibell.hs +++ b/src/HIndent/Styles/JohanTibell.hs @@ -47,6 +47,7 @@ ,Extender exp ,Extender guardedRhs ,Extender rhs + ,Extender stmt ,Extender fieldupdate ] ,styleDefConfig = @@ -56,9 +57,20 @@ -------------------------------------------------------------------------------- -- Extenders +-- Do statements need to handle infix expression indentation specially because +-- do x * +-- y +-- is two invalid statements, not one valid infix op. +stmt :: s -> Stmt NodeInfo -> Printer () +stmt _ (Qualifier _ e@(InfixApp _ a op b)) = + do col <- fmap (psColumn . snd) + (sandbox (write "")) + infixApp e a op b (Just col) +stmt _ e = prettyNoExt e + -- | Handle do specially and also space out guards more. rhs :: t -> Rhs NodeInfo -> Printer () -rhs _ x = +rhs s x = case x of UnGuardedRhs _ (Do _ dos) -> swing (write " = do") @@ -71,7 +83,10 @@ do write "|" pretty p) gas)) - _ -> prettyNoExt x + _ -> do inCase <- gets psInsideCase + if inCase + then unguardedalt s x + else unguardedrhs s x -- | Implement dangling right-hand-sides. guardedRhs :: t -> GuardedRhs NodeInfo -> Printer () @@ -88,6 +103,21 @@ (lined (map pretty dos)) guardedRhs _ e = prettyNoExt e +-- | Unguarded case alts. +unguardedalt :: t -> Rhs NodeInfo -> Printer () +unguardedalt _ (UnGuardedRhs _ e) = + do indentSpaces <- getIndentSpaces + write " -> " + indented indentSpaces (pretty e) +unguardedalt _ e = prettyNoExt e + +unguardedrhs :: s -> Rhs NodeInfo -> Printer () +unguardedrhs _ (UnGuardedRhs _ e) = + do indentSpaces <- getIndentSpaces + write " = " + indented indentSpaces (pretty e) +unguardedrhs _ e = prettyNoExt e + -- | Expression customizations. exp :: t -> Exp NodeInfo -> Printer () -- | Space out tuples. @@ -178,10 +208,59 @@ where p = brackets (inter (write ", ") (map pretty es)) +exp _ (RecUpdate _ exp updates) = recUpdateExpr (pretty exp) updates +exp _ (RecConstr _ qname updates) = recUpdateExpr (pretty qname) updates exp _ e = prettyNoExt e -- | Specially format records. Indent where clauses only 2 spaces. decl :: t -> Decl NodeInfo -> Printer () +-- | Pretty print type signatures like +-- +-- foo :: (Show x,Read x) +-- => (Foo -> Bar) +-- -> Maybe Int +-- -> (Char -> X -> Y) +-- -> IO () +-- +decl _ (TypeSig _ names ty') = + depend (do inter (write ", ") + (map pretty names) + write " :: ") + (declTy ty') + where declTy dty = + case dty of + TyForall _ mbinds mctx ty -> + do case mbinds of + Nothing -> return () + Just ts -> + do write "forall " + spaced (map pretty ts) + write ". " + newline + case mctx of + Nothing -> prettyTy ty + Just ctx -> + do pretty ctx + newline + indented (-3) + (depend (write "=> ") + (prettyTy ty)) + _ -> prettyTy dty + collapseFaps (TyFun _ arg result) = arg : collapseFaps result + collapseFaps e = [e] + prettyTy ty = + do small <- isSmall' ty + if small + then pretty ty + else case collapseFaps ty of + [] -> pretty ty + tys -> + prefixedLined "-> " + (map pretty tys) + isSmall' p = + do overflows <- isOverflow (pretty p) + oneLine <- isSingleLiner (pretty p) + return (not overflows && oneLine) decl _ (PatBind _ pat rhs' mbinds) = do pretty pat pretty rhs' @@ -190,7 +269,7 @@ Just binds -> do newline indented 2 - (do write "where " + (do write "where" newline indented 2 (pretty binds)) -- | Handle records specially for a prettier display (see guide). @@ -236,6 +315,34 @@ write "}") conDecl _ e = prettyNoExt e +-- | Record decls are formatted like: Foo +-- { bar :: X +-- } +recDecl :: ConDecl NodeInfo -> Printer () +recDecl (RecDecl _ name fields) = + do pretty name + indentSpaces <- getIndentSpaces + newline + column indentSpaces + (do depend (write "{") + (prefixedLined "," + (map (depend space . pretty) fields)) + newline + write "} ") +recDecl r = prettyNoExt r + +recUpdateExpr :: Printer () -> [FieldUpdate NodeInfo] -> Printer () +recUpdateExpr expWriter updates = do + expWriter + newline + indentSpaces <- getIndentSpaces + write "{ " + -- -2 because the "{ " moved us 2 chars to the right. + indented (indentSpaces -2) $ do + prefixedLined ", " $ map pretty updates + newline + write "}" + -------------------------------------------------------------------------------- -- Predicates @@ -334,19 +441,3 @@ do indentSpaces <- getIndentSpaces column (col + indentSpaces) (pretty b) - --- | Record decls are formatted like: Foo --- { bar :: X --- } -recDecl :: ConDecl NodeInfo -> Printer () -recDecl (RecDecl _ name fields) = - do pretty name - indentSpaces <- getIndentSpaces - newline - column indentSpaces - (do depend (write "{") - (prefixedLined "," - (map (depend space . pretty) fields)) - newline - write "} ") -recDecl r = prettyNoExt r