hindent 5.2.0 → 5.2.1

raw patch · 9 files changed

+291/−158 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +9/−11
• TESTS.md +137/−27
• elisp/hindent.el +2/−10
• hindent.cabal +1/−1
• src/HIndent.hs +57/−57
• src/HIndent/Pretty.hs +54/−43
• src/HIndent/Types.hs +15/−5
• src/main/Main.hs +6/−4

@@ -1,4 +1,14 @@+5.1.1:+    * Fix hanging on large constraints+    * Render multi-line comments+    * Rename --tab-size to --indent-size+    * Don't add a spurious space for comments at the end of the file+    * Don't add trailing whitespace on <-+    * Disable PatternSynonyms+    * Put a newline before the closing bracket on a list+ 5.2.0:+     * Default tab-width is now 2     * Supports .hindent.yaml file to specify alt tab-width and max       column

@@ -13,9 +13,9 @@ ## Usage      $ hindent --help-    hindent --version --help --style STYLE --line-length <...> --tab-size <...> --no-force-newline [-X<...>]* [<FILENAME>]+    hindent --version --help --style STYLE --line-length <...> --indent-size <...> --no-force-newline [-X<...>]* [<FILENAME>]     Version 5.1.1-    Default --tab-size is 2. Specify --tab-size 4 if you prefer that.+    Default --indent-size is 2. Specify --indent-size 4 if you prefer that.     -X to pass extensions e.g. -XMagicHash etc.     The --style option is now ignored, but preserved for backwards-compatibility.     Johan Tibell is the default and only style.@@ -24,13 +24,13 @@      $ cat path/to/sourcefile.hs | hindent -The default tab size is `2`. Configure tab size with `--tab-size`:+The default indentation size is `2` spaces. Configure indentation size with `--indent-size`: -    $ echo 'example = case x of Just p -> foo bar' | hindent --tab-size 2; echo+    $ echo 'example = case x of Just p -> foo bar' | hindent --indent-size 2; echo     example =       case x of         Just p -> foo bar-    $ echo 'example = case x of Just p -> foo bar' | hindent --tab-size 4; echo+    $ echo 'example = case x of Just p -> foo bar' | hindent --indent-size 4; echo     example =         case x of             Just p -> foo bar@@ -42,7 +42,7 @@ default:  ``` yaml-tab-size: 2+indent-size: 2 line-length: 80 force-trailing-newline: true ```@@ -85,8 +85,6 @@  ## Atom -Basic support is provided through-[atom/hindent.coffee](https://github.com/chrisdone/hindent/blob/master/atom/hindent.coffee). Mode-should be installed as package into `.atom\packages\${PACKAGE_NAME}`,-here is simple example of atom-[package](https://github.com/Heather/atom-hindent).+Fortunately, you can use https://atom.io/packages/ide-haskell with the+path to hindent specified instead of that to stylish-haskell. Works+like a charm that way!

@@ -28,7 +28,7 @@   ) where ``` -## Imports+# Imports  Import lists @@ -62,22 +62,22 @@   foobar = do     x y     k p- ```+ # Expressions  Lazy patterns in a lambda  ``` haskell f = \ ~a -> undefined- -- \~a yields parse error on input ‘\~’+-- \~a yields parse error on input ‘\~’ ```  Bang patterns in a lambda  ``` haskell f = \ !a -> undefined- -- \!a yields parse error on input ‘\!’+-- \!a yields parse error on input ‘\!’ ```  List comprehensions@@ -87,8 +87,8 @@   [ e   | e@EnableExtension {} <- knownExtensions ] \\   map EnableExtension badExtensions- ```+ Record indentation  ``` haskell@@ -98,8 +98,8 @@   { getModuleName = "Git"   , getEvents = getRepoCommits   }- ```+ Records again  ``` haskell@@ -110,8 +110,8 @@   , eventIcon = "glyphicon-cog"   , eventDate = localTimeToUTC timezone (commitDate commit)   }- ```+ Cases  ``` haskell@@ -121,16 +121,16 @@     "Jan" -> 1     "Feb" -> 2     _ -> error $ "Unknown month " ++ month- ```+ Operators  ``` haskell x =   Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*> Just thisissolong <*>   Just stilllonger- ```+ # Type signatures  Class constraints@@ -139,8 +139,8 @@ fun   :: (Class a, Class b)   => a -> b -> c- ```+ Tuples  ``` haskell@@ -182,8 +182,8 @@          Just x -> e          Nothing -> p      | otherwise -> e- ```+ Case inside a `where` and `do`  ``` haskell@@ -210,8 +210,8 @@       let y = 2           z = 3       in y- ```+ Lists  ``` haskell@@ -223,9 +223,10 @@   , InternalServerError   , InvalidStatusCode   , MissingContentHeader-  , InternalServerError]-+  , InternalServerError+  ] ```+ # Johan Tibell compatibility checks  Basic example from Tibbe's style@@ -243,8 +244,8 @@ filter p (x:xs)   | p x = x : filter p xs   | otherwise = filter p xs- ```+ Data declarations  ``` haskell@@ -263,8 +264,8 @@   , lastName :: !String -- ^ Last name   , age :: !Int -- ^ Age   }- ```+ Spaces between deriving classes  ``` haskell@@ -274,8 +275,8 @@   , lastName :: !String -- ^ Last name   , age :: !Int -- ^ Age   } deriving (Eq, Show)- ```+ Hanging lambdas  ``` haskell@@ -292,8 +293,8 @@   \a ->      alloca 20 $      \b -> cFunction fooo barrr muuu (fooo barrr muuu) (fooo barrr muuu)- ```+ # Comments  Comments within a declaration@@ -335,7 +336,8 @@     , ( 2 -- bar       , 2.5 -- mu        )-    , 3]+    , 3+    ]  foo = 1 -- after foo ```@@ -366,19 +368,118 @@     -- ^ This is a long comment which starts on the following line     -- from from the field, lines continue at the sme column.   }- ```+ Comments around regular declarations  ``` haskell -- This is some random comment. -- | Main entry point. main = putStrLn "Hello, World!"- -- This is another random comment.+-- This is another random comment. ``` -## Regression tests+Multi-line comments +``` haskell+bob {- after bob -}+ =+  foo {- next to foo -}+  {- line after foo -}+    (bar+       foo {- next to bar foo -}+       bar {- next to bar -}+     ) {- next to the end paren of (bar) -}+    {- line after (bar) -}+    mu {- next to mu -}+    {- line after mu -}+    {- another line after mu -}+    zot {- next to zot -}+    {- line after zot -}+    (case casey {- after casey -}+           of+       Just {- after Just -}+        -> do+         justice {- after justice -}+          *+           foo+             (blah * blah + z + 2 / 4 + a - {- before a line break -}+              2 * {- inside this mess -}+              z /+              2 /+              2 /+              aooooo /+              aaaaa {- bob comment -}+              ) ++           (sdfsdfsd fsdfsdf) {- blah comment -}+         putStrLn "")+    [1, 2, 3]+    [ 1 {- foo -}+    , ( 2 {- bar -}+      , 2.5 {- mu -}+       )+    , 3+    ]++foo = 1 {- after foo -}+```++Multi-line comments with multi-line contents++``` haskell+{- | This is some random comment.+Here is more docs and such.+Etc.+-}+main = putStrLn "Hello, World!"+{- This is another random comment. -}+```++# Regression tests++jml Adds trailing whitespace when wrapping #221++``` haskell+x = do+  config <- execParser options+  comments <-+    case config of+      Diff False args -> commentsFromDiff args+      Diff True args -> commentsFromDiff ("--cached" : args)+      Files args -> commentsFromFiles args+  mapM_ (putStrLn . Fixme.formatTodo) (concatMap Fixme.getTodos comments)+```++meditans hindent freezes when trying to format this code #222++``` haskell+c+  :: forall new.+     (Settable "pitch" Pitch (Map.AsMap (new Map.:\ "pitch")) new+     ,Default (Book' (Map.AsMap (new Map.:\ "pitch"))))+  => Book' new+c = set #pitch C (def :: Book' (Map.AsMap (new Map.:\ "pitch")))++foo+  :: (Foooooooooooooooooooooooooooooooooooooooooo+     ,Foooooooooooooooooooooooooooooooooooooooooo)+  => A+```++bitemyapp wonky multiline comment handling #231++``` haskell+module Woo where++hi = "hello"+{-+test comment+-}+-- blah blah+-- blah blah+-- blah blah+```+ cocreature removed from declaration issue #186  ``` haskell@@ -389,8 +490,8 @@     (emptyImage      { notPresent = S.singleton (TransitionResult Two (Just A) n)      })- ```+ sheyll explicit forall in instances #218  ``` haskell@@ -438,6 +539,14 @@ import HelloWorld ``` +Wrapped import list shouldn't add newline++```haskell+import TooLongList+       (alpha, beta, gamma, delta, epsilon, zeta, eta, theta)+import Test+```+ radupopescu `deriving` keyword not aligned with pipe symbol for type declarations  ``` haskell@@ -458,7 +567,7 @@  ``` haskell α = γ * "ω"- -- υ+-- υ ```  Empty module@@ -472,7 +581,6 @@ module X where  foo = 123- ```  # Complex input@@ -502,7 +610,8 @@                                 , ( "List of characters"                                   , ListPresentation                                       typeString-                                      (map (snd $(presentVar)) xs))]+                                      (map (snd $(presentVar)) xs))+                                ]                               where getCh (CharPresentation "GHC.Types.Char" ch) =                                       ch                                     getCh (ChoicePresentation _ ((_, CharPresentation _ ch):_)) =@@ -511,7 +620,8 @@                             _ ->                               ListPresentation                                 typeString-                                (map (snd $(presentVar)) xs)))|]))]+                                (map (snd $(presentVar)) xs)))|]))+  ] ```  Random snippet from hindent itself

@@ -60,9 +60,9 @@                  (integer :tag "Override" 120))   :safe (lambda (val) (or (integerp val) (not val)))) -(defcustom hindent-tab-size+(defcustom hindent-indent-size   2-  "Optionally override the tab size."+  "Optionally override the indent size."   :group 'haskell   :type '(choice (const :tag "Default: 2" 2)                  (integer :tag "Override" 4))@@ -188,14 +188,6 @@                                           nil ; delete                                           temp ; output                                           nil)-                                    (when hindent-line-length-                                      (list "--line-length"-                                            (number-to-string-                                             hindent-line-length)))-                                    (when hindent-tab-size-                                      (list "--tab-size"-                                            (number-to-string-                                             hindent-tab-size)))                                     (hindent-extra-arguments)))))             (cond              ((= ret 1)

@@ -1,5 +1,5 @@ name:                hindent-version:             5.2.0+version:             5.2.1 synopsis:            Extensible Haskell pretty printer description:         Extensible Haskell pretty printer. Both a library and an executable.                      .

@@ -275,6 +275,7 @@     ,XmlSyntax, RegularPatterns -- steals a-b     ,UnboxedTuples -- breaks (#) lens operator     -- ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break+    ,PatternSynonyms -- steals the pattern keyword     ]  @@ -339,83 +340,82 @@ -- this from bottom to top. collectAllComments :: Module SrcSpanInfo -> State [Comment] (Module NodeInfo) collectAllComments =-    shortCircuit-        (traverseBackwards-         -- Finally, collect backwards comments which come after each node.-             (collectCommentsBy-                  (<>)-                  CommentAfterLine-                  (\nodeSpan commentSpan ->-                        fst (srcSpanStart commentSpan) >=-                        fst (srcSpanEnd nodeSpan)))) <=<-    shortCircuit-        (traverse-         -- Collect forwards comments which start at the end line of a node.-             (collectCommentsBy-                  (<>)-                  CommentSameLine-                  (\nodeSpan commentSpan ->-                        fst (srcSpanStart commentSpan) ==-                        fst (srcSpanEnd nodeSpan)))) <=<-    shortCircuit-        (traverseBackwards-         -- Collect backwards comments which are on the same line as a node.-             (collectCommentsBy-                  (<>)-                  CommentSameLine-                  (\nodeSpan commentSpan ->-                        fst (srcSpanStart commentSpan) ==-                        fst (srcSpanStart nodeSpan) &&-                        fst (srcSpanStart commentSpan) ==-                        fst (srcSpanEnd nodeSpan)))) <=<-    shortCircuit-        (traverse-         -- First, collect forwards comments for declarations which both-         -- start on column 1 and occur before the declaration.-             (collectCommentsBy-                  (<>)-                  CommentBeforeLine-                  (\nodeSpan commentSpan ->-                        (snd (srcSpanStart nodeSpan) == 1 &&-                         snd (srcSpanStart commentSpan) == 1) &&-                        fst (srcSpanStart commentSpan) <-                        fst (srcSpanStart nodeSpan)))) .-    fmap nodify+  shortCircuit+    (traverseBackwards+     -- Finally, collect backwards comments which come after each node.+       (collectCommentsBy+          (<>)+          CommentAfterLine+          (\nodeSpan commentSpan ->+              fst (srcSpanStart commentSpan) >= fst (srcSpanEnd nodeSpan)))) <=<+  shortCircuit+    (traverse+     -- Collect forwards comments which start at the end line of a+     -- node: Does the start line of the comment match the end-line+     -- of the node?+       (collectCommentsBy+          (<>)+          CommentSameLine+          (\nodeSpan commentSpan ->+              fst (srcSpanStart commentSpan) == fst (srcSpanEnd nodeSpan)))) <=<+  shortCircuit+    (traverseBackwards+     -- Collect backwards comments which are on the same line as a+     -- node: Does the start line & end line of the comment match+     -- that of the node?+       (collectCommentsBy+          (<>)+          CommentSameLine+          (\nodeSpan commentSpan ->+              fst (srcSpanStart commentSpan) == fst (srcSpanStart nodeSpan) &&+              fst (srcSpanStart commentSpan) == fst (srcSpanEnd nodeSpan)))) <=<+  shortCircuit+    (traverse+     -- First, collect forwards comments for declarations which both+     -- start on column 1 and occur before the declaration.+       (collectCommentsBy+          (<>)+          CommentBeforeLine+          (\nodeSpan commentSpan ->+              (snd (srcSpanStart nodeSpan) == 1 &&+               snd (srcSpanStart commentSpan) == 1) &&+              fst (srcSpanStart commentSpan) < fst (srcSpanStart nodeSpan)))) .+  fmap nodify   where     nodify s = NodeInfo s mempty     -- Sort the comments by their end position.     traverseBackwards =-        traverseInOrder-            (\x y ->-                  on-                      (flip compare)-                      (srcSpanEnd . srcInfoSpan . nodeInfoSpan)-                      x-                      y)+      traverseInOrder+        (\x y -> on (flip compare) (srcSpanEnd . srcInfoSpan . nodeInfoSpan) x y)     -- Stop traversing if all comments have been consumed.     shortCircuit m v = do-        comments <- get-        if null comments-            then return v-            else m v+      comments <- get+      if null comments+        then return v+        else m v  -- | Collect comments by satisfying the given predicate, to collect a -- comment means to remove it from the pool of available comments in -- the State. This allows for a multiple pass approach. collectCommentsBy   :: ([NodeComment] -> [NodeComment] -> [NodeComment])-  -> (String -> NodeComment)+  -> (SomeComment -> NodeComment)   -> (SrcSpan -> SrcSpan -> Bool)   -> NodeInfo   -> State [Comment] NodeInfo collectCommentsBy append cons predicate nodeInfo@(NodeInfo (SrcSpanInfo nodeSpan _) _) = do   comments <- get-  let (others,mine) =+  let (others, mine) =         partitionEithers           (map-             (\comment@(Comment _ commentSpan commentString) ->+             (\comment@(Comment multiLine commentSpan commentString) ->                  if predicate nodeSpan (setFilename commentString commentSpan)-                   then Right (cons commentString)+                   then Right+                          (cons+                             ((if multiLine+                                 then MultiLine+                                 else EndOfLine)+                                commentString))                    else Left comment)              comments)   put others

@@ -43,33 +43,43 @@     (\c' -> do        case c' of          CommentBeforeLine c -> do-           write ("--" ++ c)+           case c of+             EndOfLine s -> write ("--" ++ s)+             MultiLine s -> write ("{-" ++ s ++ "-}")            newline          _ -> return ())     comments   prettyInternal a   mapM_-    (\(i,c') -> do+    (\(i, c') -> do        case c' of          CommentSameLine c -> do-           write (" --" ++ c)-           modify-             (\s ->-                 s-                 { psEolComment = True-                 })+           col <- gets psColumn+           unless (col == 0) space+           writeComment c          CommentAfterLine c -> do            when (i == 0) newline-           write ("--" ++ c)-           modify-             (\s ->-                 s-                 { psEolComment = True-                 })+           writeComment c          _ -> return ())     (zip [0 :: Int ..] comments)   where     comments = nodeInfoComments (ann a)+    writeComment =+      \case+        EndOfLine cs -> do+          write ("--" ++ cs)+          modify+            (\s ->+                s+                { psEolComment = True+                })+        MultiLine cs -> do+          write ("{-" ++ cs ++ "-}")+          modify+            (\s ->+                s+                { psEolComment = True+                })  -- | Pretty print using HSE's own printer. The 'P.Pretty' class here -- is HSE's.@@ -315,8 +325,12 @@ -- * Instances  instance Pretty Context where-  prettyInternal  =-    context+  prettyInternal ctx@(CxTuple _ asserts) = do+    mst <- fitsOnOneLine (parens (inter (comma >> space) (map pretty asserts)))+    case mst of+      Nothing -> context ctx+      Just st -> put st+  prettyInternal ctx = context ctx  instance Pretty Pat where   prettyInternal x =@@ -502,8 +516,12 @@ exp (List _ es) =   do mst <- fitsOnOneLine p      case mst of-       Nothing -> brackets (prefixedLined ","-                                          (map (depend space . pretty) es))+       Nothing -> do+         depend+           (write "[")+           (prefixedLined "," (map (depend space . pretty) es))+         newline+         write "]"        Just st -> put st   where p =           brackets (inter (write ", ")@@ -1074,9 +1092,8 @@             case mprev of                 Nothing -> 0                 Just prev ->-                    fst-                        (srcSpanStart (srcInfoSpan (nodeInfoSpan (ann current)))) --                    fst (srcSpanStart (srcInfoSpan (nodeInfoSpan (ann prev))))+                    fst (srcSpanStart (srcInfoSpan (nodeInfoSpan (ann current)))) -+                    fst (srcSpanEnd   (srcInfoSpan (nodeInfoSpan (ann prev   ))))  instance Pretty Bracket where   prettyInternal x =@@ -1232,7 +1249,8 @@      pretty p      indented indentSpaces               (dependOrNewline-                 (write " <- ")+                 (write " <-")+                 space                  e                  pretty) stmt x = case x of@@ -1249,18 +1267,20 @@  -- | Make the right hand side dependent if it fits on one line, -- otherwise send it to the next line.-dependOrNewline :: Printer ()-                -> Exp NodeInfo-                -> (Exp NodeInfo -> Printer ())-                -> Printer ()-dependOrNewline left right f =+dependOrNewline+  :: Printer ()+  -> Printer ()+  -> Exp NodeInfo+  -> (Exp NodeInfo -> Printer ())+  -> Printer ()+dependOrNewline left prefix right f =   do msg <- fitsOnOneLine renderDependent      case msg of        Nothing -> do left                      newline                      (f right)        Just st -> put st-  where renderDependent = depend left (f right)+  where renderDependent = depend left (do prefix; f right)  -- | Handle do and case specially and also space out guards more. rhs :: Rhs NodeInfo -> Printer ()@@ -1359,20 +1379,11 @@  -- | Format contexts with spaces and commas between class constraints. context :: Context NodeInfo -> Printer ()-context ctx@(CxTuple _ asserts) =-  do mst <--          fitsOnOneLine-            (parens (inter (comma >> space)-                           (map pretty asserts)))-     case mst of-       Nothing -> prettyInternal ctx-       Just st -> put st-context ctx = case ctx of-                CxSingle _ a -> pretty a-                CxTuple _ as ->-                  parens (prefixedLined ","-                                        (map pretty as))-                CxEmpty _ -> parens (return ())+context ctx =+  case ctx of+    CxSingle _ a -> pretty a+    CxTuple _ as -> parens (prefixedLined "," (map pretty as))+    CxEmpty _ -> parens (return ())  unboxParens :: Printer a -> Printer a unboxParens p =@@ -1475,7 +1486,7 @@                    Just ts ->                      do write "forall "                         spaced (map pretty ts)-                        write ". "+                        write "."                         newline                  case mctx of                    Nothing -> prettyTy ty

@@ -15,6 +15,7 @@   ,defaultConfig   ,NodeInfo(..)   ,NodeComment(..)+  ,SomeComment(..)   ) where  import           Control.Applicative@@ -68,8 +69,10 @@   parseJSON (Y.Object v) =     Config <$>     fmap (fromMaybe (configMaxColumns defaultConfig)) (v Y..:? "line-length") <*>-    fmap (fromMaybe (configIndentSpaces defaultConfig)) (v Y..:? "tab-size") <*>     fmap+      (fromMaybe (configIndentSpaces defaultConfig))+      (v Y..:? "indent-size" <|> v Y..:? "tab-size") <*>+    fmap       (fromMaybe (configTrailingNewline defaultConfig))       (v Y..:? "force-trailing-newline")   parseJSON _ = fail "Expected Object for Config value"@@ -83,11 +86,18 @@     , configTrailingNewline = True     } +-- | Some comment to print.+data SomeComment+  = EndOfLine String+  | MultiLine String+  deriving (Show, Ord, Eq)++-- | Comment associated with a node. data NodeComment-  = CommentSameLine String-  | CommentAfterLine String-  | CommentBeforeLine String-  deriving (Show,Ord,Eq)+  = CommentSameLine SomeComment+  | CommentAfterLine SomeComment+  | CommentBeforeLine SomeComment+  deriving (Show, Ord, Eq)  -- | Information for each node in the AST. data NodeInfo = NodeInfo

@@ -88,7 +88,7 @@   "\nVersion " ++   showVersion version ++   "\n" ++-  "Default --tab-size is 2. Specify --tab-size 4 if you prefer that.\n" +++  "Default --indent-size is 2. Specify --indent-size 4 if you prefer that.\n" ++   "-X to pass extensions e.g. -XMagicHash etc.\n" ++   "The --style option is now ignored, but preserved for backwards-compatibility.\n" ++   "Johan Tibell is the default and only style."@@ -115,13 +115,15 @@         (optional            (constant "--style" "Style to print with" () *> anyString "STYLE")) <*>       lineLen <*>-      tabsize <*>+      indentSpaces <*>       trailingNewline     exts = fmap getExtensions (many (prefix "X" "Language extension"))-    tabsize =+    indentSpaces =       fmap         (>>= (readMaybe . T.unpack))-        (optional (arg "tab-size" "Tab size, default: 4"))+        (optional+           (arg "indent-size" "Indentation size in spaces, default: 4" <|>+            arg "tab-size" "Same as --indent-size, for compatibility"))     lineLen =       fmap         (>>= (readMaybe . T.unpack))