hindent 4.6.3 → 4.6.4

raw patch · 16 files changed

+349/−139 lines, 16 filesdep −data-defaultPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: data-default

API changes (from Hackage documentation)

Files

• README.md +8/−3
• benchmarks/BigDeclarations.hs +17/−0
• hindent.cabal +3/−4
• src/HIndent/Pretty.hs +52/−39
• src/HIndent/Styles/Cramer.hs +7/−5
• src/HIndent/Styles/Fundamental.hs +1/−3
• src/HIndent/Styles/Gibiansky.hs +1/−1
• src/HIndent/Styles/JohanTibell.hs +30/−13
• src/HIndent/Types.hs +4/−8
• src/main/Main.hs +7/−1
• test/chris-done/expected/12.exp +100/−16
• test/chris-done/expected/2.exp +6/−3
• test/fundamental/expected/12.exp +100/−16
• test/fundamental/expected/2.exp +11/−4
• test/gibiansky/expected/38.exp +2/−1
• vim/hindent.vim +0/−22

@@ -49,9 +49,14 @@  ## 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.+The `'formatprg'` option lets you use an external program (like hindent) to+format your text. Put the following line into ~/.vim/ftplugin/haskell.vim+to set this option for Haskell files:++    setlocal formatprg=hindent\ --style\ chris-done++Then you can format with hindent using `gq`. Read `:help gq` and `help+'formatprg'` for more details.  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.

@@ -0,0 +1,17 @@+listPrinters =+  [(''[]+   ,\(typeVariable:_) _automaticPrinter ->+      (let presentVar = varE (presentVarName typeVariable)+       in lamE [varP (presentVarName typeVariable)]+               [|(let typeString = "[" ++ fst $(presentVar) ++ "]"+                  in (typeString+                     ,\xs ->+                        case fst $(presentVar) of+                          "GHC.Types.Char" ->+                            ChoicePresentation+                              "String"+                              [("String",undefined)+                              ,("List of characters",undefined)]+                          _ ->+                            ListPresentation typeString+                                             (map (snd $(presentVar)) xs)))|]))]

@@ -1,5 +1,5 @@ name:                hindent-version:             4.6.3+version:             4.6.4 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .@@ -15,8 +15,9 @@ cabal-version:       >=1.8 homepage: http://www.github.com/chrisdone/hindent bug-reports: https://github.com/chrisdone/hindent/issues-data-files:          elisp/hindent.el vim/hindent.vim+data-files:          elisp/hindent.el extra-source-files:  README.md+                     benchmarks/BigDeclarations.hs                      test/chris-done/expected/*.exp                      test/chris-done/tests/*.test                      test/gibiansky/expected/*.exp@@ -44,7 +45,6 @@                      HIndent.Styles.Cramer   build-depends:     base >= 4.7 && <5                    , containers-                   , data-default                    , haskell-src-exts >= 1.17                    , monad-loops                    , mtl@@ -78,7 +78,6 @@   main-is: Spec.hs   build-depends:     base >= 4 && <5                    , hindent-                   , data-default                    , haskell-src-exts                    , monad-loops                    , mtl

@@ -26,7 +26,7 @@   , int   , string   -- * Common node types-  , maybeCtx+  , withCtx   , printComment   , printComments   , withCaseContext@@ -399,13 +399,16 @@ nullBinds (BDecls _ x) = null x nullBinds (IPBinds _ x) = null x --- | Maybe render a class context.-maybeCtx :: MonadState (PrintState s) m => Maybe (Context NodeInfo) -> m ()-maybeCtx =-  maybe (return ())-        (\p ->-           pretty p >>-           write " => ")+-- | Render a type with a context, or not.+withCtx :: (MonadState (PrintState s) m+           ,Pretty ast)+        => Maybe (ast NodeInfo) -> m b -> m b+withCtx Nothing m = m+withCtx (Just ctx) m =+  do pretty ctx+     write " =>"+     newline+     m  -- | Maybe render an overlap definition. maybeOverlap :: MonadState (PrintState s) m => Maybe (Overlap NodeInfo) -> m ()@@ -441,7 +444,8 @@     case ctx of       CxSingle _ a -> pretty a       CxTuple _ as ->-        parens (commas (map pretty as))+        parens (prefixedLined ","+                              (map pretty as))       CxEmpty _ -> parens (return ())  instance Pretty Pat where@@ -535,8 +539,7 @@                     do write "forall "                        spaced (map pretty ts)                        write ". ")-               (depend (maybeCtx ctx)-                       (pretty ty))+               (withCtx ctx (pretty ty))       TyFun _ a b ->         depend (do pretty a                    write " -> ")@@ -828,14 +831,14 @@   lined (map pretty matches) decl (ClassDecl _ ctx dhead fundeps decls) =   do depend (write "class ")-            (depend (maybeCtx ctx)-                    (depend (do pretty dhead-                                space)-                            (depend (unless (null fundeps)-                                            (do write " | "-                                                commas (map pretty fundeps)))-                                    (unless (null (fromMaybe [] decls))-                                            (write " where")))))+            (withCtx ctx+                     (depend (do pretty dhead+                                 space)+                             (depend (unless (null fundeps)+                                             (do write " | "+                                                 commas (map pretty fundeps)))+                                     (unless (null (fromMaybe [] decls))+                                             (write " where")))))      unless (null (fromMaybe [] decls))             (do newline                 indentSpaces <- getIndentSpaces@@ -851,12 +854,12 @@ decl (DataDecl _ dataornew ctx dhead condecls mderivs) =   do depend (do pretty dataornew                 space)-            (depend (maybeCtx ctx)-                    (do pretty dhead-                        case condecls of-                          [] -> return ()-                          [x] -> singleCons x-                          xs -> multiCons xs))+            (withCtx ctx+                     (do pretty dhead+                         case condecls of+                           [] -> return ()+                           [x] -> singleCons x+                           xs -> multiCons xs))      indentSpaces <- getIndentSpaces      case mderivs of        Nothing -> return ()@@ -945,14 +948,13 @@       ClsDecl _ d -> pretty d       ClsDataFam _ ctx h mkind ->         depend (write "data ")-               (depend (maybeCtx ctx)-                       (do pretty h-                           (case mkind of-                              Nothing ->-                                return ()-                              Just kind ->-                                do write " :: "-                                   pretty kind)))+               (withCtx ctx+                        (do pretty h+                            (case mkind of+                               Nothing -> return ()+                               Just kind ->+                                 do write " :: "+                                    pretty kind)))       ClsTyFam _ h mkind ->         depend (write "type ")                (depend (pretty h)@@ -1083,7 +1085,7 @@                        (do write "forall "                            spaced (map pretty (fromMaybe [] tyvars))                            write ". "))-               (depend (maybeCtx ctx)+               (withCtx ctx                        (pretty d))  instance Pretty Rhs where@@ -1116,9 +1118,7 @@     do case mvarbinds of          Nothing -> return ()          Just xs -> spaced (map pretty xs)-       depend (maybeCtx mctx)-              (pretty ihead)-+       withCtx mctx (pretty ihead)  instance Pretty InstHead where   prettyInternal x =@@ -1283,7 +1283,18 @@   prettyInternal = pretty'  instance Pretty ModuleHead where-  prettyInternal = pretty'+  prettyInternal (ModuleHead _ name mwarnings mexports) =+    do write "module "+       pretty name+       maybe (return ()) pretty mwarnings+       maybe (return ())+             (\exports ->+                do newline+                   indented 2 (pretty exports)+                   newline+                   space)+             mexports+       write " where"  instance Pretty ModulePragma where   prettyInternal = pretty'@@ -1305,7 +1316,9 @@   prettyInternal = pretty'  instance Pretty ExportSpecList where-  prettyInternal = pretty'+  prettyInternal (ExportSpecList _ es) =+    parens (prefixedLined ","+                          (map pretty es))  instance Pretty ExportSpec where   prettyInternal = pretty'

@@ -644,11 +644,13 @@ -- Fix whitespace before 'where' in class decl extDecl (ClassDecl _ mcontext declhead fundeps mdecls) =   do depend (write "class ") $-       depend (maybeCtx mcontext) $-         depend (pretty declhead) $-           depend (unless (null fundeps) $-               write " | " >> inter (write ", ") (map pretty fundeps)) $-             when (isJust mdecls) $ write " where"+       withCtx mcontext $+       depend (pretty declhead) $+       depend (unless (null fundeps) $+               write " | " >>+               inter (write ", ")+                     (map pretty fundeps)) $+       when (isJust mdecls) $ write " where"      maybeM_ mdecls $        \decls ->          do newline

@@ -7,9 +7,7 @@  import HIndent.Types -import Data.Default - -- | Empty state. data State = State @@ -21,5 +19,5 @@         ,styleDescription = "This style adds no extensions to the built-in printer."         ,styleInitialState = State         ,styleExtenders = []-        ,styleDefConfig = def+        ,styleDefConfig = defaultConfig         ,styleCommentPreprocessor = return}

@@ -947,7 +947,7 @@    -- Header   depend (write "class ") $-    depend (maybeCtx ctx) $+    withCtx ctx $       depend (pretty dhead >> space) $         depend (unless (null fundeps) (write " | " >> commas (map pretty fundeps))) $           unless noDecls (write "where")

@@ -171,6 +171,21 @@  -- | Expression customizations. exp :: Exp NodeInfo -> Printer s ()+-- | Do after lambda should swing.+exp (Lambda _ pats (Do l stmts)) =+  do+     (fits,st) <-+       fitsOnOneLine+         (do write "\\"+             spaced (map pretty pats)+             write " -> "+             pretty (Do l stmts))+     if fits+        then put st+        else swing (do write "\\"+                       spaced (map pretty pats)+                       write " -> do")+                   (lined (map pretty stmts)) -- | Space out tuples. exp (Tuple _ boxed exps) =   depend (write (case boxed of@@ -292,8 +307,14 @@  -- | Format contexts with spaces and commas between class constraints. context :: Context NodeInfo -> Printer s ()-context (CxTuple _ asserts) =-  parens $ inter (comma >> space) $ map pretty asserts+context ctx@(CxTuple _ asserts) =+  do (fits,st) <-+       fitsOnOneLine+         (parens (inter (comma >> space)+                        (map pretty asserts)))+     if fits+        then put st+        else prettyNoExt ctx context ctx = prettyNoExt ctx  unboxParens :: MonadState (PrintState s) m => m a -> m a@@ -373,9 +394,9 @@   | any isRecord condecls =     do depend (do pretty dataornew                   unless (null condecls) space)-              (depend (maybeCtx ctx)-                      (do pretty dhead-                          multiCons condecls))+              (withCtx ctx+                       (do pretty dhead+                           multiCons condecls))        case mderivs of          Nothing -> return ()          Just derivs -> pretty derivs@@ -388,17 +409,13 @@ -- | Use special record display, used by 'dataDecl' in a record scenario. qualConDecl :: QualConDecl NodeInfo -> Printer s () qualConDecl x =-    case x of-        QualConDecl _ tyvars ctx d ->-            depend-                (unless-                     (null (fromMaybe [] tyvars))+  case x of+    QualConDecl _ tyvars ctx d ->+      depend (unless (null (fromMaybe [] tyvars))                      (do write "forall "                          spaced (map pretty (fromMaybe [] tyvars))                          write ". "))-                (depend-                     (maybeCtx ctx)-                     (recDecl d))+             (withCtx ctx (recDecl d))  -- | Fields are preceded with a space. conDecl :: ConDecl NodeInfo -> Printer s ()

@@ -24,7 +24,6 @@ import Control.Monad.State.Strict (MonadState(..),StateT) import Control.Monad.Trans.Maybe import Data.Data-import Data.Default import Data.Functor.Identity import Data.Int (Int64) import Data.Text (Text)@@ -80,15 +79,12 @@          ,configClearEmptyLines :: !Bool  -- ^ Remove spaces on lines that are otherwise empty?          } -instance Default Config where-  def =-    Config {configMaxColumns = 80-           ,configIndentSpaces = 2-           ,configClearEmptyLines = False}- -- | Default style configuration. defaultConfig :: Config-defaultConfig = def+defaultConfig =+  Config {configMaxColumns = 80+         ,configIndentSpaces = 2+         ,configClearEmptyLines = False}  -- | Information for each node in the AST. data NodeInfo =

@@ -27,6 +27,9 @@ import           System.Environment import           System.IO import           Text.Read+import           Control.Exception+import           GHC.IO.Exception+import           Foreign.C.Error  -- | Main entry point. main :: IO ()@@ -44,7 +47,10 @@                   (either error T.toLazyText (reformat style (Just exts) text))                 hFlush h                 hClose h-                renameFile fp filepath+                let exdev e = if ioe_errno e == Just ((\(Errno a) -> a) eXDEV)+                                  then copyFile fp filepath >> removeFile fp+                                  else throw e+                renameFile fp filepath `catch` exdev            Nothing ->              T.interact (either error T.toLazyText . reformat style (Just exts))        Failed (Wrap (Stopped Version) _) ->

@@ -2,38 +2,122 @@  module Main where -module Main () where+module Main+  ()+  where -module Main () where+module Main+  ()+  where -module Main (main) where+module Main+  (main)+  where -module Main (main, main2) where+module Main+  (main+  ,main2)+  where -module Main (main, main2) where+module Main+  (main+  ,main2)+  where -module Main (main, main2, main3) where+module Main+  (main+  ,main2+  ,main3)+  where -module Main (main, main2, main3, main4) where+module Main+  (main+  ,main2+  ,main3+  ,main4)+  where -module Main (main, main2, main3, main4) where+module Main+  (main+  ,main2+  ,main3+  ,main4)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5)+  where -module Main (main, main2, main3, main4, main5, main6) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5+  ,main6)+  where -module Main (main, main2, main3, main4, main5, main6) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5+  ,main6)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (+   -- * A thing+   main+  ,main2+  ,+   -- * Another thing+   main3+  ,main4+  ,+   -- ** Another thing+   main5)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (+   -- * A thing+   main+  ,main2+  ,+   -- * Another thing+   main3+  ,main4+  ,+   -- ** Another thing+   main5)+  where -module Main (main) where+module Main+  (main)+  where > import Text.Hello -module Main (main, main2, main3, main4, main5) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5)+  where > import Text.Hello

@@ -5,7 +5,8 @@ fun :: Class a     => a -> b -> c -fun :: (Class a,Class b)+fun :: (Class a+       ,Class b)     => a -> b -> c  fun :: a -> b -> c@@ -20,8 +21,10 @@  fun :: a -> b -> c -- ^ Hello -fun :: (Class a,Class b)+fun :: (Class a+       ,Class b)     => a -> b -> c -- ^ Hello -fun :: (Class a,Class b)+fun :: (Class a+       ,Class b)     => a -> b -> c -- ^ Hello

@@ -2,38 +2,122 @@  module Main where -module Main () where+module Main+  ()+  where -module Main () where+module Main+  ()+  where -module Main (main) where+module Main+  (main)+  where -module Main (main, main2) where+module Main+  (main+  ,main2)+  where -module Main (main, main2) where+module Main+  (main+  ,main2)+  where -module Main (main, main2, main3) where+module Main+  (main+  ,main2+  ,main3)+  where -module Main (main, main2, main3, main4) where+module Main+  (main+  ,main2+  ,main3+  ,main4)+  where -module Main (main, main2, main3, main4) where+module Main+  (main+  ,main2+  ,main3+  ,main4)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5)+  where -module Main (main, main2, main3, main4, main5, main6) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5+  ,main6)+  where -module Main (main, main2, main3, main4, main5, main6) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5+  ,main6)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (+   -- * A thing+   main+  ,main2+  ,+   -- * Another thing+   main3+  ,main4+  ,+   -- ** Another thing+   main5)+  where -module Main (main, main2, main3, main4, main5) where+module Main+  (+   -- * A thing+   main+  ,main2+  ,+   -- * Another thing+   main3+  ,main4+  ,+   -- ** Another thing+   main5)+  where -module Main (main) where+module Main+  (main)+  where > import Text.Hello -module Main (main, main2, main3, main4, main5) where+module Main+  (main+  ,main2+  ,main3+  ,main4+  ,main5)+  where > import Text.Hello

@@ -2,9 +2,12 @@  fun :: a -> f b -> g c d -fun :: Class a => a -> b -> c+fun :: Class a =>+       a -> b -> c -fun :: (Class a,Class b) => a -> b -> c+fun :: (Class a+       ,Class b) =>+       a -> b -> c  fun :: a -> b -> c @@ -17,6 +20,10 @@  fun :: a -> b -> c -- ^ Hello -fun :: (Class a,Class b) => a -> b -> c -- ^ Hello+fun :: (Class a+       ,Class b) =>+       a -> b -> c -- ^ Hello -fun :: (Class a,Class b) => a -> b -> c -- ^ Hello+fun :: (Class a+       ,Class b) =>+       a -> b -> c -- ^ Hello

@@ -1,7 +1,8 @@ type X = Y > -- Comment-instance A a => B a where+instance A a =>+         B a where   x = y  {-# INLINE x #-}

@@ -1,22 +0,0 @@-if exists("g:loaded_hindent") || !executable("hindent")-    finish-endif-let g:loaded_hindent = 1--if !exists("g:hindent_style")-    let g:hindent_style = "fundamental"-endif--function! FormatHaskell()-    if !empty(v:char)-        return 1-    else-        let l:filter = "hindent --style " . g:hindent_style-        let l:command = v:lnum.','.(v:lnum+v:count-1).'!'.l:filter-        execute l:command-    endif-endfunction--if has("autocmd")-  autocmd FileType haskell setlocal formatexpr=FormatHaskell()-endif