diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,9 +13,9 @@ ## Usage $ hindent --help - hindent --version --help --style STYLE --line-length <...> --tab-size <...> --no-force-newline [-X<...>]* [] + hindent --version --help --style STYLE --line-length <...> --indent-size <...> --no-force-newline [-X<...>]* [] 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! diff --git a/TESTS.md b/TESTS.md --- a/TESTS.md +++ b/TESTS.md @@ -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 diff --git a/elisp/hindent.el b/elisp/hindent.el --- a/elisp/hindent.el +++ b/elisp/hindent.el @@ -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) diff --git a/hindent.cabal b/hindent.cabal --- a/hindent.cabal +++ b/hindent.cabal @@ -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. . diff --git a/src/HIndent.hs b/src/HIndent.hs --- a/src/HIndent.hs +++ b/src/HIndent.hs @@ -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 diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -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 diff --git a/src/HIndent/Types.hs b/src/HIndent/Types.hs --- a/src/HIndent/Types.hs +++ b/src/HIndent/Types.hs @@ -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 diff --git a/src/main/Main.hs b/src/main/Main.hs --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -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))