diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index e735b52c..420cc9c8 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -20,6 +20,9 @@ jobs: - name: reuse lint run: nix-build -A packages.reuse && result/bin/reuse lint + - name: hlint + run: nix-build -A checks.hlint + - name: build nixfmt run: nix-build if: success() || failure() diff --git a/default.nix b/default.nix index c634445d..530733d5 100644 --- a/default.nix +++ b/default.nix @@ -55,11 +55,12 @@ build haskellPackages.haskell-language-server shellcheck npins + hlint ]; }; checks = { - hlint = pkgs.build.haskell.hlint ./.; + hlint = pkgs.build.haskell.hlint src; stylish-haskell = pkgs.build.haskell.stylish-haskell ./.; }; } diff --git a/main/Main.hs b/main/Main.hs index ac243a9d..c793854d 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -94,7 +94,7 @@ checkTarget format Target{tDoRead, tPath} = do | otherwise -> Left $ tPath ++ ": not formatted" stdioTarget :: Target -stdioTarget = Target TextIO.getContents "" (const $ TextIO.putStr) +stdioTarget = Target TextIO.getContents "" (const TextIO.putStr) fileTarget :: FilePath -> Target fileTarget path = Target (readFileUtf8 path) path atomicWriteFile diff --git a/main/System/IO/Utf8.hs b/main/System/IO/Utf8.hs index a53fc05c..382f7ef4 100644 --- a/main/System/IO/Utf8.hs +++ b/main/System/IO/Utf8.hs @@ -61,8 +61,7 @@ withUtf8StdHandles :: IO a -> IO a withUtf8StdHandles action = withConfiguredHandle stdin $ withConfiguredHandle stdout $ - withConfiguredHandle stderr $ - action + withConfiguredHandle stderr action where withConfiguredHandle :: IO.Handle -> IO a -> IO a withConfiguredHandle h = bracket (hSetBestUtf8Enc h) ($ h) . const diff --git a/src/Nixfmt.hs b/src/Nixfmt.hs index aa9c3b52..9454d784 100644 --- a/src/Nixfmt.hs +++ b/src/Nixfmt.hs @@ -39,8 +39,7 @@ formatVerify :: Width -> FilePath -> Text -> Either String Text formatVerify width path unformatted = do unformattedParsed@(Whole unformattedParsed' _) <- parse unformatted let formattedOnce = layout width unformattedParsed - formattedOnceParsed <- flip first (parse formattedOnce) $ - (\x -> pleaseReport "Fails to parse after formatting.\n" <> x <> "\n\nAfter Formatting:\n" <> unpack formattedOnce) + formattedOnceParsed <- first (\x -> pleaseReport "Fails to parse after formatting.\n" <> x <> "\n\nAfter Formatting:\n" <> unpack formattedOnce) (parse formattedOnce) let formattedTwice = layout width formattedOnceParsed if formattedOnceParsed /= unformattedParsed then Left $ @@ -48,8 +47,8 @@ formatVerify width path unformatted = do minimized = minimize unformattedParsed' (\e -> parse (layout width e) == Right (Whole e [])) in pleaseReport "Parses differently after formatting." - <> "\n\nBefore formatting:\n" <> (show minimized) - <> "\n\nAfter formatting:\n" <> (show $ fromRight (error "TODO") $ parse (layout width minimized)) + <> "\n\nBefore formatting:\n" <> show minimized + <> "\n\nAfter formatting:\n" <> show (fromRight (error "TODO") $ parse (layout width minimized)) else if formattedOnce /= formattedTwice then Left $ let @@ -67,6 +66,6 @@ formatVerify width path unformatted = do minimize :: Expression -> (Expression -> Bool) -> Expression minimize expr test = - case concatMap (\e -> case test e of { False -> [minimize e test]; True -> [] }) $ walkSubprograms expr of + case concatMap (\e -> ([minimize e test | not (test e)])) $ walkSubprograms expr of result:_ -> result [] -> expr diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index 82da9ab7..4a0b018d 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BlockArguments, FlexibleContexts, LambdaCase, OverloadedStrings, TupleSections #-} +{-# LANGUAGE BlockArguments, FlexibleContexts, LambdaCase, OverloadedStrings #-} module Nixfmt.Lexer (lexeme, pushTrivia, takeTrivia, whole) where @@ -47,7 +47,7 @@ blockComment = try $ preLexeme $ do let pos' = unPos pos - 1 _ <- chunk "/*" -- Try to parse /** before /*, but don't parse /**/ (i.e. the empty comment) - isDoc <- try (const True <$> char '*' <* notFollowedBy (char '/')) <|> pure False + isDoc <- try ((True <$ char '*') <* notFollowedBy (char '/')) <|> pure False chars <- manyTill anySingle $ chunk "*/" return $ PTBlockComment isDoc $ dropWhile Text.null $ fixIndent pos' $ removeStars pos' $ splitLines $ pack chars @@ -83,7 +83,7 @@ blockComment = try $ preLexeme $ do stripIndentation n t = fromMaybe (stripStart t) $ stripPrefix (Text.replicate n " ") t commonIndentationLength :: Int -> [Text] -> Int - commonIndentationLength def = foldr min def . map (Text.length . Text.takeWhile (==' ')) + commonIndentationLength = foldr (min . Text.length . Text.takeWhile (==' ')) -- This should be called with zero or one elements, as per `span isTrailing` convertTrailing :: [ParseTrivium] -> Maybe TrailingComment @@ -119,7 +119,7 @@ convertTrivia pts nextCol = -- This happens especially often after `{` or `[` tokens, where the comment of the first item -- starts on the same line ase the opening token. ([PTLineComment _ pos], (PTNewlines 1):(PTLineComment _ pos'):_) | pos == pos' -> (Nothing, convertLeading pts) - ([PTLineComment _ pos], [(PTNewlines 1)]) | pos == nextCol -> (Nothing, convertLeading pts) + ([PTLineComment _ pos], [PTNewlines 1]) | pos == nextCol -> (Nothing, convertLeading pts) _ -> (convertTrailing trailing, convertLeading leading) trivia :: Parser [ParseTrivium] diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index 2cb96b02..3ba27fbf 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -227,9 +227,9 @@ parens = Parenthesized <$> simpleSelector :: Parser StringPart -> Parser SimpleSelector simpleSelector parseInterpolation = - ((IDSelector <$> identifier) <|> + (IDSelector <$> identifier) <|> (InterpolSelector <$> lexeme parseInterpolation) <|> - (StringSelector <$> lexeme simpleString)) + (StringSelector <$> lexeme simpleString) selector :: Maybe (Parser Leaf) -> Parser Selector selector parseDot = Selector <$> @@ -246,7 +246,7 @@ selectorPath' = many $ try $ selector $ Just $ symbol TDot -- Everything but selection simpleTerm :: Parser Term simpleTerm = - (SimpleString <$> (lexeme $ simpleString <|> uri)) + (SimpleString <$> lexeme (simpleString <|> uri)) <|> (IndentedString <$> lexeme indentedString) <|> (Path <$> path) <|> (Token <$> (envPath <|> float <|> integer <|> identifier)) diff --git a/src/Nixfmt/Parser/Float.hs b/src/Nixfmt/Parser/Float.hs index e77845f1..31ba89c4 100644 --- a/src/Nixfmt/Parser/Float.hs +++ b/src/Nixfmt/Parser/Float.hs @@ -20,8 +20,8 @@ import "scientific" Data.Scientific (toRealFloat, scientific) data SP = SP !Integer {-# UNPACK #-} !Int floatParse :: (MonadParsec e s m, Token s ~ Char, RealFloat a) => m a floatParse = do - notFollowedBy $ (char '0') >> digitChar - notFollowedBy $ (char' 'e') + notFollowedBy $ char '0' >> digitChar + notFollowedBy (char' 'e') c' <- (decimal "decimal") <|> return 0 toRealFloat <$> (( do diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 3ddf7826..60a9c868 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, OverloadedStrings, LambdaCase #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} module Nixfmt.Predoc ( text @@ -151,7 +151,7 @@ trailing t = [Text 0 0 Trailing t] -- Must not contain non-hard whitespace (e.g. line, softline' etc.) at the start of the end. -- Use group' for that instead if you are sure of what you are doing. group :: HasCallStack => Pretty a => a -> Doc -group x = pure . (Group RegularG) $ +group x = pure . Group RegularG $ if p /= [] && (isSoftSpacing (head p) || isSoftSpacing (last p)) then error $ "group should not start or end with whitespace, use `group'` if you are sure; " <> show p else @@ -166,7 +166,7 @@ group x = pure . (Group RegularG) $ -- -- Also allows to create priority groups (see Node Group documentation) group' :: Pretty a => GroupAnn -> a -> Doc -group' ann = pure . (Group ann) . pretty +group' ann = pure . Group ann . pretty -- | @nest doc@ declarse @doc@ to have a higher nesting depth -- than before. Not all nestings actually result in indentation changes, @@ -276,10 +276,10 @@ spanEnd p = fmap reverse . span p . reverse unexpandSpacing' :: Maybe Int -> Doc -> Maybe Doc unexpandSpacing' (Just n) _ | n < 0 = Nothing unexpandSpacing' _ [] = Just [] -unexpandSpacing' n (txt@(Text _ _ _ t):xs) = (txt :) <$> unexpandSpacing' (n <&> (subtract $ textWidth t)) xs -unexpandSpacing' n (Spacing Hardspace:xs) = (Spacing Hardspace :) <$> unexpandSpacing' (n <&> (subtract 1)) xs -unexpandSpacing' n (Spacing Space:xs) = (Spacing Hardspace :) <$> unexpandSpacing' (n <&> (subtract 1)) xs -unexpandSpacing' n (Spacing Softspace:xs) = (Spacing Hardspace :) <$> unexpandSpacing' (n <&> (subtract 1)) xs +unexpandSpacing' n (txt@(Text _ _ _ t):xs) = (txt :) <$> unexpandSpacing' (n <&> subtract (textWidth t)) xs +unexpandSpacing' n (Spacing Hardspace:xs) = (Spacing Hardspace :) <$> unexpandSpacing' (n <&> subtract 1) xs +unexpandSpacing' n (Spacing Space:xs) = (Spacing Hardspace :) <$> unexpandSpacing' (n <&> subtract 1) xs +unexpandSpacing' n (Spacing Softspace:xs) = (Spacing Hardspace :) <$> unexpandSpacing' (n <&> subtract 1) xs unexpandSpacing' n (Spacing Break:xs) = unexpandSpacing' n xs unexpandSpacing' n (Spacing Softbreak:xs) = unexpandSpacing' n xs unexpandSpacing' _ (Spacing _:_) = Nothing @@ -316,7 +316,7 @@ fixup (a@(Spacing _) : Group ann xs : ys) = -- For the leading side, also move out comments out of groups, they are kinda the same thing -- (We could move out trailing comments too but it would make no difference) (pre, rest) = span (\x -> isHardSpacing x || isComment x) $ fixup xs - (post, body) = (second $ simplifyGroup ann) $ spanEnd isHardSpacing rest + (post, body) = second (simplifyGroup ann) $ spanEnd isHardSpacing rest in if null body then -- Dissolve empty group fixup $ (a : pre) ++ post ++ ys @@ -326,7 +326,7 @@ fixup (a@(Spacing _) : Group ann xs : ys) = fixup (Group ann xs : ys) = let (pre, rest) = span (\x -> isHardSpacing x || isComment x) $ fixup xs - (post, body) = (second $ simplifyGroup ann) $ spanEnd isHardSpacing rest + (post, body) = second (simplifyGroup ann) $ spanEnd isHardSpacing rest in if null body then fixup $ pre ++ post ++ ys else @@ -380,7 +380,7 @@ priorityGroups = explode . mergeSegments . segments | prio = [([], x, [])] | otherwise = [] explode ((prio, x):xs) - | prio = ([], x, concatMap (snd) xs) : (map (\(a, b, c) -> (x<>a, b, c)) $ explode xs) + | prio = ([], x, concatMap snd xs) : map (\(a, b, c) -> (x<>a, b, c)) (explode xs) | otherwise = map (\(a, b, c) -> (x<>a, b, c)) (explode xs) -- | To support i18n, this function needs to be patched. @@ -434,7 +434,7 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs where go c _ | c < 0 = False go c [] = maxWidth - c <= targetWidth go c (Text _ _ RegularT t : xs) = go (c - textWidth t) xs - go c (Text _ _ _ _ : xs) = go c xs + go c (Text {} : xs) = go c xs -- This case is impossible in the input thanks to fixup, but may happen -- due to our recursion on groups below go c (Spacing a : Spacing b : xs) = go c $ Spacing (mergeSpacings a b) : xs @@ -534,7 +534,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, s -- [ # comment -- 1 -- ] - Text _ _ TrailingComment t | cc == 2 && (fst $ nextIndent xs) > lineNL -> putText' [" ", t] + Text _ _ TrailingComment t | cc == 2 && fst (nextIndent xs) > lineNL -> putText' [" ", t] where lineNL = snd $ NonEmpty.head indents Text nl off _ t -> putText nl off t @@ -572,7 +572,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, s -- Ignore transparent groups as their priority children have already been handled up in the parent (and failed) <|> (if ann /= Transparent then -- Each priority group will be handled individually, and the priority groups are tried in reverse order - asum $ map (flip goPriorityGroup xs) $ reverse $ priorityGroups ys + asum $ map (`goPriorityGroup` xs) $ reverse $ priorityGroups ys else empty ) @@ -593,7 +593,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, s -- Try to render post onto one line postRendered <- goGroup post rest -- If none of these failed, put together and return - return $ (preRendered ++ prioRendered ++ postRendered) + return (preRendered ++ prioRendered ++ postRendered) -- Try to fit the group onto a single line, while accounting for the fact that the first -- bits of rest must fit as well (until the first possibility for a line break within rest). @@ -610,7 +610,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, s -- therefore drop any leading whitespace within the group to avoid duplicate newlines grp' = case head grp of Spacing _ -> tail grp - Group ann ((Spacing _) : inner) -> (Group ann inner) : tail grp + Group ann ((Spacing _) : inner) -> Group ann inner : tail grp _ -> grp (nl, off) = nextIndent grp' diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 19b163c8..455d57bb 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -37,7 +37,7 @@ instance Pretty Trivium where pretty (BlockComment isDoc c) = comment (if isDoc then "/**" else "/*") <> hardline -- Indent the comment using offset instead of nest - <> (offset 2 $ hcat $ map prettyCommentLine c) + <> offset 2 (hcat $ map prettyCommentLine c) <> comment "*/" <> hardline where prettyCommentLine :: Text -> Doc @@ -94,7 +94,7 @@ instance Pretty Binder where -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) = group $ pretty inherit <> nest ( - (group' RegularG (line <> pretty source)) + group' RegularG (line <> pretty source) <> if null ids then pretty semicolon else line <> sepBy (if length ids < 4 then line else hardline) ids <> line' <> pretty semicolon @@ -118,7 +118,7 @@ prettySet _ (krec, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) prettySet wide (krec, Ann pre paropen post, binders, parclose) = pretty (fmap (, hardspace) krec) <> pretty (Ann pre paropen Nothing) - <> (surroundWith sep $ nest $ pretty post <> prettyItems hardline binders) + <> surroundWith sep (nest $ pretty post <> prettyItems hardline binders) <> pretty parclose where sep = if wide && not (null (unItems binders)) then hardline else line @@ -142,7 +142,7 @@ prettyTerm (Selection term selectors rest) = -- If it is an ident, keep it all together (Token _) -> mempty -- If it is a parenthesized expression, maybe add a line break - (Parenthesized _ _ _) -> softline' + (Parenthesized {}) -> softline' -- Otherwise, very likely add a line break _ -> line' @@ -154,7 +154,7 @@ prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trail -- Always expand if len > 1 prettyTerm (List (Ann pre paropen post) items parclose) = pretty (Ann pre paropen Nothing) - <> (surroundWith line $ nest $ pretty post <> prettyItems hardline items) + <> surroundWith line (nest $ pretty post <> prettyItems hardline items) <> pretty parclose prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) @@ -174,7 +174,7 @@ prettyTerm (Parenthesized paropen expr (Ann closePre parclose closePost)) (Application f a) -> prettyApp True mempty True f a -- Same thing for selections (Term (Selection t _ _)) | isAbsorbable t -> line' <> group expr <> line' - (Term (Selection _ _ _)) -> group expr <> line' + (Term (Selection {})) -> group expr <> line' -- Start on a new line for the others _ -> line' <> group expr <> line' @@ -229,19 +229,19 @@ moveParamsComments ((ParamAttr name maybeDefault (Just (Ann trivia comma Nothing))) : (ParamAttr (Ann trivia' name' Nothing) maybeDefault' maybeComma') : xs) - = (ParamAttr name maybeDefault (Just (Ann [] comma Nothing))) - : moveParamsComments ((ParamAttr (Ann (trivia ++ trivia') name' Nothing) maybeDefault' maybeComma') : xs) + = ParamAttr name maybeDefault (Just (Ann [] comma Nothing)) + : moveParamsComments (ParamAttr (Ann (trivia ++ trivia') name' Nothing) maybeDefault' maybeComma' : xs) -- This may seem like a nonsensical case, but keep in mind that blank lines also count as comments (trivia) moveParamsComments -- , name -- # comment -- ellipsis - [(ParamAttr name maybeDefault (Just (Ann trivia comma Nothing))) - ,(ParamEllipsis (Ann trivia' name' trailing'))] - = [(ParamAttr name maybeDefault (Just (Ann [] comma Nothing))) - , (ParamEllipsis (Ann (trivia ++ trivia') name' trailing'))] + [ParamAttr name maybeDefault (Just (Ann trivia comma Nothing)) + ,ParamEllipsis (Ann trivia' name' trailing')] + = [ParamAttr name maybeDefault (Just (Ann [] comma Nothing)) + , ParamEllipsis (Ann (trivia ++ trivia') name' trailing')] -- Inject a trailing comma on the last element if nessecary -moveParamsComments [(ParamAttr name def Nothing)] = [ParamAttr name def (Just (Ann [] TComma Nothing))] +moveParamsComments [ParamAttr name def Nothing] = [ParamAttr name def (Just (Ann [] TComma Nothing))] moveParamsComments (x : xs) = x : moveParamsComments xs moveParamsComments [] = [] @@ -257,7 +257,7 @@ instance Pretty Parameter where pretty (SetParameter bopen attrs bclose) = group $ pretty (moveTrailingCommentUp bopen) - <> (surroundWith sep $ nest $ sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) + <> surroundWith sep (nest $ sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments attrs) <> pretty bclose where -- pretty all ParamAttrs, but mark the trailing comma of the last element specially @@ -265,7 +265,7 @@ instance Pretty Parameter where handleTrailingComma :: [ParamAttr] -> [Doc] handleTrailingComma [] = [] -- That's the case we're interested in - handleTrailingComma [(ParamAttr name maybeDefault (Just (Ann [] TComma Nothing)))] + handleTrailingComma [ParamAttr name maybeDefault (Just (Ann [] TComma Nothing))] = [pretty (ParamAttr name maybeDefault Nothing) <> trailing ","] handleTrailingComma (x:xs) = pretty x : handleTrailingComma xs @@ -307,9 +307,9 @@ instance Pretty Parameter where prettyApp :: Bool -> Doc -> Bool -> Expression -> Expression -> Doc prettyApp indentFunction pre hasPost f a = let - absorbApp (Application f' a') = (group' Transparent $ absorbApp f') <> line <> (nest (group' Priority a')) + absorbApp (Application f' a') = group' Transparent (absorbApp f') <> line <> nest (group' Priority a') absorbApp expr - | indentFunction && (null comment') = nest $ group' RegularG $ line' <> pretty expr + | indentFunction && null comment' = nest $ group' RegularG $ line' <> pretty expr | otherwise = pretty expr absorbLast (Term t) | isAbsorbable t @@ -319,7 +319,7 @@ prettyApp indentFunction pre hasPost f a (Term (Parenthesized open (Abstraction (IDParameter name) colon (Term body)) close )) - | isAbsorbableTerm body && all (not . hasTrivia) [open, name, colon] + | isAbsorbableTerm body && not (any hasTrivia [open, name, colon]) = group' Priority $ nest $ pretty open <> pretty name <> pretty colon <> hardspace <> prettyTermWide body @@ -329,7 +329,7 @@ prettyApp indentFunction pre hasPost f a (Term (Parenthesized open (Application (Term (Token ident@(Ann _ fn@(Identifier _) _))) (Term body)) close )) - | isAbsorbableTerm body && all (not . hasTrivia) [open, ident, close] + | isAbsorbableTerm body && not (any hasTrivia [open, ident, close]) = group' Priority $ nest $ pretty open <> pretty fn <> hardspace <> prettyTermWide body @@ -350,10 +350,10 @@ prettyApp indentFunction pre hasPost f a in pretty comment' <> ( - if isSimple (Application f a) && isJust (renderedFUnexpanded) then - (group' RegularG $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a) + if isSimple (Application f a) && isJust renderedFUnexpanded then + group' RegularG $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a else - (group' RegularG $ renderedF <> line <> absorbLast a <> post) + group' RegularG $ renderedF <> line <> absorbLast a <> post ) <> (if hasPost && not (null comment') then hardline else mempty) @@ -381,7 +381,7 @@ isAbsorbableExpr expr = case expr of (With _ _ _ (Term t)) | isAbsorbableTerm t -> True -- Absorb function declarations but only those with simple parameter(s) (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t -> True - (Abstraction (IDParameter _) _ body@(Abstraction _ _ _)) -> isAbsorbableExpr body + (Abstraction (IDParameter _) _ body@(Abstraction {})) -> isAbsorbableExpr body _ -> False isAbsorbable :: Term -> Bool @@ -401,13 +401,12 @@ absorbParen :: Ann Token -> Expression -> Ann Token -> Doc absorbParen (Ann pre' open post') expr (Ann pre'' close post'') = group' Priority $ nest $ pretty (Ann pre' open Nothing) -- Move any trailing comments on the opening parenthesis down into the body - <> (surroundWith line' $ group' RegularG $ nest $ + <> surroundWith line' (group' RegularG $ nest $ pretty (mapFirstToken - (\(Ann leading token trailing') -> (Ann (maybeToList (toLineComment <$> post') ++ leading) token trailing')) + (\(Ann leading token trailing') -> Ann (maybeToList (toLineComment <$> post') ++ leading) token trailing') expr) -- Move any leading comments on the closing parenthesis up into the nest - <> pretty pre'' - ) + <> pretty pre'') <> pretty (Ann [] close post'') -- Note that unlike for absorbable terms which can be force-absorbed, some expressions @@ -439,7 +438,7 @@ absorbRHS expr = case expr of -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise (Application f a) -> prettyApp False line False f a - (With _ _ _ _) -> group' RegularG $ line <> pretty expr + (With {}) -> group' RegularG $ line <> pretty expr -- Special case `//` and `++` operations to be more compact in some cases -- Case 1: two arguments, LHS is absorbable term, RHS fits onto the last line (Operation (Term t) (Ann [] op Nothing) b) | isAbsorbable t && isUpdateOrConcat op -> @@ -449,7 +448,7 @@ absorbRHS expr = case expr of group' RegularG $ line <> pretty l <> line <> group' Transparent (pretty op <> hardspace <> group' Priority (prettyTermWide t)) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] op Nothing) (Application f a)) | isUpdateOrConcat op -> - line <> (group l) <> line <> prettyApp False (pretty op <> hardspace) False f a + line <> group l <> line <> prettyApp False (pretty op <> hardspace) False f a -- Everything else: -- If it fits on one line, it fits -- If it fits on one line but with a newline after the `=`, it fits (including semicolon) @@ -464,7 +463,7 @@ absorbRHS expr = case expr of instance Pretty Expression where pretty (Term t) = pretty t - pretty with@(With _ _ _ _) = prettyWith False with + pretty with@(With {}) = prettyWith False with -- Let bindings are always fully expanded (no single-line form) -- We also take the comments around the `in` (trailing, leading and detached binder comments) @@ -474,7 +473,7 @@ instance Pretty Expression where where -- Convert the TrailingComment to a Trivium, if present convertTrailing Nothing = [] - convertTrailing (Just (TrailingComment t)) = [(LineComment (" " <> t))] + convertTrailing (Just (TrailingComment t)) = [LineComment (" " <> t)] -- Extract detached comments at the bottom. -- This uses a custom variant of span/spanJust/spanMaybe. @@ -482,8 +481,7 @@ instance Pretty Expression where -- are constructed in a way that they end up correct again. (binderComments, bindersWithoutComments) = foldr - (\item -> \(start, rest) -> - case item of + (\ item (start, rest) -> case item of (DetachedComments inner) | null rest -> (inner : start, rest) _ -> (start, item : rest) ) @@ -506,10 +504,10 @@ instance Pretty Expression where -- Add something to the left of a function application -- We need to walk down the arguments here because applications are left-associative. insertIntoApp :: Expression -> Expression -> (Expression, Expression) - insertIntoApp insert (Application f a) = ((uncurry Application $ insertIntoApp insert f), a) + insertIntoApp insert (Application f a) = (uncurry Application $ insertIntoApp insert f, a) insertIntoApp insert other = (insert, other) - pretty expr@(If _ _ _ _ _ _) + pretty expr@(If {}) -- If the first `if` or any `else` has a trailing comment, move it up. -- However, don't any subsequent `if` (`else if`). We could do that, but that -- would require taking care of edge cases which are not worth handling. @@ -520,7 +518,7 @@ instance Pretty Expression where prettyIf sep (If if_ cond then_ expr0 else_ expr1) -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) = group (pretty if_ <> line <> nest (pretty cond) <> line <> pretty then_) - <> (surroundWith sep $ nest $ group expr0) + <> surroundWith sep (nest $ group expr0) -- Using hardline here is okay because it will only apply to nested ifs, which should not be inline anyways. <> pretty (moveTrailingCommentUp else_) <> hardspace <> prettyIf hardline expr1 prettyIf _ x @@ -560,14 +558,14 @@ instance Pretty Expression where -- We still need to keep the operators around because they might have comments attached to them. -- An operator is put together with its succeeding expression. Only the first operand has none. flatten :: Maybe Leaf -> Expression -> [(Maybe Leaf, Expression)] - flatten opL (Operation a opR b) | opR == op = (flatten opL a) ++ (flatten (Just opR) b) + flatten opL (Operation a opR b) | opR == op = flatten opL a ++ flatten (Just opR) b flatten opL x = [(opL, x)] -- Called on every operand except the first one (a.k.a. RHS) absorbOperation :: Expression -> Doc - absorbOperation (Term t) | isAbsorbable t = hardspace <> (pretty t) + absorbOperation (Term t) | isAbsorbable t = hardspace <> pretty t -- Force nested operations to start on a new line - absorbOperation x@(Operation _ _ _) = group' RegularG $ line <> pretty x + absorbOperation x@(Operation {}) = group' RegularG $ line <> pretty x -- Force applications to start on a new line if more than the last argument is multiline absorbOperation (Application f a) = group $ prettyApp False line False f a absorbOperation x = hardspace <> pretty x @@ -576,11 +574,11 @@ instance Pretty Expression where -- First element prettyOperation (Nothing, expr) = pretty expr -- The others - prettyOperation ((Just op'), expr) = + prettyOperation (Just op', expr) = line <> pretty (moveTrailingCommentUp op') <> nest (absorbOperation expr) in group' RegularG $ - (concat . map prettyOperation . (flatten Nothing)) operation + (concatMap prettyOperation . flatten Nothing) operation pretty (MemberCheck expr qmark sel) = pretty expr <> softline @@ -643,7 +641,7 @@ instance Pretty StringPart where whole' = pretty whole inner = fromMaybe -- default - (surroundWith line' $ nest $ whole') + (surroundWith line' $ nest whole') -- force on one line if possible (unexpandSpacing' (Just 30) whole') @@ -662,7 +660,7 @@ instance Pretty [StringPart] where (Application f a) -> prettyApp True mempty True f a -- Same thing for selections (Term (Selection t _ _)) | isAbsorbable t -> line' <> group expr <> line' - (Term (Selection _ _ _)) -> group expr <> line' + (Term (Selection {})) -> group expr <> line' -- Start on a new line for the others _ -> line' <> group expr <> line' @@ -694,5 +692,5 @@ prettyIndentedString parts = group $ -- However, for single-line strings it should be omitted, because often times a line break will -- not reduce the indentation at all <> (case parts of { _:_:_ -> line'; _ -> mempty }) - <> (nest $ sepBy newline $ map pretty parts) + <> nest (sepBy newline $ map pretty parts) <> text "''" diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 242895a5..7307f58d 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase, TupleSections, FlexibleInstances #-} +{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase, FlexibleInstances #-} module Nixfmt.Types where @@ -136,7 +136,7 @@ instance Eq Parameter where where -- Compare two lists of paramters, but for the last argument don't compare whether or not there is a trailing comma cmp [] [] = True - cmp [(ParamAttr x1 x2 _)] [(ParamAttr y1 y2 _)] = x1 == y1 && x2 == y2 + cmp [ParamAttr x1 x2 _] [ParamAttr y1 y2 _] = x1 == y1 && x2 == y2 cmp (x:xs) (y:ys) = x == y && cmp xs ys cmp _ _ = False (ContextParameter l1 l2 l3) == (ContextParameter r1 r2 r3) = l1 == r1 && l2 == r2 && l3 == r3 @@ -216,10 +216,10 @@ instance LanguageElement SimpleSelector where (StringSelector str) -> [Term (SimpleString str)] instance LanguageElement Selector where - mapFirstToken' f (Selector Nothing ident) = first (\ident' -> Selector Nothing ident') $ mapFirstToken' f ident + mapFirstToken' f (Selector Nothing ident) = first (Selector Nothing) $ mapFirstToken' f ident mapFirstToken' f (Selector (Just dot) ident) = first (\dot' -> Selector (Just dot') ident) $ mapFirstToken' f dot - mapLastToken' f (Selector dot ident) = first (\ident' -> Selector dot ident') $ mapLastToken' f ident + mapLastToken' f (Selector dot ident) = first (Selector dot) $ mapLastToken' f ident walkSubprograms (Selector _ ident) = walkSubprograms ident @@ -244,7 +244,7 @@ instance LanguageElement Parameter where (ContextParameter first' at second) -> first (ContextParameter first' at) (mapLastToken' f second) walkSubprograms = \case - (IDParameter ident) -> [(Term $ Token ident)] + (IDParameter ident) -> [Term $ Token ident] (SetParameter _ bindings _) -> bindings >>= walkSubprograms (ContextParameter left _ right) -> walkSubprograms left ++ walkSubprograms right @@ -312,11 +312,11 @@ instance LanguageElement Expression where (Assert assert cond semicolon body) -> first (\assert' -> Assert assert' cond semicolon body) (f assert) (If if_ expr0 then_ expr1 else_ expr2) -> first (\if_' -> If if_' expr0 then_ expr1 else_ expr2) (f if_) (Abstraction param colon body) -> first (\param' -> Abstraction param' colon body) (mapFirstToken' f param) - (Application g a) -> first (\g' -> Application g' a) (mapFirstToken' f g) + (Application g a) -> first (`Application` a) (mapFirstToken' f g) (Operation left op right) -> first (\left' -> Operation left' op right) (mapFirstToken' f left) (MemberCheck name dot selectors) -> first (\name' -> MemberCheck name' dot selectors) (mapFirstToken' f name) - (Negation not_ expr) -> first (\not_' -> Negation not_' expr) (f not_) - (Inversion tilde expr) -> first (\tilde' -> Inversion tilde' expr) (f tilde) + (Negation not_ expr) -> first (`Negation` expr) (f not_) + (Inversion tilde expr) -> first (`Inversion` expr) (f tilde) mapLastToken' f = \case (Term term) -> first Term (mapLastToken' f term) @@ -337,12 +337,12 @@ instance LanguageElement Expression where (With _ expr0 _ expr1) -> [expr0, expr1] (Let _ items _ body) -> body : (unItems items >>= \case -- Map each binding to a singleton set - (CommentedItem _ item) -> [ Term (Set Nothing (ann TBraceOpen) (Items [(CommentedItem [] item)]) (ann TBraceClose)) ] + (CommentedItem _ item) -> [ Term (Set Nothing (ann TBraceOpen) (Items [CommentedItem [] item]) (ann TBraceClose)) ] (DetachedComments _) -> [] ) (Assert _ cond _ body) -> [cond, body] (If _ expr0 _ expr1 _ expr2) -> [expr0, expr1, expr2] - (Abstraction param _ body) -> [(Abstraction param (ann TColon) (Term (Token (ann (Identifier "_"))))), body] + (Abstraction param _ body) -> [Abstraction param (ann TColon) (Term (Token (ann (Identifier "_")))), body] (Application g a) -> [g, a] (Operation left _ right) -> [left, right] (MemberCheck name _ sels) -> name : (sels >>= walkSubprograms) @@ -351,10 +351,10 @@ instance LanguageElement Expression where instance LanguageElement (Whole Expression) where mapFirstToken' f (Whole a trivia) - = first (\a' -> Whole a' trivia) (mapFirstToken' f a) + = first (`Whole` trivia) (mapFirstToken' f a) mapLastToken' f (Whole a trivia) - = first (\a' -> Whole a' trivia) (mapLastToken' f a) + = first (`Whole` trivia) (mapLastToken' f a) walkSubprograms (Whole a _) = [a] diff --git a/src/Nixfmt/Util.hs b/src/Nixfmt/Util.hs index 021fc72a..31b55df6 100644 --- a/src/Nixfmt/Util.hs +++ b/src/Nixfmt/Util.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} + module Nixfmt.Util ( manyP