From d2cc629ebe97700e5895e2371766f7ebbaa7bedd Mon Sep 17 00:00:00 2001 From: Lars Jellema Date: Thu, 6 Apr 2023 11:51:46 +0200 Subject: [PATCH 001/125] Apply hlint suggestions --- src/Nixfmt/Lexer.hs | 8 ++++---- src/Nixfmt/Parser.hs | 29 +++++++++++++++-------------- src/Nixfmt/Predoc.hs | 3 +-- src/Nixfmt/Pretty.hs | 4 ++-- 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index b331359b..3378a861 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -12,8 +12,8 @@ import Data.Char (isSpace) import Data.List (dropWhileEnd) import Data.Maybe (fromMaybe) import Data.Text as Text - (Text, intercalate, length, lines, null, pack, replace, replicate, strip, - stripEnd, stripPrefix, stripStart, takeWhile) + (Text, length, lines, null, pack, replace, replicate, strip, + stripEnd, stripPrefix, stripStart, takeWhile, unwords) import Text.Megaparsec (SourcePos(..), anySingle, chunk, getSourcePos, hidden, many, manyTill, some, try, unPos, (<|>)) @@ -32,7 +32,7 @@ preLexeme :: Parser a -> Parser a preLexeme p = p <* manyP (\x -> isSpace x && x /= '\n' && x /= '\r') newlines :: Parser ParseTrivium -newlines = PTNewlines <$> Prelude.length <$> some (preLexeme eol) +newlines = PTNewlines . Prelude.length <$> some (preLexeme eol) splitLines :: Text -> [Text] splitLines = dropWhile Text.null . dropWhileEnd Text.null @@ -65,7 +65,7 @@ convertTrailing = toMaybe . join . map toText where toText (PTLineComment c) = strip c toText (PTBlockComment [c]) = strip c toText _ = "" - join = intercalate " " . filter (/="") + join = Text.unwords . filter (/="") toMaybe "" = Nothing toMaybe c = Just $ TrailingComment c diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index 0c11cfc3..9246790a 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE LambdaCase, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Nixfmt.Parser where @@ -16,6 +16,7 @@ import qualified Control.Monad.Combinators.Expr as MPExpr (Operator(..), makeExprParser) import Data.Char (isAlpha) import Data.Foldable (toList) +import Data.Functor (($>)) import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.Text as Text (Text, cons, empty, singleton, split, stripPrefix) import Text.Megaparsec @@ -41,7 +42,7 @@ ann f p = try $ lexeme $ f <$> p -- | parses a token without parsing trivia after it rawSymbol :: Token -> Parser Token -rawSymbol t = chunk (tokenText t) *> return t +rawSymbol t = chunk (tokenText t) $> t symbol :: Token -> Parser (Ann Token) symbol = lexeme . rawSymbol @@ -72,7 +73,7 @@ identifier :: Parser (Ann Token) identifier = ann Identifier $ do ident <- Text.cons <$> satisfy (\x -> isAlpha x || x == '_') <*> manyP identChar - guard $ not $ ident `elem` reservedNames + guard $ ident `notElem` reservedNames return ident slash :: Parser Text @@ -105,9 +106,9 @@ interpolation = Interpolation <$> simpleStringPart :: Parser StringPart simpleStringPart = TextPart <$> someText ( - chunk "\\n" *> pure "\n" <|> - chunk "\\r" *> pure "\r" <|> - chunk "\\t" *> pure "\t" <|> + chunk "\\n" $> "\n" <|> + chunk "\\r" $> "\r" <|> + chunk "\\t" $> "\t" <|> chunk "\\" *> (Text.singleton <$> anySingle) <|> chunk "$$" <|> try (chunk "$" <* notFollowedBy (char '{')) <|> @@ -115,12 +116,12 @@ simpleStringPart = TextPart <$> someText ( indentedStringPart :: Parser StringPart indentedStringPart = TextPart <$> someText ( - chunk "''\\n" *> pure "\n" <|> - chunk "''\\r" *> pure "\r" <|> - chunk "''\\t" *> pure "\t" <|> + chunk "''\\n" $> "\n" <|> + chunk "''\\r" $> "\r" <|> + chunk "''\\t" $> "\t" <|> chunk "''\\" *> (Text.singleton <$> anySingle) <|> - chunk "''$" *> pure "$" <|> - chunk "'''" *> pure "''" <|> + chunk "''$" $> "$" <|> + chunk "'''" $> "''" <|> chunk "$$" <|> try (chunk "$" <* notFollowedBy (char '{')) <|> try (chunk "'" <* notFollowedBy (char '\'')) <|> @@ -151,7 +152,7 @@ lineHead :: [StringPart] -> Maybe Text lineHead [] = Nothing lineHead line | isEmptyLine line = Nothing lineHead (TextPart t : _) = Just t -lineHead (Interpolation _ _ _ : _) = Just "" +lineHead (Interpolation{} : _) = Just "" stripParts :: Text -> [StringPart] -> [StringPart] stripParts indentation (TextPart t : xs) = @@ -170,7 +171,7 @@ splitLines (TextPart t : xs) = splitLines (x : xs) = case splitLines xs of - (xs' : xss) -> ((x : xs') : xss) + (xs' : xss) -> (x : xs') : xss _ -> error "unreachable" stripIndentation :: [[StringPart]] -> [[StringPart]] @@ -255,7 +256,7 @@ setParameter = SetParameter <$> bopen <*> attrs <*> bclose commaAttrs = many $ try $ attrParameter $ Just $ symbol TComma ellipsis = ParamEllipsis <$> symbol TEllipsis lastAttr = attrParameter Nothing <|> ellipsis - attrs = commaAttrs <> (toList <$> optional (lastAttr)) + attrs = commaAttrs <> (toList <$> optional lastAttr) contextParameter :: Parser Parameter contextParameter = diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 4e1b41c6..058c2b1e 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -4,8 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE DeriveFoldable, DeriveFunctor, FlexibleInstances, - OverloadedStrings, StandaloneDeriving #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} -- | This module implements a layer around the prettyprinter package, making it -- easier to use. diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index eb4d7200..2da9ef83 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -117,8 +117,8 @@ prettyTerm (Parenthesized (Ann paropen trailing leading) expr parclose) <> nest 2 (pretty leading <> group expr) <> pretty parclose instance Pretty Term where - pretty l@(List _ _ _) = group $ prettyTerm l - pretty x = prettyTerm x + pretty l@List{} = group $ prettyTerm l + pretty x = prettyTerm x toLeading :: Maybe TrailingComment -> Trivia toLeading Nothing = [] From d83a00c66dbb8c9e2aa38ab45b0581e8d774f7c8 Mon Sep 17 00:00:00 2001 From: Lars Jellema Date: Thu, 6 Apr 2023 12:28:44 +0200 Subject: [PATCH 002/125] Generalize parsing utilities --- src/Nixfmt/Util.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Nixfmt/Util.hs b/src/Nixfmt/Util.hs index f648c1ff..4590ff62 100644 --- a/src/Nixfmt/Util.hs +++ b/src/Nixfmt/Util.hs @@ -30,7 +30,7 @@ import Data.Maybe (fromMaybe) import Data.Text as Text (Text, all, commonPrefixes, concat, empty, null, splitAt, stripEnd, stripPrefix, takeWhile) import Text.Megaparsec - (ParsecT, Stream, Token, Tokens, many, some, takeWhile1P, takeWhileP) + (MonadParsec, Token, Tokens, many, some, takeWhile1P, takeWhileP) charClass :: [Char] -> Char -> Bool charClass s c = isAlpha c || isDigit c || elem c s @@ -48,19 +48,19 @@ uriChar :: Char -> Bool uriChar = charClass "~!@$%&*-=_+:',./?" -- | Match one or more characters that match a predicate. -someP :: (Stream s, Ord e) => (Token s -> Bool) -> ParsecT e s m (Tokens s) +someP :: MonadParsec e s m => (Token s -> Bool) -> m (Tokens s) someP = takeWhile1P Nothing -- | Match zero or more characters that match a predicate. -manyP :: (Stream s, Ord e) => (Token s -> Bool) -> ParsecT e s m (Tokens s) +manyP :: MonadParsec e s m => (Token s -> Bool) -> m (Tokens s) manyP = takeWhileP Nothing -- | Match one or more texts and return the concatenation. -someText :: (Stream s, Ord e) => ParsecT e s m Text -> ParsecT e s m Text +someText :: MonadParsec e s m => m Text -> m Text someText p = Text.concat <$> some p -- | Match zero or more texts and return the concatenation. -manyText :: (Stream s, Ord e) => ParsecT e s m Text -> ParsecT e s m Text +manyText :: MonadParsec e s m => m Text -> m Text manyText p = Text.concat <$> many p -- | The longest common prefix of the arguments. From c8ebd02b4cb3bbcb1decd71f01962fdeaf660d3b Mon Sep 17 00:00:00 2001 From: Lars Jellema Date: Thu, 6 Apr 2023 12:29:01 +0200 Subject: [PATCH 003/125] Attach leading trivia to next token --- nixfmt.cabal | 2 ++ src/Nixfmt/Lexer.hs | 41 ++++++++++++++++----- src/Nixfmt/Parser.hs | 24 ++++++++----- src/Nixfmt/Predoc.hs | 4 +-- src/Nixfmt/Pretty.hs | 86 +++++++++++++++++++++----------------------- src/Nixfmt/Types.hs | 13 ++++--- 6 files changed, 101 insertions(+), 69 deletions(-) diff --git a/nixfmt.cabal b/nixfmt.cabal index 704461c9..44a653e1 100644 --- a/nixfmt.cabal +++ b/nixfmt.cabal @@ -88,9 +88,11 @@ library build-depends: base >= 4.12.0 && < 4.17 , megaparsec >= 9.0.1 && < 9.3 + , mtl , parser-combinators >= 1.0.3 && < 1.4 , scientific >= 0.3.0 && < 0.4.0 , text >= 1.2.3 && < 1.3 + , transformers default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index 3378a861..f6ec88d6 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -4,22 +4,25 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE LambdaCase, OverloadedStrings #-} +{-# LANGUAGE BlockArguments, FlexibleContexts, LambdaCase, OverloadedStrings #-} -module Nixfmt.Lexer (lexeme) where +module Nixfmt.Lexer (lexeme, whole) where +import Control.Monad.State (MonadState, evalStateT, get, modify, put) import Data.Char (isSpace) import Data.List (dropWhileEnd) import Data.Maybe (fromMaybe) import Data.Text as Text - (Text, length, lines, null, pack, replace, replicate, strip, - stripEnd, stripPrefix, stripStart, takeWhile, unwords) + (Text, length, lines, null, pack, replace, replicate, strip, stripEnd, + stripPrefix, stripStart, takeWhile, unwords) +import Data.Void (Void) import Text.Megaparsec - (SourcePos(..), anySingle, chunk, getSourcePos, hidden, many, manyTill, some, - try, unPos, (<|>)) + (Parsec, SourcePos(..), anySingle, chunk, getSourcePos, hidden, many, + manyTill, some, try, unPos, (<|>)) import Text.Megaparsec.Char (eol) -import Nixfmt.Types (Ann(..), Parser, TrailingComment(..), Trivia, Trivium(..)) +import Nixfmt.Types + (Ann(..), Whole(..), Parser, TrailingComment(..), Trivia, Trivium(..)) import Nixfmt.Util (manyP) data ParseTrivium @@ -92,8 +95,28 @@ convertTrivia pts = trivia :: Parser [ParseTrivium] trivia = many $ hidden $ lineComment <|> blockComment <|> newlines +-- The following primitives to interact with the state monad that stores trivia +-- are designed to prevent trivia from being dropped or duplicated by accident. + +takeTrivia :: MonadState Trivia m => m Trivia +takeTrivia = get <* put [] + +pushTrivia :: MonadState Trivia m => Trivia -> m () +pushTrivia t = modify (<>t) + lexeme :: Parser a -> Parser (Ann a) lexeme p = do + lastLeading <- takeTrivia token <- preLexeme p - (trailing, leading) <- convertTrivia <$> trivia - return $ Ann token trailing leading + (trailing, nextLeading) <- convertTrivia <$> trivia + pushTrivia nextLeading + return $ Ann token trailing lastLeading + +-- | Tokens normally have only leading trivia and one trailing comment on the same +-- line. A whole x also parses and stores final trivia after the x. A whole also +-- does not interact with the trivia state of its surroundings. +whole :: Parser a -> Parsec Void Text (Whole a) +whole pa = flip evalStateT [] do + preLexeme $ pure () + pushTrivia . convertLeading =<< trivia + Whole <$> pa <*> takeTrivia diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index 9246790a..202f39ce 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} module Nixfmt.Parser where @@ -14,23 +14,25 @@ import Control.Monad (guard, liftM2) import Control.Monad.Combinators (sepBy) import qualified Control.Monad.Combinators.Expr as MPExpr (Operator(..), makeExprParser) +import Control.Monad.Trans.Class (lift) import Data.Char (isAlpha) import Data.Foldable (toList) import Data.Functor (($>)) import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.Text as Text (Text, cons, empty, singleton, split, stripPrefix) +import Data.Void (Void) import Text.Megaparsec - (anySingle, chunk, eof, label, lookAhead, many, notFollowedBy, oneOf, + (Parsec, anySingle, chunk, eof, label, lookAhead, many, notFollowedBy, oneOf, optional, satisfy, some, try, (<|>)) import Text.Megaparsec.Char (char) import qualified Text.Megaparsec.Char.Lexer as L (decimal) -import Nixfmt.Lexer (lexeme) +import Nixfmt.Lexer (lexeme, whole) +import Nixfmt.Parser.Float (floatParse) import Nixfmt.Types - (Ann, Binder(..), Expression(..), File(..), Fixity(..), Leaf, Operator(..), + (Ann, Binder(..), Expression(..), File, Fixity(..), Leaf, Operator(..), ParamAttr(..), Parameter(..), Parser, Path, Selector(..), SimpleSelector(..), String, StringPart(..), Term(..), Token(..), operators, tokenText) -import Nixfmt.Parser.Float (floatParse) import Nixfmt.Util (commonIndentation, identChar, isSpaces, manyP, manyText, pathChar, schemeChar, someP, someText, uriChar) @@ -79,6 +81,12 @@ identifier = ann Identifier $ do slash :: Parser Text slash = chunk "/" <* notFollowedBy (char '/') +instance Semigroup a => Semigroup (Parser a) where + fx <> fy = do + x <- fx + y <- fy + pure $ x <> y + envPath :: Parser (Ann Token) envPath = ann EnvPath $ char '<' *> someP pathChar <> manyText (slash <> someP pathChar) @@ -102,7 +110,7 @@ uri = fmap (pure . pure . TextPart) $ try $ interpolation :: Parser StringPart interpolation = Interpolation <$> - symbol TInterOpen <*> expression <*> rawSymbol TInterClose + (rawSymbol TInterOpen *> lift (whole expression) <* rawSymbol TInterClose) simpleStringPart :: Parser StringPart simpleStringPart = TextPart <$> someText ( @@ -342,5 +350,5 @@ expression :: Parser Expression expression = label "expression" $ try operation <|> abstraction <|> with <|> letIn <|> ifThenElse <|> assert -file :: Parser File -file = File <$> lexeme (return SOF) <*> expression <* eof +file :: Parsec Void Text File +file = whole (expression <* eof) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 058c2b1e..8082364a 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -32,7 +32,7 @@ module Nixfmt.Predoc ) where import Data.List (intersperse) -import Data.Text as Text (Text, concat, length, pack, replicate) +import Data.Text as Text (Text, concat, length, pack, replicate, strip) -- | Sequential Spacings are reduced to a single Spacing by taking the maximum. -- This means that e.g. a Space followed by an Emptyline results in just an @@ -192,7 +192,7 @@ moveLinesIn (Node ann xs : ys) = moveLinesIn (x : xs) = x : moveLinesIn xs layout :: Pretty a => Int -> a -> Text -layout w = layoutGreedy w . fixup . pretty +layout w = (<>"\n") . Text.strip . layoutGreedy w . fixup . pretty -- 1. Move and merge Spacings. -- 2. Convert Softlines to Grouped Lines and Hardspaces to Texts. diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 2da9ef83..a5e25130 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -20,7 +20,7 @@ import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, hardline, hardspace, hcat, line, line', nest, newline, pretty, sepBy, softline, softline', text, textWidth) import Nixfmt.Types - (Ann(..), Binder(..), Expression(..), File(..), Leaf, ParamAttr(..), + (Ann(..), Binder(..), Expression(..), Whole(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), Token(..), TrailingComment(..), Trivia, Trivium(..), tokenText) import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) @@ -53,13 +53,13 @@ instance Pretty [Trivium] where instance Pretty a => Pretty (Ann a) where pretty (Ann x trailing leading) - = pretty x <> pretty trailing <> pretty leading + = pretty leading <> pretty x <> pretty trailing instance Pretty SimpleSelector where pretty (IDSelector i) = pretty i pretty (InterpolSelector interpol) = pretty interpol pretty (StringSelector (Ann s trailing leading)) - = prettySimpleString s <> pretty trailing <> pretty leading + = pretty leading <> prettySimpleString s <> pretty trailing instance Pretty Selector where pretty (Selector dot sel Nothing) @@ -74,15 +74,15 @@ instance Pretty Binder where = base $ group (pretty inherit <> softline <> nest 2 (sepBy softline ids)) <> pretty semicolon - pretty (Inherit inherit source ids semicolon) + pretty (Inherit inherit (Just source) ids semicolon) = base $ group (pretty inherit <> hardspace <> pretty source <> line <> nest 2 (sepBy softline ids)) <> pretty semicolon pretty (Assignment selectors assign expr semicolon) - = base $ group (hcat selectors <> hardspace - <> nest 2 (pretty assign <> softline <> pretty expr)) - <> pretty semicolon + = base $ hcat selectors <> hardspace <> group (nest 2 value) + where + value = pretty assign <> softline <> pretty expr <> pretty semicolon -- | Pretty print a term without wrapping it in a group. prettyTerm :: Term -> Doc @@ -91,30 +91,29 @@ prettyTerm (String s) = pretty s prettyTerm (Path p) = pretty p prettyTerm (Selection term selectors) = pretty term <> hcat selectors -prettyTerm (List (Ann paropen Nothing []) [] parclose) - = pretty paropen <> hardspace <> pretty parclose +prettyTerm (List (Ann paropen Nothing leading) [] (Ann parclose trailing [])) + = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing -prettyTerm (List (Ann paropen Nothing []) [item] parclose) +prettyTerm (List (Ann paropen Nothing leading) [item] (Ann parclose trailing [])) | isAbsorbable item - = pretty paropen <> pretty item <> pretty parclose + = pretty leading <> pretty paropen <> pretty item <> pretty parclose <> pretty trailing -prettyTerm (List (Ann paropen trailing leading) items parclose) - = base $ pretty paropen <> pretty trailing <> line - <> nest 2 (pretty leading <> sepBy line (map group items)) <> line +prettyTerm (List paropen items parclose) + = base $ pretty paropen <> line + <> nest 2 (sepBy line (map group items)) <> line <> pretty parclose prettyTerm (Set Nothing (Ann paropen Nothing []) [] parclose) = pretty paropen <> hardspace <> pretty parclose -prettyTerm (Set krec (Ann paropen trailing leading) binders parclose) +prettyTerm (Set krec paropen binders parclose) = base $ pretty (fmap ((<>hardspace) . pretty) krec) - <> pretty paropen <> pretty trailing <> line - <> nest 2 (pretty leading <> sepBy hardline binders) <> line + <> pretty paropen <> line + <> nest 2 (sepBy hardline binders) <> line <> pretty parclose -prettyTerm (Parenthesized (Ann paropen trailing leading) expr parclose) - = base $ pretty paropen <> pretty trailing - <> nest 2 (pretty leading <> group expr) <> pretty parclose +prettyTerm (Parenthesized paropen expr parclose) + = base $ pretty paropen <> nest 2 (group expr) <> pretty parclose instance Pretty Term where pretty l@List{} = group $ prettyTerm l @@ -200,16 +199,11 @@ instance Pretty Expression where <> nest 2 (group expr0) <> pretty semicolon) <> absorbSet expr1 - pretty (Let (Ann let_ letTrailing letLeading) binders - (Ann in_ inTrailing inLeading) expr) + pretty (Let let_ binders in_ expr) = base $ group letPart <> line <> group inPart - where letPart = pretty let_ <> pretty letTrailing <> line <> letBody + where letPart = pretty let_ <> line <> letBody inPart = pretty in_ <> hardspace <> pretty expr - letBody = nest 2 $ - pretty letLeading - <> sepBy hardline binders - <> pretty (toLeading inTrailing) - <> pretty inLeading + letBody = nest 2 $ sepBy hardline binders pretty (Assert assert cond semicolon expr) = base (pretty assert <> hardspace @@ -247,13 +241,9 @@ instance Pretty Expression where pretty (Inversion bang expr) = pretty bang <> pretty expr -instance Pretty File where - pretty (File (Ann _ Nothing leading) expr) - = group $ hcat leading <> pretty expr <> hardline - - pretty (File (Ann _ (Just (TrailingComment trailing)) leading) expr) - = group $ text "# " <> pretty trailing <> hardline - <> hcat leading <> pretty expr <> hardline +instance Pretty a => Pretty (Whole a) where + pretty (Whole x finalTrivia) + = group $ pretty x <> pretty finalTrivia instance Pretty Token where pretty = text . tokenText @@ -331,22 +321,26 @@ isSimpleString parts instance Pretty StringPart where pretty (TextPart t) = text t - pretty (Interpolation paropen (Term t) parclose) + pretty (Interpolation (Whole (Term t) [])) | isAbsorbable t - = group $ pretty paropen <> prettyTerm t <> pretty parclose + = group $ text "${" <> prettyTerm t <> text "}" - pretty (Interpolation paropen expr parclose) + pretty (Interpolation (Whole expr [])) | isSimple expr - = pretty paropen <> pretty expr <> pretty parclose - | otherwise - = group $ pretty paropen <> line' - <> nest 2 (pretty expr) <> line' - <> pretty parclose + = text "${" <> pretty expr <> text "}" + + pretty (Interpolation whole) + = group $ text "${" <> line' + <> nest 2 (pretty whole) <> line' + <> text "}" instance Pretty [StringPart] where - pretty [Interpolation paropen expr parclose] - = group $ pretty paropen <> pretty expr <> pretty parclose + pretty [Interpolation expr] + = group $ text "${" <> pretty expr <> text "}" + -- If we split a string line over multiple code lines due to large + -- interpolations, make sure to indent based on the indentation of the line + -- in the string. pretty (TextPart t : parts) = text t <> nest indentation (hcat parts) where indentation = textWidth $ Text.takeWhile isSpace t @@ -370,7 +364,7 @@ prettyLine escapeText unescapeInterpol unescapeInterpols [] = [] unescapeInterpols (TextPart t : TextPart u : xs) = unescapeInterpols (TextPart (t <> u) : xs) - unescapeInterpols (TextPart t : xs@(Interpolation _ _ _ : _)) + unescapeInterpols (TextPart t : xs@(Interpolation{} : _)) = TextPart (unescapeInterpol t) : unescapeInterpols xs unescapeInterpols (x : xs) = x : unescapeInterpols xs diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 042b76c0..b2c024a7 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -10,12 +10,13 @@ module Nixfmt.Types where import Prelude hiding (String) +import Control.Monad.State (StateT) import Data.Text (Text, pack) import Data.Void (Void) import qualified Text.Megaparsec as MP (ParseErrorBundle, Parsec) -- | A @megaparsec@ @ParsecT@ specified for use with @nixfmt@. -type Parser = MP.Parsec Void Text +type Parser = StateT Trivia (MP.Parsec Void Text) -- | A @megaparsec@ @ParseErrorBundle@ specified for use with @nixfmt@. type ParseErrorBundle = MP.ParseErrorBundle Text Void @@ -43,7 +44,7 @@ type Leaf = Ann Token data StringPart = TextPart Text - | Interpolation Leaf Expression Token + | Interpolation (Whole Expression) deriving (Eq, Show) type Path = Ann [StringPart] @@ -101,10 +102,14 @@ data Expression | Inversion Leaf Expression deriving (Eq, Show) -data File - = File Leaf Expression +-- | A Whole a is an a including final trivia. It's assumed the a stores the +-- initial trivia. +data Whole a + = Whole a Trivia deriving (Eq, Show) +type File = Whole Expression + data Token = Integer Int | Float Double From 0c9d9a4e02ea88453708b61ffd0d50d09bba8c80 Mon Sep 17 00:00:00 2001 From: Lars Jellema Date: Thu, 6 Apr 2023 16:35:36 +0200 Subject: [PATCH 004/125] Add test for if-with-comments --- test/correct/if-with-comments.nix | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 test/correct/if-with-comments.nix diff --git a/test/correct/if-with-comments.nix b/test/correct/if-with-comments.nix new file mode 100644 index 00000000..20ebf2fe --- /dev/null +++ b/test/correct/if-with-comments.nix @@ -0,0 +1,15 @@ +v: + +# check if v is int +if isInt v then + # handle int v + fromInt v +# comments here apply to the branch below, not to the value above +# check if v is bool +else if isBool v then + # handle bool v + fromBool v +# no idea what v could be +else + # we give up + error "iunno" From f702d739ffbaba2ac890ba771790e44ed8541ab1 Mon Sep 17 00:00:00 2001 From: Lars Jellema Date: Thu, 6 Apr 2023 16:45:15 +0200 Subject: [PATCH 005/125] Fix argument order in Ann --- src/Nixfmt/Lexer.hs | 2 +- src/Nixfmt/Pretty.hs | 18 +++++++++--------- src/Nixfmt/Types.hs | 4 ++-- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index f6ec88d6..1d0cb07d 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -110,7 +110,7 @@ lexeme p = do token <- preLexeme p (trailing, nextLeading) <- convertTrivia <$> trivia pushTrivia nextLeading - return $ Ann token trailing lastLeading + return $ Ann lastLeading token trailing -- | Tokens normally have only leading trivia and one trailing comment on the same -- line. A whole x also parses and stores final trivia after the x. A whole also diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index a5e25130..7fa4556e 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -52,13 +52,13 @@ instance Pretty [Trivium] where pretty trivia = hardline <> hcat trivia instance Pretty a => Pretty (Ann a) where - pretty (Ann x trailing leading) + pretty (Ann leading x trailing) = pretty leading <> pretty x <> pretty trailing instance Pretty SimpleSelector where pretty (IDSelector i) = pretty i pretty (InterpolSelector interpol) = pretty interpol - pretty (StringSelector (Ann s trailing leading)) + pretty (StringSelector (Ann leading s trailing)) = pretty leading <> prettySimpleString s <> pretty trailing instance Pretty Selector where @@ -91,10 +91,10 @@ prettyTerm (String s) = pretty s prettyTerm (Path p) = pretty p prettyTerm (Selection term selectors) = pretty term <> hcat selectors -prettyTerm (List (Ann paropen Nothing leading) [] (Ann parclose trailing [])) +prettyTerm (List (Ann leading paropen Nothing) [] (Ann [] parclose trailing)) = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing -prettyTerm (List (Ann paropen Nothing leading) [item] (Ann parclose trailing [])) +prettyTerm (List (Ann leading paropen Nothing) [item] (Ann [] parclose trailing)) | isAbsorbable item = pretty leading <> pretty paropen <> pretty item <> pretty parclose <> pretty trailing @@ -103,7 +103,7 @@ prettyTerm (List paropen items parclose) <> nest 2 (sepBy line (map group items)) <> line <> pretty parclose -prettyTerm (Set Nothing (Ann paropen Nothing []) [] parclose) +prettyTerm (Set Nothing (Ann [] paropen Nothing) [] parclose) = pretty paropen <> hardspace <> pretty parclose prettyTerm (Set krec paropen binders parclose) @@ -150,11 +150,11 @@ instance Pretty Parameter where = pretty param1 <> pretty at <> pretty param2 isAbsorbable :: Term -> Bool -isAbsorbable (String (Ann parts@(_:_:_) _ _)) +isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts isAbsorbable (Set _ _ (_:_) _) = True -isAbsorbable (List (Ann _ Nothing []) [item] _) = isAbsorbable item -isAbsorbable (Parenthesized (Ann _ Nothing []) (Term t) _) = isAbsorbable t +isAbsorbable (List (Ann [] _ Nothing) [item] _) = isAbsorbable item +isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t isAbsorbable (List _ (_:_:_) _) = True isAbsorbable _ = False @@ -258,7 +258,7 @@ isSimpleSelector (Selector _ (IDSelector _) Nothing) = True isSimpleSelector _ = False isSimple :: Expression -> Bool -isSimple (Term (Token (Ann (Identifier _) Nothing []))) = True +isSimple (Term (Token (Ann [] (Identifier _) Nothing))) = True isSimple (Term (Selection t selectors)) = isSimple (Term t) && all isSimpleSelector selectors isSimple _ = False diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index b2c024a7..d85e6304 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -32,13 +32,13 @@ type Trivia = [Trivium] newtype TrailingComment = TrailingComment Text deriving (Eq, Show) data Ann a - = Ann a (Maybe TrailingComment) Trivia + = Ann Trivia a (Maybe TrailingComment) deriving (Show) -- | Equality of annotated syntax is defines as equality of their corresponding -- semantics, thus ignoring the annotations. instance Eq a => Eq (Ann a) where - Ann x _ _ == Ann y _ _ = x == y + Ann _ x _ == Ann _ y _ = x == y type Leaf = Ann Token From 5ae8e626ee8dcf6887061d0e32dea5563de52a24 Mon Sep 17 00:00:00 2001 From: Lars Jellema Date: Sat, 29 Apr 2023 10:02:36 +0200 Subject: [PATCH 006/125] Allow standalone comments in lists and sets --- src/Nixfmt/Lexer.hs | 2 +- src/Nixfmt/Parser.hs | 44 +++++++++--- src/Nixfmt/Pretty.hs | 95 +++++++++++++++++-------- src/Nixfmt/Types.hs | 27 +++++-- test/correct/commented-list.nix | 2 + test/correct/final-comments-in-sets.nix | 19 +++++ test/correct/short-inherit-from.nix | 4 ++ test/correct/standalone-comments.nix | 25 +++++++ 8 files changed, 171 insertions(+), 47 deletions(-) create mode 100644 test/correct/commented-list.nix create mode 100644 test/correct/final-comments-in-sets.nix create mode 100644 test/correct/short-inherit-from.nix create mode 100644 test/correct/standalone-comments.nix diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index 1d0cb07d..4382e475 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -6,7 +6,7 @@ {-# LANGUAGE BlockArguments, FlexibleContexts, LambdaCase, OverloadedStrings #-} -module Nixfmt.Lexer (lexeme, whole) where +module Nixfmt.Lexer (lexeme, pushTrivia, takeTrivia, whole) where import Control.Monad.State (MonadState, evalStateT, get, modify, put) import Data.Char (isSpace) diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index 202f39ce..694bde64 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -19,20 +19,22 @@ import Data.Char (isAlpha) import Data.Foldable (toList) import Data.Functor (($>)) import Data.Maybe (fromMaybe, mapMaybe, maybeToList) -import Data.Text as Text (Text, cons, empty, singleton, split, stripPrefix) +import Data.Text (Text) +import qualified Data.Text as Text import Data.Void (Void) import Text.Megaparsec - (Parsec, anySingle, chunk, eof, label, lookAhead, many, notFollowedBy, oneOf, - optional, satisfy, some, try, (<|>)) + (Parsec, anySingle, chunk, empty, eof, label, lookAhead, many, notFollowedBy, + oneOf, optional, satisfy, some, try, (<|>)) import Text.Megaparsec.Char (char) import qualified Text.Megaparsec.Char.Lexer as L (decimal) -import Nixfmt.Lexer (lexeme, whole) +import Nixfmt.Lexer (lexeme, pushTrivia, takeTrivia, whole) import Nixfmt.Parser.Float (floatParse) import Nixfmt.Types - (Ann, Binder(..), Expression(..), File, Fixity(..), Leaf, Operator(..), - ParamAttr(..), Parameter(..), Parser, Path, Selector(..), SimpleSelector(..), - String, StringPart(..), Term(..), Token(..), operators, tokenText) + (Ann, Binder(..), Expression(..), File, Fixity(..), Item(..), Items(..), Leaf, + Operator(..), ParamAttr(..), Parameter(..), Parser, Path, Selector(..), + SimpleSelector(..), String, StringPart(..), Term(..), Token(..), Trivium(..), + operators, tokenText) import Nixfmt.Util (commonIndentation, identChar, isSpaces, manyP, manyText, pathChar, schemeChar, someP, someText, uriChar) @@ -247,6 +249,28 @@ term = label "term" $ do return $ case s of [] -> t _ -> Selection t s +items :: Parser a -> Parser (Items a) +items p = Items <$> many (item p) <> (toList <$> optional lastItem) + +item :: Parser a -> Parser (Item a) +item p = detachedComment <|> CommentedItem <$> takeTrivia <*> p + +lastItem :: Parser (Item a) +lastItem = do + trivia <- takeTrivia + case trivia of + [] -> empty + _ -> pure $ DetachedComments trivia + +detachedComment :: Parser (Item a) +detachedComment = do + trivia <- takeTrivia + case break (== EmptyLine) trivia of + -- Return a set of comments that don't annotate the next item + (detached, EmptyLine : trivia') -> pushTrivia trivia' >> pure (DetachedComments detached) + -- The remaining trivia annotate the next item + _ -> pushTrivia trivia >> empty + -- ABSTRACTIONS attrParameter :: Maybe (Parser Leaf) -> Parser ParamAttr @@ -286,15 +310,15 @@ assignment :: Parser Binder assignment = Assignment <$> selectorPath <*> symbol TAssign <*> expression <*> symbol TSemicolon -binders :: Parser [Binder] -binders = many (assignment <|> inherit) +binders :: Parser (Items Binder) +binders = items (assignment <|> inherit) set :: Parser Term set = Set <$> optional (reserved KRec <|> reserved KLet) <*> symbol TBraceOpen <*> binders <*> symbol TBraceClose list :: Parser Term -list = List <$> symbol TBrackOpen <*> many term <*> symbol TBrackClose +list = List <$> symbol TBrackOpen <*> items term <*> symbol TBrackClose -- OPERATORS diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 7fa4556e..07e228f8 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -20,9 +20,10 @@ import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, hardline, hardspace, hcat, line, line', nest, newline, pretty, sepBy, softline, softline', text, textWidth) import Nixfmt.Types - (Ann(..), Binder(..), Expression(..), Whole(..), Leaf, ParamAttr(..), - Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), - Token(..), TrailingComment(..), Trivia, Trivium(..), tokenText) + (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, + ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), + StringPart(..), Term(..), Token(..), TrailingComment(..), Trivia, Trivium(..), + Whole(..), tokenText) import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) prettyCommentLine :: Text -> Doc @@ -33,6 +34,12 @@ prettyCommentLine l toLineComment :: Text -> Trivium toLineComment c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c +-- Make sure a group is not expanded because the token that starts it has +-- leading comments. +groupWithStart :: Pretty a => Ann a -> Doc -> Doc +groupWithStart (Ann leading a trailing) b + = pretty leading <> group (pretty a <> pretty trailing <> b) + instance Pretty TrailingComment where pretty (TrailingComment c) = hardspace <> text "#" <> hardspace <> text c <> hardline @@ -47,6 +54,18 @@ instance Pretty Trivium where <> nest 3 (hcat (map prettyCommentLine c)) <> text "*/" <> hardline +prettyItems :: Pretty a => Doc -> Items a -> Doc +prettyItems sep = prettyItems' . unItems + where + prettyItems' :: Pretty a => [Item a] -> Doc + prettyItems' [] = mempty + prettyItems' [DetachedComments trivia] = pretty trivia + prettyItems' [CommentedItem trivia x] = pretty trivia <> group x + prettyItems' (DetachedComments trivia : xs) + = pretty trivia <> emptyline <> prettyItems' xs + prettyItems' (CommentedItem trivia x : xs) + = pretty trivia <> group x <> sep <> prettyItems' xs + instance Pretty [Trivium] where pretty [] = mempty pretty trivia = hardline <> hcat trivia @@ -71,16 +90,16 @@ instance Pretty Selector where instance Pretty Binder where pretty (Inherit inherit Nothing ids semicolon) - = base $ group (pretty inherit <> softline - <> nest 2 (sepBy softline ids)) <> pretty semicolon + = base $ pretty inherit <> softline + <> nest 2 (sepBy softline ids) <> pretty semicolon pretty (Inherit inherit (Just source) ids semicolon) - = base $ group (pretty inherit <> hardspace + = base $ pretty inherit <> hardspace <> pretty source <> line - <> nest 2 (sepBy softline ids)) <> pretty semicolon + <> nest 2 (sepBy softline ids) <> pretty semicolon pretty (Assignment selectors assign expr semicolon) - = base $ hcat selectors <> hardspace <> group (nest 2 value) + = base $ group $ hcat selectors <> hardspace <> nest 2 value where value = pretty assign <> softline <> pretty expr <> pretty semicolon @@ -91,25 +110,33 @@ prettyTerm (String s) = pretty s prettyTerm (Path p) = pretty p prettyTerm (Selection term selectors) = pretty term <> hcat selectors -prettyTerm (List (Ann leading paropen Nothing) [] (Ann [] parclose trailing)) +prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing)) = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing -prettyTerm (List (Ann leading paropen Nothing) [item] (Ann [] parclose trailing)) +prettyTerm (List (Ann leading paropen Nothing) (Items [CommentedItem [] item]) (Ann [] parclose trailing)) | isAbsorbable item = pretty leading <> pretty paropen <> pretty item <> pretty parclose <> pretty trailing +prettyTerm (List (Ann [] paropen trailing) items parclose) + = base $ pretty paropen <> pretty trailing <> line + <> nest 2 (prettyItems line items) <> line + <> pretty parclose + +-- Lists with leading comments get their own group so the comments don't always +-- force the list to be split over multiple lines. prettyTerm (List paropen items parclose) - = base $ pretty paropen <> line - <> nest 2 (sepBy line (map group items)) <> line + = base $ groupWithStart paropen $ + line + <> nest 2 (prettyItems line items) <> line <> pretty parclose -prettyTerm (Set Nothing (Ann [] paropen Nothing) [] parclose) +prettyTerm (Set Nothing (Ann [] paropen Nothing) (Items []) parclose) = pretty paropen <> hardspace <> pretty parclose prettyTerm (Set krec paropen binders parclose) = base $ pretty (fmap ((<>hardspace) . pretty) krec) <> pretty paropen <> line - <> nest 2 (sepBy hardline binders) <> line + <> nest 2 (prettyItems hardline binders) <> line <> pretty parclose prettyTerm (Parenthesized paropen expr parclose) @@ -142,9 +169,10 @@ instance Pretty ParamAttr where instance Pretty Parameter where pretty (IDParameter i) = pretty i pretty (SetParameter bopen attrs bclose) - = group $ pretty bopen <> hardspace - <> hcat attrs <> softline - <> pretty bclose + = groupWithStart bopen $ + hardspace + <> hcat attrs <> softline + <> pretty bclose pretty (ContextParameter param1 at param2) = pretty param1 <> pretty at <> pretty param2 @@ -152,11 +180,11 @@ instance Pretty Parameter where isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts -isAbsorbable (Set _ _ (_:_) _) = True -isAbsorbable (List (Ann [] _ Nothing) [item] _) = isAbsorbable item -isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t -isAbsorbable (List _ (_:_:_) _) = True -isAbsorbable _ = False +isAbsorbable (Set _ _ (Items (_:_)) _) = True +isAbsorbable (List (Ann [] _ Nothing) (Items [CommentedItem [] item]) _) = isAbsorbable item +isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t +isAbsorbable (List _ (Items (_:_:_)) _) = True +isAbsorbable _ = False absorb :: Doc -> Doc -> Maybe Int -> Expression -> Doc absorb left right _ (Term t) @@ -199,11 +227,19 @@ instance Pretty Expression where <> nest 2 (group expr0) <> pretty semicolon) <> absorbSet expr1 + pretty (Let let_ (Items []) in_ expr) + = base $ pretty let_ <> hardspace <> pretty in_ <> hardspace <> pretty expr + + pretty (Let let_ (Items [CommentedItem [] item]) in_ expr) + = base $ letPart <> line <> inPart + where letPart = groupWithStart let_ $ line <> nest 2 (pretty item) + inPart = groupWithStart in_ $ hardspace <> pretty expr + pretty (Let let_ binders in_ expr) - = base $ group letPart <> line <> group inPart - where letPart = pretty let_ <> line <> letBody - inPart = pretty in_ <> hardspace <> pretty expr - letBody = nest 2 $ sepBy hardline binders + = base $ letPart <> emptyline <> inPart + where letPart = groupWithStart let_ $ line <> letBody + inPart = groupWithStart in_ $ hardspace <> pretty expr + letBody = nest 2 $ prettyItems hardline binders pretty (Assert assert cond semicolon expr) = base (pretty assert <> hardspace @@ -211,8 +247,8 @@ instance Pretty Expression where <> absorbSet expr pretty (If if_ cond then_ expr0 else_ expr1) - = base $ group $ - pretty if_ <> hardspace <> group cond <> hardspace + = base $ groupWithStart if_ $ + hardspace <> group cond <> hardspace <> pretty then_ <> absorbThen expr0 <> pretty else_ <> absorbElse expr1 @@ -248,9 +284,6 @@ instance Pretty a => Pretty (Whole a) where instance Pretty Token where pretty = text . tokenText -instance Pretty [Token] where - pretty = hcat - -- STRINGS isSimpleSelector :: Selector -> Bool diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index d85e6304..6c12851d 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -4,13 +4,15 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveFoldable, OverloadedStrings #-} module Nixfmt.Types where import Prelude hiding (String) import Control.Monad.State (StateT) +import Data.Foldable (toList) +import Data.Function (on) import Data.Text (Text, pack) import Data.Void (Void) import qualified Text.Megaparsec as MP (ParseErrorBundle, Parsec) @@ -35,11 +37,26 @@ data Ann a = Ann Trivia a (Maybe TrailingComment) deriving (Show) --- | Equality of annotated syntax is defines as equality of their corresponding +-- | Equality of annotated syntax is defined as equality of their corresponding -- semantics, thus ignoring the annotations. instance Eq a => Eq (Ann a) where Ann _ x _ == Ann _ y _ = x == y +data Item a + -- | An item with a list of line comments that apply to it. There is no + -- empty line between the comments and the stuff it applies to. + = CommentedItem Trivia a + -- | A list of line comments not associated with any item. Followed by an + -- empty line unless they're the last comments in a set or list. + | DetachedComments Trivia + deriving (Foldable, Show) + +newtype Items a = Items { unItems :: [Item a] } + deriving (Show) + +instance Eq a => Eq (Items a) where + (==) = (==) `on` concatMap toList . unItems + type Leaf = Ann Token data StringPart @@ -70,8 +87,8 @@ data Term = Token Leaf | String String | Path Path - | List Leaf [Term] Leaf - | Set (Maybe Leaf) Leaf [Binder] Leaf + | List Leaf (Items Term) Leaf + | Set (Maybe Leaf) Leaf (Items Binder) Leaf | Selection Term [Selector] | Parenthesized Leaf Expression Leaf deriving (Eq, Show) @@ -90,7 +107,7 @@ data Parameter data Expression = Term Term | With Leaf Expression Leaf Expression - | Let Leaf [Binder] Leaf Expression + | Let Leaf (Items Binder) Leaf Expression | Assert Leaf Expression Leaf Expression | If Leaf Expression Leaf Expression Leaf Expression | Abstraction Parameter Leaf Expression diff --git a/test/correct/commented-list.nix b/test/correct/commented-list.nix new file mode 100644 index 00000000..73012d7f --- /dev/null +++ b/test/correct/commented-list.nix @@ -0,0 +1,2 @@ +# bar and baz +[ bar ] diff --git a/test/correct/final-comments-in-sets.nix b/test/correct/final-comments-in-sets.nix new file mode 100644 index 00000000..a856a82c --- /dev/null +++ b/test/correct/final-comments-in-sets.nix @@ -0,0 +1,19 @@ +[ + { + # foo1 = bar; + # foo2 = bar; + # foo3 = bar; + } + + { + foo1 = bar; + # foo2 = bar; + # foo3 = bar; + } + + { + foo1 = bar; + foo2 = bar; + # foo3 = bar; + } +] diff --git a/test/correct/short-inherit-from.nix b/test/correct/short-inherit-from.nix new file mode 100644 index 00000000..a1f4a80c --- /dev/null +++ b/test/correct/short-inherit-from.nix @@ -0,0 +1,4 @@ +rec { + utils.id = x: x; + inherit (utils) id; +} diff --git a/test/correct/standalone-comments.nix b/test/correct/standalone-comments.nix new file mode 100644 index 00000000..2056e864 --- /dev/null +++ b/test/correct/standalone-comments.nix @@ -0,0 +1,25 @@ +# This tests whether empty lines are correctly preserved in lists +[ + a + b + # c + c + # 1 + + d + + # e + e + + # 2 + + f + # 3 + + # g + g + + # 8 + + # 9 +] From 4a054940ee8609d113e91ad196fc5d7fa477b553 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 11:49:12 +0200 Subject: [PATCH 007/125] Add direnv --- .envrc | 1 + .gitignore | 1 + 2 files changed, 2 insertions(+) create mode 100644 .envrc diff --git a/.envrc b/.envrc new file mode 100644 index 00000000..4a4726a5 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use_nix diff --git a/.gitignore b/.gitignore index 94462357..37ad2a5f 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ /dist-newstyle /.ghc.environment.* /result +/.direnv From 13b79042994a3e6acf1e7db7f1fd452632a557f9 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 12:28:54 +0200 Subject: [PATCH 008/125] Update CLI flags description To make more clear that one formats and the other one only checks --- main/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index 5b1a3cef..e5f4ef96 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -51,12 +51,12 @@ options = , width = defaultWidth &= help (addDefaultHint defaultWidth "Maximum width in characters") - , check = False &= help "Check whether files are formatted" + , check = False &= help "Check whether files are formatted without modifying them" , quiet = False &= help "Do not report errors" , verify = False &= help - "Check that the output parses and formats the same as the input" + "Apply sanity checks on the output after formatting" } &= summary ("nixfmt v" ++ showVersion version) &= help "Format Nix source code" From f938cfc182a69a9a4b9a80630baf26a9ae9332ec Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 11:49:19 +0200 Subject: [PATCH 009/125] Add simple test runner Tests mostly imported from Alejandra --- flake.nix | 1 + test/README.md | 4 +- test/diff/apply/in.nix | 100 +++++ test/diff/apply/out.nix | 63 +++ test/diff/assert/in.nix | 13 + test/diff/assert/out.nix | 27 ++ test/diff/attr_set/in.nix | 60 +++ test/diff/attr_set/out.nix | 81 ++++ test/diff/comment/in.nix | 93 +++++ test/diff/comment/out.nix | 80 ++++ test/diff/dynamic/in.nix | 1 + test/diff/dynamic/out.nix | 5 + test/diff/idioms/in.nix | 7 + test/diff/idioms/out.nix | 19 + test/diff/idioms_lib_1/in.nix | 9 + test/diff/idioms_lib_1/out.nix | 10 + test/diff/idioms_lib_2/in.nix | 456 +++++++++++++++++++++ test/diff/idioms_lib_2/out.nix | 442 ++++++++++++++++++++ test/diff/idioms_lib_3/in.nix | 488 +++++++++++++++++++++++ test/diff/idioms_lib_3/out.nix | 469 ++++++++++++++++++++++ test/diff/idioms_nixos_1/in.nix | 350 ++++++++++++++++ test/diff/idioms_nixos_1/out.nix | 358 +++++++++++++++++ test/diff/idioms_pkgs_1/in.nix | 13 + test/diff/idioms_pkgs_1/out.nix | 11 + test/diff/idioms_pkgs_2/in.nix | 43 ++ test/diff/idioms_pkgs_2/out.nix | 35 ++ test/diff/idioms_pkgs_3/in.nix | 350 ++++++++++++++++ test/diff/idioms_pkgs_3/out.nix | 358 +++++++++++++++++ test/diff/if_else/in.nix | 102 +++++ test/diff/if_else/out.nix | 72 ++++ test/diff/inherit/in.nix | 29 ++ test/diff/inherit/out.nix | 54 +++ test/diff/inherit_blank_trailing/in.nix | 34 ++ test/diff/inherit_blank_trailing/out.nix | 29 ++ test/diff/inherit_comment/in.nix | 18 + test/diff/inherit_comment/out.nix | 16 + test/diff/inherit_from/in.nix | 66 +++ test/diff/inherit_from/out.nix | 414 +++++++++++++++++++ test/diff/key_value/in.nix | 40 ++ test/diff/key_value/out.nix | 70 ++++ test/diff/lambda/in.nix | 36 ++ test/diff/lambda/out.nix | 45 +++ test/diff/let_in/in.nix | 40 ++ test/diff/let_in/out.nix | 37 ++ test/diff/lists/in.nix | 46 +++ test/diff/lists/out.nix | 57 +++ test/diff/monsters_1/in.nix | 269 +++++++++++++ test/diff/monsters_1/out.nix | 269 +++++++++++++ test/diff/monsters_2/in.nix | 31 ++ test/diff/monsters_2/out.nix | 30 ++ test/diff/monsters_3/in.nix | 7 + test/diff/monsters_3/out.nix | 48 +++ test/diff/monsters_4/in.nix | 7 + test/diff/monsters_4/out.nix | 137 +++++++ test/diff/monsters_5/in.nix | 327 +++++++++++++++ test/diff/monsters_5/out.nix | 262 ++++++++++++ test/diff/or_default/in.nix | 14 + test/diff/or_default/out.nix | 13 + test/diff/paren/in.nix | 21 + test/diff/paren/out.nix | 35 ++ test/diff/pat_bind/in.nix | 11 + test/diff/pat_bind/out.nix | 11 + test/diff/pattern/in.nix | 144 +++++++ test/diff/pattern/out.nix | 394 ++++++++++++++++++ test/diff/root/in.nix | 10 + test/diff/root/out.nix | 10 + test/diff/select/in.nix | 9 + test/diff/select/out.nix | 8 + test/diff/string/in.nix | 95 +++++ test/diff/string/out.nix | 93 +++++ test/diff/string_interpol/in.nix | 1 + test/diff/string_interpol/out.nix | 4 + test/diff/with/in.nix | 34 ++ test/diff/with/out.nix | 47 +++ test/dist-newstyle/cache/compiler | Bin 0 -> 18340 bytes test/invalid/smiley.nix | 1 + test/test.sh | 55 +++ 77 files changed, 7547 insertions(+), 1 deletion(-) create mode 100644 test/diff/apply/in.nix create mode 100644 test/diff/apply/out.nix create mode 100644 test/diff/assert/in.nix create mode 100644 test/diff/assert/out.nix create mode 100644 test/diff/attr_set/in.nix create mode 100644 test/diff/attr_set/out.nix create mode 100644 test/diff/comment/in.nix create mode 100644 test/diff/comment/out.nix create mode 100644 test/diff/dynamic/in.nix create mode 100644 test/diff/dynamic/out.nix create mode 100644 test/diff/idioms/in.nix create mode 100644 test/diff/idioms/out.nix create mode 100644 test/diff/idioms_lib_1/in.nix create mode 100644 test/diff/idioms_lib_1/out.nix create mode 100644 test/diff/idioms_lib_2/in.nix create mode 100644 test/diff/idioms_lib_2/out.nix create mode 100644 test/diff/idioms_lib_3/in.nix create mode 100644 test/diff/idioms_lib_3/out.nix create mode 100644 test/diff/idioms_nixos_1/in.nix create mode 100644 test/diff/idioms_nixos_1/out.nix create mode 100644 test/diff/idioms_pkgs_1/in.nix create mode 100644 test/diff/idioms_pkgs_1/out.nix create mode 100644 test/diff/idioms_pkgs_2/in.nix create mode 100644 test/diff/idioms_pkgs_2/out.nix create mode 100644 test/diff/idioms_pkgs_3/in.nix create mode 100644 test/diff/idioms_pkgs_3/out.nix create mode 100644 test/diff/if_else/in.nix create mode 100644 test/diff/if_else/out.nix create mode 100644 test/diff/inherit/in.nix create mode 100644 test/diff/inherit/out.nix create mode 100644 test/diff/inherit_blank_trailing/in.nix create mode 100644 test/diff/inherit_blank_trailing/out.nix create mode 100644 test/diff/inherit_comment/in.nix create mode 100644 test/diff/inherit_comment/out.nix create mode 100644 test/diff/inherit_from/in.nix create mode 100644 test/diff/inherit_from/out.nix create mode 100644 test/diff/key_value/in.nix create mode 100644 test/diff/key_value/out.nix create mode 100644 test/diff/lambda/in.nix create mode 100644 test/diff/lambda/out.nix create mode 100644 test/diff/let_in/in.nix create mode 100644 test/diff/let_in/out.nix create mode 100644 test/diff/lists/in.nix create mode 100644 test/diff/lists/out.nix create mode 100644 test/diff/monsters_1/in.nix create mode 100644 test/diff/monsters_1/out.nix create mode 100644 test/diff/monsters_2/in.nix create mode 100644 test/diff/monsters_2/out.nix create mode 100644 test/diff/monsters_3/in.nix create mode 100644 test/diff/monsters_3/out.nix create mode 100644 test/diff/monsters_4/in.nix create mode 100644 test/diff/monsters_4/out.nix create mode 100644 test/diff/monsters_5/in.nix create mode 100644 test/diff/monsters_5/out.nix create mode 100644 test/diff/or_default/in.nix create mode 100644 test/diff/or_default/out.nix create mode 100644 test/diff/paren/in.nix create mode 100644 test/diff/paren/out.nix create mode 100644 test/diff/pat_bind/in.nix create mode 100644 test/diff/pat_bind/out.nix create mode 100644 test/diff/pattern/in.nix create mode 100644 test/diff/pattern/out.nix create mode 100644 test/diff/root/in.nix create mode 100644 test/diff/root/out.nix create mode 100644 test/diff/select/in.nix create mode 100644 test/diff/select/out.nix create mode 100644 test/diff/string/in.nix create mode 100644 test/diff/string/out.nix create mode 100644 test/diff/string_interpol/in.nix create mode 100644 test/diff/string_interpol/out.nix create mode 100644 test/diff/with/in.nix create mode 100644 test/diff/with/out.nix create mode 100644 test/dist-newstyle/cache/compiler create mode 100644 test/invalid/smiley.nix create mode 100755 test/test.sh diff --git a/flake.nix b/flake.nix index 0f68db7d..83661b57 100644 --- a/flake.nix +++ b/flake.nix @@ -84,6 +84,7 @@ # nixfmt: expand cabal-install stylish-haskell + shellcheck ]); }); diff --git a/test/README.md b/test/README.md index cf02a9bf..8c1dfe4c 100644 --- a/test/README.md +++ b/test/README.md @@ -10,5 +10,7 @@ the input. Tests in `invalid` should return an error when formatted. -Tests in `changed` have input and output files. `nixfmt --verify foo.in.nix` +Tests in `diff` have input and output files. `nixfmt --verify < foo.in.nix` should output exactly `foo.out.nix`. + +`test.sh` runs these tests for you. Pass `--update-diff` to update the out files in `diff`. diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix new file mode 100644 index 00000000..26cc0f98 --- /dev/null +++ b/test/diff/apply/in.nix @@ -0,0 +1,100 @@ +[ + (a + b) + ( + (a b) + (a b) + (a /*b*/ c) + (/*a*/ b /*c*/ d /*e*/) + ) + '' + otherModules=${ + pkgs.writeText "other-modules.json" + (l.toJSON + (l.mapAttrs + (pname: subOutputs: + let + pkg = subOutputs.packages."${pname}".overrideAttrs (old: { + buildScript = "true"; + installMethod = "copy"; + }); + in + "${pkg}/lib/node_modules/${pname}/node_modules") + outputs.subPackages)) + } + '' + { + name1 = + function + arg + {asdf = 1;}; + + name2 = + function + arg + {asdf = 1;} + argument; + + name3 = + function + arg + {asdf = 1;} + {qwer = 12345;} + argument; + } + { + name1 = function arg { + asdf = 1; + }; + + name2 = function arg { + asdf = 1; + } + argument; + + name3 = function arg { + asdf = 1; + } { + qwer = 12345; + } + argument; + } + { + name4 = + function + arg + {asdf = 1;} + { + qwer = 12345; + qwer2 = 54321; + } + argument; + } + { + option1 = function arg {asdf = 1;} { + qwer = 12345; + qwer2 = 54321; + } + lastArg; + + option2 = function arg {asdf = 1;} { + qwer = 12345; + qwer2 = 54321; + } + lastArg; + + option3 = function arg {asdf = 1;} + { + qwer = 12345; + qwer2 = 54321; + } + lastArg; + } + # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 + { + outputs = + { utils }: + # For each supported platform, + utils.lib.eachDefaultSystem (system: {}); + } +] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix new file mode 100644 index 00000000..c14df116 --- /dev/null +++ b/test/diff/apply/out.nix @@ -0,0 +1,63 @@ +[ + (a b) + ((a b) (a b) (a # b + c) ( # a + b # c + d # e + )) + '' + otherModules=${ + pkgs.writeText "other-modules.json" (l.toJSON (l.mapAttrs + (pname: subOutputs: + let + pkg = subOutputs.packages."${pname}".overrideAttrs (old: { + buildScript = "true"; + installMethod = "copy"; + }); + in "${pkg}/lib/node_modules/${pname}/node_modules") + outputs.subPackages)) + } + '' + { + name1 = function arg { asdf = 1; }; + + name2 = function arg { asdf = 1; } argument; + + name3 = function arg { asdf = 1; } { qwer = 12345; } argument; + } + { + name1 = function arg { asdf = 1; }; + + name2 = function arg { asdf = 1; } argument; + + name3 = function arg { asdf = 1; } { qwer = 12345; } argument; + } + { + name4 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } argument; + } + { + option1 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } lastArg; + + option2 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } lastArg; + + option3 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } lastArg; + } + # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 + { + outputs = { utils }: + # For each supported platform, + utils.lib.eachDefaultSystem (system: { }); + } +] diff --git a/test/diff/assert/in.nix b/test/diff/assert/in.nix new file mode 100644 index 00000000..6be19f68 --- /dev/null +++ b/test/diff/assert/in.nix @@ -0,0 +1,13 @@ +[ + (assert b ; e) + (assert b ; /*d*/ e) + (assert b /*c*/; e) + (assert b /*c*/; /*d*/ e) + (assert /*a*/ b ; e) + (assert /*a*/ b ; /*d*/ e) + (assert /*a*/ b /*c*/; e) + (assert /*a*/ b /*c*/; /*d*/ e) + ( assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) + ( assert b; + cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) +] diff --git a/test/diff/assert/out.nix b/test/diff/assert/out.nix new file mode 100644 index 00000000..1228cdba --- /dev/null +++ b/test/diff/assert/out.nix @@ -0,0 +1,27 @@ +[ + (assert b; e) + (assert b; # d + e) + (assert b # c + ; + e) + (assert b # c + ; # d + e) + (assert # a + b; + e) + (assert # a + b; # d + e) + (assert # a + b # c + ; + e) + (assert # a + b # c + ; # d + e) + (assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) + (assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) +] diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix new file mode 100644 index 00000000..2af0248d --- /dev/null +++ b/test/diff/attr_set/in.nix @@ -0,0 +1,60 @@ +[ + {} + {/*a*/} + {a=1;} + {a=1; + } + + { b=1; } + { b=1; /*c*/ } + { /*a*/ b=1; } + { /*a*/ b=1; /*c*/ } + + rec { c=1; } + rec { c=1; /*d*/ } + rec { /*b*/ c=1; } + rec { /*b*/ c=1; /*d*/ } + rec /*a*/ { c=1; } + rec /*a*/ { c=1; /*d*/ } + rec /*a*/ { /*b*/ c=1; } + rec /*a*/ { /*b*/ c=1; /*d*/ } + + { + a=rec { + a={ + a=rec { + a={ + a=rec {a={a=rec {a={a=rec {a={};};};};};};};};};};} + + rec { + + c=1; + + + e=1; + + + } + + rec + /*a*/ + { + + + /*b*/ + + + c=1; + + + /*d*/ + + + e=1; + + + /*f*/ + + + } +] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix new file mode 100644 index 00000000..b95620b0 --- /dev/null +++ b/test/diff/attr_set/out.nix @@ -0,0 +1,81 @@ +[ + { } + { # a + } + { a = 1; } + { a = 1; } + + { b = 1; } + { + b = 1; # c + } + { # a + b = 1; + } + { # a + b = 1; # c + } + + rec { c = 1; } + rec { + c = 1; # d + } + rec { # b + c = 1; + } + rec { # b + c = 1; # d + } + rec # a + { + c = 1; + } + rec # a + { + c = 1; # d + } + rec # a + { # b + c = 1; + } + rec # a + { # b + c = 1; # d + } + + { + a = rec { + a = { + a = rec { + a = { + a = rec { a = { a = rec { a = { a = rec { a = { }; }; }; }; }; }; + }; + }; + }; + }; + } + + rec { + + c = 1; + + e = 1; + + } + + rec + # a + { + + # b + + c = 1; + + # d + + e = 1; + + # f + + } +] diff --git a/test/diff/comment/in.nix b/test/diff/comment/in.nix new file mode 100644 index 00000000..7ed19e54 --- /dev/null +++ b/test/diff/comment/in.nix @@ -0,0 +1,93 @@ +[ +/* +*/ + /* + */ + + /* + */ + + /* + */ + + /* + */ + + /* + */ + + /*@*/ + + /** + @ + **/ + + /*@ + @ + @*/ + + /*@ + @ + @*/ + + /*@ +@ + @*/ + + /*@ + @ + @*/ + + /* test + * test + */ + + [ # 1 + #2 + a # 3 + b + c # 4 + #5 + + #6 + + d + #7 + ] + + { + a = 123; # comment + } + + { # 1 + #2 + a=1; # 3 + b=1; + c=1; # 4 + #5 + + #6 + + d=1; + #7 + } + + (let # 1 + #2 + a=1; # 3 + b=1; + c=1; # 4 + #5 + + #6 + + d=1; + #7 + in + d) + + ({ + a, # comment + b ? 2,# comment + }: _) +] diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix new file mode 100644 index 00000000..4ce451b9 --- /dev/null +++ b/test/diff/comment/out.nix @@ -0,0 +1,80 @@ +[ + + # @ + + /* * + @ + * + */ + + /* @ + @ + @ + */ + + /* @ + @ + @ + */ + + /* @ + @ + @ + */ + + /* @ + @ + @ + */ + + # test + # test + + [ # 1 + #2 + a # 3 + b + c # 4 + #5 + + #6 + + d + #7 + ] + + { + a = 123; # comment + } + + { # 1 + #2 + a = 1; # 3 + b = 1; + c = 1; # 4 + #5 + + #6 + + d = 1; + #7 + } + + (let # 1 + #2 + a = 1; # 3 + b = 1; + c = 1; # 4 + #5 + + #6 + + d = 1; + #7 + in d) + + ({ a, # comment + b ? 2, # comment + }: + _) +] diff --git a/test/diff/dynamic/in.nix b/test/diff/dynamic/in.nix new file mode 100644 index 00000000..bad6cfab --- /dev/null +++ b/test/diff/dynamic/in.nix @@ -0,0 +1 @@ +a.${/*b*/c.${/*d*/e.${f}}/*g*/} diff --git a/test/diff/dynamic/out.nix b/test/diff/dynamic/out.nix new file mode 100644 index 00000000..050f0ec4 --- /dev/null +++ b/test/diff/dynamic/out.nix @@ -0,0 +1,5 @@ +a.${ # b + c.${ # d + e.${f} + } # g +} diff --git a/test/diff/idioms/in.nix b/test/diff/idioms/in.nix new file mode 100644 index 00000000..26490c47 --- /dev/null +++ b/test/diff/idioms/in.nix @@ -0,0 +1,7 @@ +[ + { meta = with lib; { a=1; b=2; c=3; };} + + { meta = with lib; + # comment + { a=1; b=2; c=3; };} +] diff --git a/test/diff/idioms/out.nix b/test/diff/idioms/out.nix new file mode 100644 index 00000000..faed7b03 --- /dev/null +++ b/test/diff/idioms/out.nix @@ -0,0 +1,19 @@ +[ + { + meta = with lib; { + a = 1; + b = 2; + c = 3; + }; + } + + { + meta = with lib; + # comment + { + a = 1; + b = 2; + c = 3; + }; + } +] diff --git a/test/diff/idioms_lib_1/in.nix b/test/diff/idioms_lib_1/in.nix new file mode 100644 index 00000000..93ebe7e1 --- /dev/null +++ b/test/diff/idioms_lib_1/in.nix @@ -0,0 +1,9 @@ +{ + traceIf = + # Predicate to check + pred: + # Message that should be traced + msg: + # Value to return + x: if pred then trace msg x else x; +} diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix new file mode 100644 index 00000000..3c4520d9 --- /dev/null +++ b/test/diff/idioms_lib_1/out.nix @@ -0,0 +1,10 @@ +{ + traceIf = + # Predicate to check + pred: + # Message that should be traced + msg: + # Value to return + x: + if pred then trace msg x else x; +} diff --git a/test/diff/idioms_lib_2/in.nix b/test/diff/idioms_lib_2/in.nix new file mode 100644 index 00000000..c68bac90 --- /dev/null +++ b/test/diff/idioms_lib_2/in.nix @@ -0,0 +1,456 @@ +{ lib }: + +rec { + + ## Simple (higher order) functions + + /* The identity function + For when you need a function that does “nothing”. + + Type: id :: a -> a + */ + id = + # The value to return + x: x; + + /* The constant function + + Ignores the second argument. If called with only one argument, + constructs a function that always returns a static value. + + Type: const :: a -> b -> a + Example: + let f = const 5; in f 10 + => 5 + */ + const = + # Value to return + x: + # Value to ignore + y: x; + + /* Pipes a value through a list of functions, left to right. + + Type: pipe :: a -> [] -> + Example: + pipe 2 [ + (x: x + 2) # 2 + 2 = 4 + (x: x * 2) # 4 * 2 = 8 + ] + => 8 + + # ideal to do text transformations + pipe [ "a/b" "a/c" ] [ + + # create the cp command + (map (file: ''cp "${src}/${file}" $out\n'')) + + # concatenate all commands into one string + lib.concatStrings + + # make that string into a nix derivation + (pkgs.runCommand "copy-to-out" {}) + + ] + => + + The output type of each function has to be the input type + of the next function, and the last function returns the + final value. + */ + pipe = val: functions: + let reverseApply = x: f: f x; + in builtins.foldl' reverseApply val functions; + + # note please don’t add a function like `compose = flip pipe`. + # This would confuse users, because the order of the functions + # in the list is not clear. With pipe, it’s obvious that it + # goes first-to-last. With `compose`, not so much. + + ## Named versions corresponding to some builtin operators. + + /* Concatenate two lists + + Type: concat :: [a] -> [a] -> [a] + + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] + */ + concat = x: y: x ++ y; + + /* boolean “or” */ + or = x: y: x || y; + + /* boolean “and” */ + and = x: y: x && y; + + /* bitwise “and” */ + bitAnd = builtins.bitAnd + or (import ./zip-int-bits.nix + (a: b: if a==1 && b==1 then 1 else 0)); + + /* bitwise “or” */ + bitOr = builtins.bitOr + or (import ./zip-int-bits.nix + (a: b: if a==1 || b==1 then 1 else 0)); + + /* bitwise “xor” */ + bitXor = builtins.bitXor + or (import ./zip-int-bits.nix + (a: b: if a!=b then 1 else 0)); + + /* bitwise “not” */ + bitNot = builtins.sub (-1); + + /* Convert a boolean to a string. + + This function uses the strings "true" and "false" to represent + boolean values. Calling `toString` on a bool instead returns "1" + and "" (sic!). + + Type: boolToString :: bool -> string + */ + boolToString = b: if b then "true" else "false"; + + /* Merge two attribute sets shallowly, right side trumps left + + mergeAttrs :: attrs -> attrs -> attrs + + Example: + mergeAttrs { a = 1; b = 2; } { b = 3; c = 4; } + => { a = 1; b = 3; c = 4; } + */ + mergeAttrs = + # Left attribute set + x: + # Right attribute set (higher precedence for equal keys) + y: x // y; + + /* Flip the order of the arguments of a binary function. + + Type: flip :: (a -> b -> c) -> (b -> a -> c) + + Example: + flip concat [1] [2] + => [ 2 1 ] + */ + flip = f: a: b: f b a; + + /* Apply function if the supplied argument is non-null. + + Example: + mapNullable (x: x+1) null + => null + mapNullable (x: x+1) 22 + => 23 + */ + mapNullable = + # Function to call + f: + # Argument to check for null before passing it to `f` + a: if a == null then a else f a; + + # Pull in some builtins not included elsewhere. + inherit (builtins) + pathExists readFile isBool + isInt isFloat add sub lessThan + seq deepSeq genericClosure; + + + ## nixpkgs version strings + + /* Returns the current full nixpkgs version number. */ + version = release + versionSuffix; + + /* Returns the current nixpkgs release number as string. */ + release = lib.strings.fileContents ../.version; + + /* Returns the current nixpkgs release code name. + + On each release the first letter is bumped and a new animal is chosen + starting with that new letter. + */ + codeName = "Quokka"; + + /* Returns the current nixpkgs version suffix as string. */ + versionSuffix = + let suffixFile = ../.version-suffix; + in if pathExists suffixFile + then lib.strings.fileContents suffixFile + else "pre-git"; + + /* Attempts to return the the current revision of nixpkgs and + returns the supplied default value otherwise. + + Type: revisionWithDefault :: string -> string + */ + revisionWithDefault = + # Default value to return if revision can not be determined + default: + let + revisionFile = "${toString ./..}/.git-revision"; + gitRepo = "${toString ./..}/.git"; + in if lib.pathIsGitRepo gitRepo + then lib.commitIdFromGitRepo gitRepo + else if lib.pathExists revisionFile then lib.fileContents revisionFile + else default; + + nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version; + + /* Determine whether the function is being called from inside a Nix + shell. + + Type: inNixShell :: bool + */ + inNixShell = builtins.getEnv "IN_NIX_SHELL" != ""; + + + ## Integer operations + + /* Return minimum of two numbers. */ + min = x: y: if x < y then x else y; + + /* Return maximum of two numbers. */ + max = x: y: if x > y then x else y; + + /* Integer modulus + + Example: + mod 11 10 + => 1 + mod 1 10 + => 1 + */ + mod = base: int: base - (int * (builtins.div base int)); + + + ## Comparisons + + /* C-style comparisons + + a < b, compare a b => -1 + a == b, compare a b => 0 + a > b, compare a b => 1 + */ + compare = a: b: + if a < b + then -1 + else if a > b + then 1 + else 0; + + /* Split type into two subtypes by predicate `p`, take all elements + of the first subtype to be less than all the elements of the + second subtype, compare elements of a single subtype with `yes` + and `no` respectively. + + Type: (a -> bool) -> (a -> a -> int) -> (a -> a -> int) -> (a -> a -> int) + + Example: + let cmp = splitByAndCompare (hasPrefix "foo") compare compare; in + + cmp "a" "z" => -1 + cmp "fooa" "fooz" => -1 + + cmp "f" "a" => 1 + cmp "fooa" "a" => -1 + # while + compare "fooa" "a" => 1 + */ + splitByAndCompare = + # Predicate + p: + # Comparison function if predicate holds for both values + yes: + # Comparison function if predicate holds for neither value + no: + # First value to compare + a: + # Second value to compare + b: + if p a + then if p b then yes a b else -1 + else if p b then 1 else no a b; + + + /* Reads a JSON file. + + Type :: path -> any + */ + importJSON = path: + builtins.fromJSON (builtins.readFile path); + + /* Reads a TOML file. + + Type :: path -> any + */ + importTOML = path: + builtins.fromTOML (builtins.readFile path); + + ## Warnings + + # See https://github.com/NixOS/nix/issues/749. Eventually we'd like these + # to expand to Nix builtins that carry metadata so that Nix can filter out + # the INFO messages without parsing the message string. + # + # Usage: + # { + # foo = lib.warn "foo is deprecated" oldFoo; + # bar = lib.warnIf (bar == "") "Empty bar is deprecated" bar; + # } + # + # TODO: figure out a clever way to integrate location information from + # something like __unsafeGetAttrPos. + + /* + Print a warning before returning the second argument. This function behaves + like `builtins.trace`, but requires a string message and formats it as a + warning, including the `warning: ` prefix. + + To get a call stack trace and abort evaluation, set the environment variable + `NIX_ABORT_ON_WARN=true` and set the Nix options `--option pure-eval false --show-trace` + + Type: string -> a -> a + */ + warn = + if lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") ["1" "true" "yes"] + then msg: builtins.trace "warning: ${msg}" (abort "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") + else msg: builtins.trace "warning: ${msg}"; + + /* + Like warn, but only warn when the first argument is `true`. + + Type: bool -> string -> a -> a + */ + warnIf = cond: msg: if cond then warn msg else id; + + /* + Like the `assert b; e` expression, but with a custom error message and + without the semicolon. + + If true, return the identity function, `r: r`. + + If false, throw the error message. + + Calls can be juxtaposed using function application, as `(r: r) a = a`, so + `(r: r) (r: r) a = a`, and so forth. + + Type: bool -> string -> a -> a + + Example: + + throwIfNot (lib.isList overlays) "The overlays argument to nixpkgs must be a list." + lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays + pkgs + + */ + throwIfNot = cond: msg: if cond then x: x else throw msg; + + /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. + + Example: + let colorVariants = ["bright" "dark" "black"] + in checkListOfEnum "color variants" [ "standard" "light" "dark" ] colorVariants; + => + error: color variants: bright, black unexpected; valid ones: standard, light, dark + + Type: String -> List ComparableVal -> List ComparableVal -> a -> a + */ + checkListOfEnum = msg: valid: given: + let + unexpected = lib.subtractLists valid given; + in + lib.throwIfNot (unexpected == []) + "${msg}: ${builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected)} unexpected; valid ones: ${builtins.concatStringsSep ", " (builtins.map builtins.toString valid)}"; + + info = msg: builtins.trace "INFO: ${msg}"; + + showWarnings = warnings: res: lib.foldr (w: x: warn w x) res warnings; + + ## Function annotations + + /* Add metadata about expected function arguments to a function. + The metadata should match the format given by + builtins.functionArgs, i.e. a set from expected argument to a bool + representing whether that argument has a default or not. + setFunctionArgs : (a → b) → Map String Bool → (a → b) + + This function is necessary because you can't dynamically create a + function of the { a, b ? foo, ... }: format, but some facilities + like callPackage expect to be able to query expected arguments. + */ + setFunctionArgs = f: args: + { # TODO: Should we add call-time "type" checking like built in? + __functor = self: f; + __functionArgs = args; + }; + + /* Extract the expected function arguments from a function. + This works both with nix-native { a, b ? foo, ... }: style + functions and functions with args set with 'setFunctionArgs'. It + has the same return type and semantics as builtins.functionArgs. + setFunctionArgs : (a → b) → Map String Bool. + */ + functionArgs = f: + if f ? __functor + then f.__functionArgs or (lib.functionArgs (f.__functor f)) + else builtins.functionArgs f; + + /* Check whether something is a function or something + annotated with function args. + */ + isFunction = f: builtins.isFunction f || + (f ? __functor && isFunction (f.__functor f)); + + /* Convert the given positive integer to a string of its hexadecimal + representation. For example: + + toHexString 0 => "0" + + toHexString 16 => "10" + + toHexString 250 => "FA" + */ + toHexString = i: + let + toHexDigit = d: + if d < 10 + then toString d + else + { + "10" = "A"; + "11" = "B"; + "12" = "C"; + "13" = "D"; + "14" = "E"; + "15" = "F"; + }.${toString d}; + in + lib.concatMapStrings toHexDigit (toBaseDigits 16 i); + + /* `toBaseDigits base i` converts the positive integer i to a list of its + digits in the given base. For example: + + toBaseDigits 10 123 => [ 1 2 3 ] + + toBaseDigits 2 6 => [ 1 1 0 ] + + toBaseDigits 16 250 => [ 15 10 ] + */ + toBaseDigits = base: i: + let + go = i: + if i < base + then [i] + else + let + r = i - ((i / base) * base); + q = (i - r) / base; + in + [r] ++ go q; + in + assert (base >= 2); + assert (i >= 0); + lib.reverseList (go i); +} diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix new file mode 100644 index 00000000..50127d5b --- /dev/null +++ b/test/diff/idioms_lib_2/out.nix @@ -0,0 +1,442 @@ +{ lib }: + +rec { + + ## Simple (higher order) functions + + /* The identity function + For when you need a function that does “nothing”. + + Type: id :: a -> a + */ + id = + # The value to return + x: + x; + + /* The constant function + + Ignores the second argument. If called with only one argument, + constructs a function that always returns a static value. + + Type: const :: a -> b -> a + Example: + let f = const 5; in f 10 + => 5 + */ + const = + # Value to return + x: + # Value to ignore + y: + x; + + /* Pipes a value through a list of functions, left to right. + + Type: pipe :: a -> [] -> + Example: + pipe 2 [ + (x: x + 2) # 2 + 2 = 4 + (x: x * 2) # 4 * 2 = 8 + ] + => 8 + + # ideal to do text transformations + pipe [ "a/b" "a/c" ] [ + + # create the cp command + (map (file: ''cp "${src}/${file}" $out\n'')) + + # concatenate all commands into one string + lib.concatStrings + + # make that string into a nix derivation + (pkgs.runCommand "copy-to-out" {}) + + ] + => + + The output type of each function has to be the input type + of the next function, and the last function returns the + final value. + */ + pipe = val: functions: + let reverseApply = x: f: f x; + in builtins.foldl' reverseApply val functions; + + # note please don’t add a function like `compose = flip pipe`. + # This would confuse users, because the order of the functions + # in the list is not clear. With pipe, it’s obvious that it + # goes first-to-last. With `compose`, not so much. + + ## Named versions corresponding to some builtin operators. + + /* Concatenate two lists + + Type: concat :: [a] -> [a] -> [a] + + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] + */ + concat = x: y: x ++ y; + + # boolean “or” + or = x: y: x || y; + + # boolean “and” + and = x: y: x && y; + + # bitwise “and” + bitAnd = builtins.bitAnd or (import ./zip-int-bits.nix + (a: b: if a == 1 && b == 1 then 1 else 0)); + + # bitwise “or” + bitOr = builtins.bitOr or (import ./zip-int-bits.nix + (a: b: if a == 1 || b == 1 then 1 else 0)); + + # bitwise “xor” + bitXor = builtins.bitXor or (import ./zip-int-bits.nix + (a: b: if a != b then 1 else 0)); + + # bitwise “not” + bitNot = builtins.sub (-1); + + /* Convert a boolean to a string. + + This function uses the strings "true" and "false" to represent + boolean values. Calling `toString` on a bool instead returns "1" + and "" (sic!). + + Type: boolToString :: bool -> string + */ + boolToString = b: if b then "true" else "false"; + + /* Merge two attribute sets shallowly, right side trumps left + + mergeAttrs :: attrs -> attrs -> attrs + + Example: + mergeAttrs { a = 1; b = 2; } { b = 3; c = 4; } + => { a = 1; b = 3; c = 4; } + */ + mergeAttrs = + # Left attribute set + x: + # Right attribute set (higher precedence for equal keys) + y: + x // y; + + /* Flip the order of the arguments of a binary function. + + Type: flip :: (a -> b -> c) -> (b -> a -> c) + + Example: + flip concat [1] [2] + => [ 2 1 ] + */ + flip = f: a: b: f b a; + + /* Apply function if the supplied argument is non-null. + + Example: + mapNullable (x: x+1) null + => null + mapNullable (x: x+1) 22 + => 23 + */ + mapNullable = + # Function to call + f: + # Argument to check for null before passing it to `f` + a: + if a == null then a else f a; + + # Pull in some builtins not included elsewhere. + inherit (builtins) + pathExists readFile isBool isInt isFloat add sub lessThan seq deepSeq + genericClosure; + + ## nixpkgs version strings + + # Returns the current full nixpkgs version number. + version = release + versionSuffix; + + # Returns the current nixpkgs release number as string. + release = lib.strings.fileContents ../.version; + + /* Returns the current nixpkgs release code name. + + On each release the first letter is bumped and a new animal is chosen + starting with that new letter. + */ + codeName = "Quokka"; + + # Returns the current nixpkgs version suffix as string. + versionSuffix = let suffixFile = ../.version-suffix; + in if pathExists suffixFile then + lib.strings.fileContents suffixFile + else + "pre-git"; + + /* Attempts to return the the current revision of nixpkgs and + returns the supplied default value otherwise. + + Type: revisionWithDefault :: string -> string + */ + revisionWithDefault = + # Default value to return if revision can not be determined + default: + let + revisionFile = "${toString ./..}/.git-revision"; + gitRepo = "${toString ./..}/.git"; + in if lib.pathIsGitRepo gitRepo then + lib.commitIdFromGitRepo gitRepo + else if lib.pathExists revisionFile then + lib.fileContents revisionFile + else + default; + + nixpkgsVersion = builtins.trace + "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version; + + /* Determine whether the function is being called from inside a Nix + shell. + + Type: inNixShell :: bool + */ + inNixShell = builtins.getEnv "IN_NIX_SHELL" != ""; + + ## Integer operations + + # Return minimum of two numbers. + min = x: y: if x < y then x else y; + + # Return maximum of two numbers. + max = x: y: if x > y then x else y; + + /* Integer modulus + + Example: + mod 11 10 + => 1 + mod 1 10 + => 1 + */ + mod = base: int: base - (int * (builtins.div base int)); + + ## Comparisons + + /* C-style comparisons + + a < b, compare a b => -1 + a == b, compare a b => 0 + a > b, compare a b => 1 + */ + compare = a: b: if a < b then -1 else if a > b then 1 else 0; + + /* Split type into two subtypes by predicate `p`, take all elements + of the first subtype to be less than all the elements of the + second subtype, compare elements of a single subtype with `yes` + and `no` respectively. + + Type: (a -> bool) -> (a -> a -> int) -> (a -> a -> int) -> (a -> a -> int) + + Example: + let cmp = splitByAndCompare (hasPrefix "foo") compare compare; in + + cmp "a" "z" => -1 + cmp "fooa" "fooz" => -1 + + cmp "f" "a" => 1 + cmp "fooa" "a" => -1 + # while + compare "fooa" "a" => 1 + */ + splitByAndCompare = + # Predicate + p: + # Comparison function if predicate holds for both values + yes: + # Comparison function if predicate holds for neither value + no: + # First value to compare + a: + # Second value to compare + b: + if p a then if p b then yes a b else -1 else if p b then 1 else no a b; + + /* Reads a JSON file. + + Type :: path -> any + */ + importJSON = path: builtins.fromJSON (builtins.readFile path); + + /* Reads a TOML file. + + Type :: path -> any + */ + importTOML = path: builtins.fromTOML (builtins.readFile path); + + ## Warnings + + # See https://github.com/NixOS/nix/issues/749. Eventually we'd like these + # to expand to Nix builtins that carry metadata so that Nix can filter out + # the INFO messages without parsing the message string. + # + # Usage: + # { + # foo = lib.warn "foo is deprecated" oldFoo; + # bar = lib.warnIf (bar == "") "Empty bar is deprecated" bar; + # } + # + # TODO: figure out a clever way to integrate location information from + # something like __unsafeGetAttrPos. + + /* Print a warning before returning the second argument. This function behaves + like `builtins.trace`, but requires a string message and formats it as a + warning, including the `warning: ` prefix. + + To get a call stack trace and abort evaluation, set the environment variable + `NIX_ABORT_ON_WARN=true` and set the Nix options `--option pure-eval false --show-trace` + + Type: string -> a -> a + */ + warn = + if lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ "1" "true" "yes" ] then + msg: + builtins.trace "warning: ${msg}" (abort + "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") + else + msg: builtins.trace "warning: ${msg}"; + + /* Like warn, but only warn when the first argument is `true`. + + Type: bool -> string -> a -> a + */ + warnIf = cond: msg: if cond then warn msg else id; + + /* Like the `assert b; e` expression, but with a custom error message and + without the semicolon. + + If true, return the identity function, `r: r`. + + If false, throw the error message. + + Calls can be juxtaposed using function application, as `(r: r) a = a`, so + `(r: r) (r: r) a = a`, and so forth. + + Type: bool -> string -> a -> a + + Example: + + throwIfNot (lib.isList overlays) "The overlays argument to nixpkgs must be a list." + lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays + pkgs + */ + throwIfNot = cond: msg: if cond then x: x else throw msg; + + /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. + + Example: + let colorVariants = ["bright" "dark" "black"] + in checkListOfEnum "color variants" [ "standard" "light" "dark" ] colorVariants; + => + error: color variants: bright, black unexpected; valid ones: standard, light, dark + + Type: String -> List ComparableVal -> List ComparableVal -> a -> a + */ + checkListOfEnum = msg: valid: given: + let unexpected = lib.subtractLists valid given; + in lib.throwIfNot (unexpected == [ ]) "${msg}: ${ + builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) + } unexpected; valid ones: ${ + builtins.concatStringsSep ", " (builtins.map builtins.toString valid) + }"; + + info = msg: builtins.trace "INFO: ${msg}"; + + showWarnings = warnings: res: lib.foldr (w: x: warn w x) res warnings; + + ## Function annotations + + /* Add metadata about expected function arguments to a function. + The metadata should match the format given by + builtins.functionArgs, i.e. a set from expected argument to a bool + representing whether that argument has a default or not. + setFunctionArgs : (a → b) → Map String Bool → (a → b) + + This function is necessary because you can't dynamically create a + function of the { a, b ? foo, ... }: format, but some facilities + like callPackage expect to be able to query expected arguments. + */ + setFunctionArgs = + f: args: { # TODO: Should we add call-time "type" checking like built in? + __functor = self: f; + __functionArgs = args; + }; + + /* Extract the expected function arguments from a function. + This works both with nix-native { a, b ? foo, ... }: style + functions and functions with args set with 'setFunctionArgs'. It + has the same return type and semantics as builtins.functionArgs. + setFunctionArgs : (a → b) → Map String Bool. + */ + functionArgs = f: + if f ? __functor then + f.__functionArgs or (lib.functionArgs (f.__functor f)) + else + builtins.functionArgs f; + + /* Check whether something is a function or something + annotated with function args. + */ + isFunction = f: + builtins.isFunction f || (f ? __functor && isFunction (f.__functor f)); + + /* Convert the given positive integer to a string of its hexadecimal + representation. For example: + + toHexString 0 => "0" + + toHexString 16 => "10" + + toHexString 250 => "FA" + */ + toHexString = i: + let + toHexDigit = d: + if d < 10 then + toString d + else + { + "10" = "A"; + "11" = "B"; + "12" = "C"; + "13" = "D"; + "14" = "E"; + "15" = "F"; + }.${toString d}; + in lib.concatMapStrings toHexDigit (toBaseDigits 16 i); + + /* `toBaseDigits base i` converts the positive integer i to a list of its + digits in the given base. For example: + + toBaseDigits 10 123 => [ 1 2 3 ] + + toBaseDigits 2 6 => [ 1 1 0 ] + + toBaseDigits 16 250 => [ 15 10 ] + */ + toBaseDigits = base: i: + let + go = i: + if i < base then + [ i ] + else + let + r = i - ((i / base) * base); + q = (i - r) / base; + in [ r ] ++ go q; + in assert (base >= 2); assert (i >= 0); lib.reverseList (go i); +} diff --git a/test/diff/idioms_lib_3/in.nix b/test/diff/idioms_lib_3/in.nix new file mode 100644 index 00000000..92c8a0c3 --- /dev/null +++ b/test/diff/idioms_lib_3/in.nix @@ -0,0 +1,488 @@ +# Functions that generate widespread file +# formats from nix data structures. +# +# They all follow a similar interface: +# generator { config-attrs } data +# +# `config-attrs` are “holes” in the generators +# with sensible default implementations that +# can be overwritten. The default implementations +# are mostly generators themselves, called with +# their respective default values; they can be reused. +# +# Tests can be found in ./tests/misc.nix +# Documentation in the manual, #sec-generators +{ + lib, +}: +with (lib).trivial; +let + libStr = lib.strings; + libAttr = lib.attrsets; + + inherit (lib) isFunction; + +in rec { + + ## -- HELPER FUNCTIONS & DEFAULTS -- + + # Convert a value to a sensible default string representation. + # The builtin `toString` function has some strange defaults, + # suitable for bash scripts but not much else. + mkValueStringDefault = { + }: + v: + with builtins; + let + err = t: v: + abort ("generators.mkValueStringDefault: " + + "${t} not supported: ${toPretty { } v}"); + in if isInt v then + toString v + # convert derivations to store paths + else if lib.isDerivation v then + toString v + # we default to not quoting strings + else if isString v then + v + # isString returns "1", which is not a good default + else if true == v then + "true" + # here it returns to "", which is even less of a good default + else if false == v then + "false" + else if null == v then + "null" + # if you have lists you probably want to replace this + else if isList v then + err "lists" v + # same as for lists, might want to replace + else if isAttrs v then + err "attrsets" v + # functions can’t be printed of course + else if isFunction v then + err "functions" v + # Floats currently can't be converted to precise strings, + # condition warning on nix version once this isn't a problem anymore + # See https://github.com/NixOS/nix/pull/3480 + else if isFloat v then + libStr.floatToString v + else + err "this value is" (toString v); + + # Generate a line of key k and value v, separated by + # character sep. If sep appears in k, it is escaped. + # Helper for synaxes with different separators. + # + # mkValueString specifies how values should be formatted. + # + # mkKeyValueDefault {} ":" "f:oo" "bar" + # > "f\:oo:bar" + mkKeyValueDefault = { + mkValueString ? mkValueStringDefault { } + }: + sep: k: v: + "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; + + ## -- FILE FORMAT GENERATORS -- + + # Generate a key-value-style config file from an attrset. + # + # mkKeyValue is the same as in toINI. + toKeyValue = { + mkKeyValue ? mkKeyValueDefault { } "=", + listsAsDuplicateKeys ? false + }: + let + mkLine = k: v: mkKeyValue k v + "\n"; + mkLines = if listsAsDuplicateKeys then + k: v: map (mkLine k) (if lib.isList v then v else [ v ]) + else + k: v: [ (mkLine k v) ]; + in attrs: + libStr.concatStrings + (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); + + # Generate an INI-style config file from an + # attrset of sections to an attrset of key-value pairs. + # + # generators.toINI {} { + # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; + # baz = { "also, integers" = 42; }; + # } + # + #> [baz] + #> also, integers=42 + #> + #> [foo] + #> ciao=bar + #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 + # + # The mk* configuration attributes can generically change + # the way sections and key-value strings are generated. + # + # For more examples see the test cases in ./tests/misc.nix. + toINI = { + # apply transformations (e.g. escapes) to section names + mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + # format a setting line from key and value + mkKeyValue ? mkKeyValueDefault { } "=", + # allow lists as values for duplicate keys + listsAsDuplicateKeys ? false + }: + attrsOfAttrs: + let + # map function to string for each key val + mapAttrsToStringsSep = sep: mapFn: attrs: + libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs); + mkSection = sectName: sectValues: + '' + [${mkSectionName sectName}] + '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; + # map input to ini sections + in mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + + # Generate an INI-style config file from an attrset + # specifying the global section (no header), and an + # attrset of sections to an attrset of key-value pairs. + # + # generators.toINIWithGlobalSection {} { + # globalSection = { + # someGlobalKey = "hi"; + # }; + # sections = { + # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; + # baz = { "also, integers" = 42; }; + # } + # + #> someGlobalKey=hi + #> + #> [baz] + #> also, integers=42 + #> + #> [foo] + #> ciao=bar + #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 + # + # The mk* configuration attributes can generically change + # the way sections and key-value strings are generated. + # + # For more examples see the test cases in ./tests/misc.nix. + # + # If you don’t need a global section, you can also use + # `generators.toINI` directly, which only takes + # the part in `sections`. + toINIWithGlobalSection = { + # apply transformations (e.g. escapes) to section names + mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + # format a setting line from key and value + mkKeyValue ? mkKeyValueDefault { } "=", + # allow lists as values for duplicate keys + listsAsDuplicateKeys ? false + }: + { + globalSection, + sections, + }: + (if globalSection == { } then + "" + else + (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + + "\n") + + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } + sections); + + # Generate a git-config file from an attrset. + # + # It has two major differences from the regular INI format: + # + # 1. values are indented with tabs + # 2. sections can have sub-sections + # + # generators.toGitINI { + # url."ssh://git@github.com/".insteadOf = "https://github.com"; + # user.name = "edolstra"; + # } + # + #> [url "ssh://git@github.com/"] + #> insteadOf = https://github.com/ + #> + #> [user] + #> name = edolstra + toGitINI = attrs: + with builtins; + let + mkSectionName = name: + let + containsQuote = libStr.hasInfix ''"'' name; + sections = libStr.splitString "." name; + section = head sections; + subsections = tail sections; + subsection = concatStringsSep "." subsections; + in if containsQuote || subsections == [ ] then + name + else + ''${section} "${subsection}"''; + + # generation for multiple ini values + mkKeyValue = k: v: + let mkKeyValue = mkKeyValueDefault { } " = " k; + in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)); + + # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI + gitFlattenAttrs = let + recurse = path: value: + if isAttrs value && !lib.isDerivation value then + lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) + value + else if length path > 1 then { + ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = + value; + } else { + ${head path} = value; + }; + in attrs: + lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); + + toINI_ = toINI { inherit mkKeyValue mkSectionName; }; + in toINI_ (gitFlattenAttrs attrs); + + # Generates JSON from an arbitrary (non-function) value. + # For more information see the documentation of the builtin. + toJSON = { + }: + builtins.toJSON; + + # YAML has been a strict superset of JSON since 1.2, so we + # use toJSON. Before it only had a few differences referring + # to implicit typing rules, so it should work with older + # parsers as well. + toYAML = toJSON; + + withRecursion = { + # If this option is not null, the given value will stop evaluating at a certain depth + depthLimit + # If this option is true, an error will be thrown, if a certain given depth is exceeded + , + throwOnDepthLimit ? true + }: + assert builtins.isInt depthLimit; + let + specialAttrs = [ "__functor" "__functionArgs" "__toString" "__pretty" ]; + stepIntoAttr = evalNext: name: + if builtins.elem name specialAttrs then id else evalNext; + transform = depth: + if depthLimit != null && depth > depthLimit then + if throwOnDepthLimit then + throw "Exceeded maximum eval-depth limit of ${ + toString depthLimit + } while trying to evaluate with `generators.withRecursion'!" + else + const "" + else + id; + mapAny = with builtins; + depth: v: + let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); + in if isAttrs v then + mapAttrs (stepIntoAttr evalNext) v + else if isList v then + map evalNext v + else + transform (depth + 1) v; + in mapAny 0; + + # Pretty print a value, akin to `builtins.trace`. + # Should probably be a builtin as well. + # The pretty-printed string should be suitable for rendering default values + # in the NixOS manual. In particular, it should be as close to a valid Nix expression + # as possible. + toPretty = { + /* If this option is true, attrsets like { __pretty = fn; val = …; } + will use fn to convert val to a pretty printed representation. + (This means fn is type Val -> String.) + */ + allowPrettyValues ? false, + # If this option is true, the output is indented with newlines for attribute sets and lists + multiline ? true, + # Initial indentation level + indent ? "" + }: + let + go = indent: v: + with builtins; + let + isPath = v: typeOf v == "path"; + introSpace = if multiline then '' + + ${indent} '' else + " "; + outroSpace = if multiline then '' + + ${indent}'' else + " "; + in if isInt v then + toString v + # toString loses precision on floats, so we use toJSON instead. This isn't perfect + # as the resulting string may not parse back as a float (e.g. 42, 1e-06), but for + # pretty-printing purposes this is acceptable. + else if isFloat v then + builtins.toJSON v + else if isString v then + let + lines = filter (v: !isList v) (builtins.split "\n" v); + escapeSingleline = libStr.escape [ "\\" ''"'' "\${" ]; + escapeMultiline = + libStr.replaceStrings [ "\${" "''" ] [ "''\${" "'''" ]; + singlelineResult = ''"'' + + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; + multilineResult = let + escapedLines = map escapeMultiline lines; + # The last line gets a special treatment: if it's empty, '' is on its own line at the "outer" + # indentation level. Otherwise, '' is appended to the last line. + lastLine = lib.last escapedLines; + in "''" + introSpace + + concatStringsSep introSpace (lib.init escapedLines) + + (if lastLine == "" then outroSpace else introSpace + lastLine) + + "''"; + in if multiline && length lines > 1 then + multilineResult + else + singlelineResult + else if true == v then + "true" + else if false == v then + "false" + else if null == v then + "null" + else if isPath v then + toString v + else if isList v then + if v == [ ] then + "[ ]" + else + "[" + introSpace + + libStr.concatMapStringsSep introSpace (go (indent + " ")) v + + outroSpace + "]" + else if isFunction v then + let + fna = lib.functionArgs v; + showFnas = concatStringsSep ", " (libAttr.mapAttrsToList + (name: hasDefVal: if hasDefVal then name + "?" else name) fna); + in if fna == { } then + "" + else + "" + else if isAttrs v then + # apply pretty values if allowed + if allowPrettyValues && v ? __pretty && v ? val then + v.__pretty v.val + else if v == { } then + "{ }" + else if v ? type && v.type == "derivation" then + "" + else + "{" + introSpace + libStr.concatStringsSep introSpace + (libAttr.mapAttrsToList (name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext + "while evaluating an attribute `${name}`" + (go (indent + " ") value) + };") v) + outroSpace + "}" + else + abort "generators.toPretty: should never happen (v = ${v})"; + in go indent; + + # PLIST handling + toPlist = { + }: + v: + let + isFloat = builtins.isFloat or (x: false); + expr = ind: x: + with builtins; + if x == null then + "" + else if isBool x then + bool ind x + else if isInt x then + int ind x + else if isString x then + str ind x + else if isList x then + list ind x + else if isAttrs x then + attrs ind x + else if isFloat x then + float ind x + else + abort "generators.toPlist: should never happen (v = ${v})"; + + literal = ind: x: ind + x; + + bool = ind: x: literal ind (if x then "" else ""); + int = ind: x: literal ind "${toString x}"; + str = ind: x: literal ind "${x}"; + key = ind: x: literal ind "${x}"; + float = ind: x: literal ind "${toString x}"; + + indent = ind: expr " ${ind}"; + + item = ind: libStr.concatMapStringsSep "\n" (indent ind); + + list = ind: x: + libStr.concatStringsSep "\n" [ + (literal ind "") + (item ind x) + (literal ind "") + ]; + + attrs = ind: x: + libStr.concatStringsSep "\n" [ + (literal ind "") + (attr ind x) + (literal ind "") + ]; + + attr = let attrFilter = name: value: name != "_module" && value != null; + in ind: x: + libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList + (name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ]) x)); + + in '' + + + + ${expr "" v} + ''; + + # Translate a simple Nix expression to Dhall notation. + # Note that integers are translated to Integer and never + # the Natural type. + toDhall = { + }@args: + v: + with builtins; + let concatItems = lib.strings.concatStringsSep ", "; + in if isAttrs v then + "{ ${ + concatItems (lib.attrsets.mapAttrsToList + (key: value: "${key} = ${toDhall args value}") v) + } }" + else if isList v then + "[ ${concatItems (map (toDhall args) v)} ]" + else if isInt v then + "${if v < 0 then "" else "+"}${toString v}" + else if isBool v then + (if v then "True" else "False") + else if isFunction v then + abort "generators.toDhall: cannot convert a function to Dhall" + else if v == null then + abort "generators.toDhall: cannot convert a null to Dhall" + else + builtins.toJSON v; +} diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix new file mode 100644 index 00000000..bcfd80b8 --- /dev/null +++ b/test/diff/idioms_lib_3/out.nix @@ -0,0 +1,469 @@ +# Functions that generate widespread file +# formats from nix data structures. +# +# They all follow a similar interface: +# generator { config-attrs } data +# +# `config-attrs` are “holes” in the generators +# with sensible default implementations that +# can be overwritten. The default implementations +# are mostly generators themselves, called with +# their respective default values; they can be reused. +# +# Tests can be found in ./tests/misc.nix +# Documentation in the manual, #sec-generators +{ lib, }: +with (lib).trivial; +let + libStr = lib.strings; + libAttr = lib.attrsets; + + inherit (lib) isFunction; + +in rec { + + ## -- HELPER FUNCTIONS & DEFAULTS -- + + # Convert a value to a sensible default string representation. + # The builtin `toString` function has some strange defaults, + # suitable for bash scripts but not much else. + mkValueStringDefault = { }: + v: + with builtins; + let + err = t: v: + abort ("generators.mkValueStringDefault: " + + "${t} not supported: ${toPretty { } v}"); + in if isInt v then + toString v + # convert derivations to store paths + else if lib.isDerivation v then + toString v + # we default to not quoting strings + else if isString v then + v + # isString returns "1", which is not a good default + else if true == v then + "true" + # here it returns to "", which is even less of a good default + else if false == v then + "false" + else if null == v then + "null" + # if you have lists you probably want to replace this + else if isList v then + err "lists" v + # same as for lists, might want to replace + else if isAttrs v then + err "attrsets" v + # functions can’t be printed of course + else if isFunction v then + err "functions" v + # Floats currently can't be converted to precise strings, + # condition warning on nix version once this isn't a problem anymore + # See https://github.com/NixOS/nix/pull/3480 + else if isFloat v then + libStr.floatToString v + else + err "this value is" (toString v); + + # Generate a line of key k and value v, separated by + # character sep. If sep appears in k, it is escaped. + # Helper for synaxes with different separators. + # + # mkValueString specifies how values should be formatted. + # + # mkKeyValueDefault {} ":" "f:oo" "bar" + # > "f\:oo:bar" + mkKeyValueDefault = { mkValueString ? mkValueStringDefault { } }: + sep: k: v: + "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; + + ## -- FILE FORMAT GENERATORS -- + + # Generate a key-value-style config file from an attrset. + # + # mkKeyValue is the same as in toINI. + toKeyValue = + { mkKeyValue ? mkKeyValueDefault { } "=", listsAsDuplicateKeys ? false }: + let + mkLine = k: v: mkKeyValue k v + "\n"; + mkLines = if listsAsDuplicateKeys then + k: v: map (mkLine k) (if lib.isList v then v else [ v ]) + else + k: v: [ (mkLine k v) ]; + in attrs: + libStr.concatStrings + (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); + + # Generate an INI-style config file from an + # attrset of sections to an attrset of key-value pairs. + # + # generators.toINI {} { + # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; + # baz = { "also, integers" = 42; }; + # } + # + #> [baz] + #> also, integers=42 + #> + #> [foo] + #> ciao=bar + #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 + # + # The mk* configuration attributes can generically change + # the way sections and key-value strings are generated. + # + # For more examples see the test cases in ./tests/misc.nix. + toINI = { + # apply transformations (e.g. escapes) to section names + mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + # format a setting line from key and value + mkKeyValue ? mkKeyValueDefault { } "=", + # allow lists as values for duplicate keys + listsAsDuplicateKeys ? false }: + attrsOfAttrs: + let + # map function to string for each key val + mapAttrsToStringsSep = sep: mapFn: attrs: + libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs); + mkSection = sectName: sectValues: + '' + [${mkSectionName sectName}] + '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; + # map input to ini sections + in mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + + # Generate an INI-style config file from an attrset + # specifying the global section (no header), and an + # attrset of sections to an attrset of key-value pairs. + # + # generators.toINIWithGlobalSection {} { + # globalSection = { + # someGlobalKey = "hi"; + # }; + # sections = { + # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; + # baz = { "also, integers" = 42; }; + # } + # + #> someGlobalKey=hi + #> + #> [baz] + #> also, integers=42 + #> + #> [foo] + #> ciao=bar + #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 + # + # The mk* configuration attributes can generically change + # the way sections and key-value strings are generated. + # + # For more examples see the test cases in ./tests/misc.nix. + # + # If you don’t need a global section, you can also use + # `generators.toINI` directly, which only takes + # the part in `sections`. + toINIWithGlobalSection = { + # apply transformations (e.g. escapes) to section names + mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + # format a setting line from key and value + mkKeyValue ? mkKeyValueDefault { } "=", + # allow lists as values for duplicate keys + listsAsDuplicateKeys ? false }: + { globalSection, sections, }: + (if globalSection == { } then + "" + else + (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + + "\n") + + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } + sections); + + # Generate a git-config file from an attrset. + # + # It has two major differences from the regular INI format: + # + # 1. values are indented with tabs + # 2. sections can have sub-sections + # + # generators.toGitINI { + # url."ssh://git@github.com/".insteadOf = "https://github.com"; + # user.name = "edolstra"; + # } + # + #> [url "ssh://git@github.com/"] + #> insteadOf = https://github.com/ + #> + #> [user] + #> name = edolstra + toGitINI = attrs: + with builtins; + let + mkSectionName = name: + let + containsQuote = libStr.hasInfix ''"'' name; + sections = libStr.splitString "." name; + section = head sections; + subsections = tail sections; + subsection = concatStringsSep "." subsections; + in if containsQuote || subsections == [ ] then + name + else + ''${section} "${subsection}"''; + + # generation for multiple ini values + mkKeyValue = k: v: + let mkKeyValue = mkKeyValueDefault { } " = " k; + in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)); + + # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI + gitFlattenAttrs = let + recurse = path: value: + if isAttrs value && !lib.isDerivation value then + lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) + value + else if length path > 1 then { + ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = + value; + } else { + ${head path} = value; + }; + in attrs: + lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); + + toINI_ = toINI { inherit mkKeyValue mkSectionName; }; + in toINI_ (gitFlattenAttrs attrs); + + # Generates JSON from an arbitrary (non-function) value. + # For more information see the documentation of the builtin. + toJSON = { }: builtins.toJSON; + + # YAML has been a strict superset of JSON since 1.2, so we + # use toJSON. Before it only had a few differences referring + # to implicit typing rules, so it should work with older + # parsers as well. + toYAML = toJSON; + + withRecursion = { + # If this option is not null, the given value will stop evaluating at a certain depth + depthLimit + # If this option is true, an error will be thrown, if a certain given depth is exceeded + , throwOnDepthLimit ? true }: + assert builtins.isInt depthLimit; + let + specialAttrs = [ "__functor" "__functionArgs" "__toString" "__pretty" ]; + stepIntoAttr = evalNext: name: + if builtins.elem name specialAttrs then id else evalNext; + transform = depth: + if depthLimit != null && depth > depthLimit then + if throwOnDepthLimit then + throw "Exceeded maximum eval-depth limit of ${ + toString depthLimit + } while trying to evaluate with `generators.withRecursion'!" + else + const "" + else + id; + mapAny = with builtins; + depth: v: + let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); + in if isAttrs v then + mapAttrs (stepIntoAttr evalNext) v + else if isList v then + map evalNext v + else + transform (depth + 1) v; + in mapAny 0; + + # Pretty print a value, akin to `builtins.trace`. + # Should probably be a builtin as well. + # The pretty-printed string should be suitable for rendering default values + # in the NixOS manual. In particular, it should be as close to a valid Nix expression + # as possible. + toPretty = { + /* If this option is true, attrsets like { __pretty = fn; val = …; } + will use fn to convert val to a pretty printed representation. + (This means fn is type Val -> String.) + */ + allowPrettyValues ? false, + # If this option is true, the output is indented with newlines for attribute sets and lists + multiline ? true, + # Initial indentation level + indent ? "" }: + let + go = indent: v: + with builtins; + let + isPath = v: typeOf v == "path"; + introSpace = if multiline then '' + + ${indent} '' else + " "; + outroSpace = if multiline then '' + + ${indent}'' else + " "; + in if isInt v then + toString v + # toString loses precision on floats, so we use toJSON instead. This isn't perfect + # as the resulting string may not parse back as a float (e.g. 42, 1e-06), but for + # pretty-printing purposes this is acceptable. + else if isFloat v then + builtins.toJSON v + else if isString v then + let + lines = filter (v: !isList v) (builtins.split "\n" v); + escapeSingleline = libStr.escape [ "\\" ''"'' "\${" ]; + escapeMultiline = + libStr.replaceStrings [ "\${" "''" ] [ "''\${" "'''" ]; + singlelineResult = ''"'' + + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; + multilineResult = let + escapedLines = map escapeMultiline lines; + # The last line gets a special treatment: if it's empty, '' is on its own line at the "outer" + # indentation level. Otherwise, '' is appended to the last line. + lastLine = lib.last escapedLines; + in "''" + introSpace + + concatStringsSep introSpace (lib.init escapedLines) + + (if lastLine == "" then outroSpace else introSpace + lastLine) + + "''"; + in if multiline && length lines > 1 then + multilineResult + else + singlelineResult + else if true == v then + "true" + else if false == v then + "false" + else if null == v then + "null" + else if isPath v then + toString v + else if isList v then + if v == [ ] then + "[ ]" + else + "[" + introSpace + + libStr.concatMapStringsSep introSpace (go (indent + " ")) v + + outroSpace + "]" + else if isFunction v then + let + fna = lib.functionArgs v; + showFnas = concatStringsSep ", " (libAttr.mapAttrsToList + (name: hasDefVal: if hasDefVal then name + "?" else name) fna); + in if fna == { } then + "" + else + "" + else if isAttrs v then + # apply pretty values if allowed + if allowPrettyValues && v ? __pretty && v ? val then + v.__pretty v.val + else if v == { } then + "{ }" + else if v ? type && v.type == "derivation" then + "" + else + "{" + introSpace + libStr.concatStringsSep introSpace + (libAttr.mapAttrsToList (name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext + "while evaluating an attribute `${name}`" + (go (indent + " ") value) + };") v) + outroSpace + "}" + else + abort "generators.toPretty: should never happen (v = ${v})"; + in go indent; + + # PLIST handling + toPlist = { }: + v: + let + isFloat = builtins.isFloat or (x: false); + expr = ind: x: + with builtins; + if x == null then + "" + else if isBool x then + bool ind x + else if isInt x then + int ind x + else if isString x then + str ind x + else if isList x then + list ind x + else if isAttrs x then + attrs ind x + else if isFloat x then + float ind x + else + abort "generators.toPlist: should never happen (v = ${v})"; + + literal = ind: x: ind + x; + + bool = ind: x: literal ind (if x then "" else ""); + int = ind: x: literal ind "${toString x}"; + str = ind: x: literal ind "${x}"; + key = ind: x: literal ind "${x}"; + float = ind: x: literal ind "${toString x}"; + + indent = ind: expr " ${ind}"; + + item = ind: libStr.concatMapStringsSep "\n" (indent ind); + + list = ind: x: + libStr.concatStringsSep "\n" [ + (literal ind "") + (item ind x) + (literal ind "") + ]; + + attrs = ind: x: + libStr.concatStringsSep "\n" [ + (literal ind "") + (attr ind x) + (literal ind "") + ]; + + attr = let attrFilter = name: value: name != "_module" && value != null; + in ind: x: + libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList + (name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ]) x)); + + in '' + + + + ${expr "" v} + ''; + + # Translate a simple Nix expression to Dhall notation. + # Note that integers are translated to Integer and never + # the Natural type. + toDhall = { }@args: + v: + with builtins; + let concatItems = lib.strings.concatStringsSep ", "; + in if isAttrs v then + "{ ${ + concatItems (lib.attrsets.mapAttrsToList + (key: value: "${key} = ${toDhall args value}") v) + } }" + else if isList v then + "[ ${concatItems (map (toDhall args) v)} ]" + else if isInt v then + "${if v < 0 then "" else "+"}${toString v}" + else if isBool v then + (if v then "True" else "False") + else if isFunction v then + abort "generators.toDhall: cannot convert a function to Dhall" + else if v == null then + abort "generators.toDhall: cannot convert a null to Dhall" + else + builtins.toJSON v; +} diff --git a/test/diff/idioms_nixos_1/in.nix b/test/diff/idioms_nixos_1/in.nix new file mode 100644 index 00000000..d147155d --- /dev/null +++ b/test/diff/idioms_nixos_1/in.nix @@ -0,0 +1,350 @@ +{ config, lib, pkgs, ... }: + +with lib; + +let + + inherit (config.boot) kernelPatches; + inherit (config.boot.kernel) features randstructSeed; + inherit (config.boot.kernelPackages) kernel; + + kernelModulesConf = pkgs.writeText "nixos.conf" + '' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; + +in + +{ + + ###### interface + + options = { + + boot.kernel.features = mkOption { + default = {}; + example = literalExpression "{ debug = true; }"; + internal = true; + description = '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; + + boot.kernelPackages = mkOption { + default = pkgs.linuxPackages; + type = types.unspecified // { merge = mergeEqualOption; }; + apply = kernelPackages: kernelPackages.extend (self: super: { + kernel = super.kernel.override (originalArgs: { + inherit randstructSeed; + kernelPatches = (originalArgs.kernelPatches or []) ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + }); + }); + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. + defaultText = literalExpression "pkgs.linuxPackages"; + example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; + description = '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + }; + + boot.kernelPatches = mkOption { + type = types.listOf types.attrs; + default = []; + example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + + boot.kernel.randstructSeed = mkOption { + type = types.str; + default = ""; + example = "my secret seed"; + description = '' + Provides a custom seed for the RANDSTRUCT security + option of the Linux kernel. Note that RANDSTRUCT is + only enabled in NixOS hardened kernels. Using a custom seed requires + building the kernel and dependent packages locally, since this + customization happens at build time. + ''; + }; + + boot.kernelParams = mkOption { + type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { + name = "kernelParam"; + description = "string, with spaces inside double quotes"; + }); + default = [ ]; + description = "Parameters added to the kernel command line."; + }; + + boot.consoleLogLevel = mkOption { + type = types.int; + default = 4; + description = '' + The kernel console loglevel. All Kernel Messages with a log level smaller + than this setting will be printed to the console. + ''; + }; + + boot.vesa = mkOption { + type = types.bool; + default = false; + description = '' + (Deprecated) This option, if set, activates the VESA 800x600 video + mode on boot and disables kernel modesetting. It is equivalent to + specifying [ "vga=0x317" "nomodeset" ] in the + option. This option is + deprecated as of 2020: Xorg now works better with modesetting, and + you might want a different VESA vga setting, anyway. + ''; + }; + + boot.extraModulePackages = mkOption { + type = types.listOf types.package; + default = []; + example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; + description = "A list of additional packages supplying kernel modules."; + }; + + boot.kernelModules = mkOption { + type = types.listOf types.str; + default = []; + description = '' + The set of kernel modules to be loaded in the second stage of + the boot process. Note that modules that are needed to + mount the root file system should be added to + or + . + ''; + }; + + boot.initrd.availableKernelModules = mkOption { + type = types.listOf types.str; + default = []; + example = [ "sata_nv" "ext3" ]; + description = '' + The set of kernel modules in the initial ramdisk used during the + boot process. This set must include all modules necessary for + mounting the root device. That is, it should include modules + for the physical device (e.g., SCSI drivers) and for the file + system (e.g., ext3). The set specified here is automatically + closed under the module dependency relation, i.e., all + dependencies of the modules list here are included + automatically. The modules listed here are available in the + initrd, but are only loaded on demand (e.g., the ext3 module is + loaded automatically when an ext3 filesystem is mounted, and + modules for PCI devices are loaded when they match the PCI ID + of a device in your system). To force a module to be loaded, + include it in . + ''; + }; + + boot.initrd.kernelModules = mkOption { + type = types.listOf types.str; + default = []; + description = "List of modules that are always loaded by the initrd."; + }; + + boot.initrd.includeDefaultModules = mkOption { + type = types.bool; + default = true; + description = '' + This option, if set, adds a collection of default kernel modules + to and + . + ''; + }; + + system.modulesTree = mkOption { + type = types.listOf types.path; + internal = true; + default = []; + description = '' + Tree of kernel modules. This includes the kernel, plus modules + built outside of the kernel. Combine these into a single tree of + symlinks because modprobe only supports one directory. + ''; + # Convert the list of path to only one path. + apply = pkgs.aggregateModules; + }; + + system.requiredKernelConfig = mkOption { + default = []; + example = literalExpression '' + with config.lib.kernelConfig; [ + (isYes "MODULES") + (isEnabled "FB_CON_DECOR") + (isEnabled "BLK_DEV_INITRD") + ] + ''; + internal = true; + type = types.listOf types.attrs; + description = '' + This option allows modules to specify the kernel config options that + must be set (or unset) for the module to work. Please use the + lib.kernelConfig functions to build list elements. + ''; + }; + + }; + + + ###### implementation + + config = mkMerge + [ (mkIf config.boot.initrd.enable { + boot.initrd.availableKernelModules = + optionals config.boot.initrd.includeDefaultModules ([ + # Note: most of these (especially the SATA/PATA modules) + # shouldn't be included by default since nixos-generate-config + # detects them, but I'm keeping them for now for backwards + # compatibility. + + # Some SATA/PATA stuff. + "ahci" + "sata_nv" + "sata_via" + "sata_sis" + "sata_uli" + "ata_piix" + "pata_marvell" + + # Standard SCSI stuff. + "sd_mod" + "sr_mod" + + # SD cards and internal eMMC drives. + "mmc_block" + + # Support USB keyboards, in case the boot fails and we only have + # a USB keyboard, or for LUKS passphrase prompt. + "uhci_hcd" + "ehci_hcd" + "ehci_pci" + "ohci_hcd" + "ohci_pci" + "xhci_hcd" + "xhci_pci" + "usbhid" + "hid_generic" "hid_lenovo" "hid_apple" "hid_roccat" + "hid_logitech_hidpp" "hid_logitech_dj" "hid_microsoft" + + ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ + # Misc. x86 keyboard stuff. + "pcips2" "atkbd" "i8042" + + # x86 RTC needed by the stage 2 init script. + "rtc_cmos" + ]); + + boot.initrd.kernelModules = + optionals config.boot.initrd.includeDefaultModules [ + # For LVM. + "dm_mod" + ]; + }) + + (mkIf (!config.boot.isContainer) { + system.build = { inherit kernel; }; + + system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; + + # Implement consoleLogLevel both in early boot and using sysctl + # (so you don't need to reboot to have changes take effect). + boot.kernelParams = + [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ + optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; + + boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; + + boot.kernelModules = [ "loop" "atkbd" ]; + + # The Linux kernel >= 2.6.27 provides firmware. + hardware.firmware = [ kernel ]; + + # Create /etc/modules-load.d/nixos.conf, which is read by + # systemd-modules-load.service to load required kernel modules. + environment.etc = + { "modules-load.d/nixos.conf".source = kernelModulesConf; + }; + + systemd.services.systemd-modules-load = + { wantedBy = [ "multi-user.target" ]; + restartTriggers = [ kernelModulesConf ]; + serviceConfig = + { # Ignore failed module loads. Typically some of the + # modules in ‘boot.kernelModules’ are "nice to have but + # not required" (e.g. acpi-cpufreq), so we don't want to + # barf on those. + SuccessExitStatus = "0 1"; + }; + }; + + lib.kernelConfig = { + isYes = option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + }; + + isNo = option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + }; + + isModule = option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + }; + + ### Usually you will just want to use these two + # True if yes or module + isEnabled = option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + }; + + # True if no or omitted + isDisabled = option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + }; + }; + + # The config options that all modules can depend upon + system.requiredKernelConfig = with config.lib.kernelConfig; + [ + # !!! Should this really be needed? + (isYes "MODULES") + (isYes "BINFMT_ELF") + ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); + + # nixpkgs kernels are assumed to have all required features + assertions = if config.boot.kernelPackages.kernel ? features then [] else + let cfg = config.boot.kernelPackages.kernel.config; in map (attrs: + { assertion = attrs.assertion cfg; inherit (attrs) message; } + ) config.system.requiredKernelConfig; + + }) + + ]; + +} diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix new file mode 100644 index 00000000..fa81fe0f --- /dev/null +++ b/test/diff/idioms_nixos_1/out.nix @@ -0,0 +1,358 @@ +{ config, lib, pkgs, ... }: + +with lib; + +let + + inherit (config.boot) kernelPatches; + inherit (config.boot.kernel) features randstructSeed; + inherit (config.boot.kernelPackages) kernel; + + kernelModulesConf = pkgs.writeText "nixos.conf" '' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; + +in { + + ###### interface + + options = { + + boot.kernel.features = mkOption { + default = { }; + example = literalExpression "{ debug = true; }"; + internal = true; + description = '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; + + boot.kernelPackages = mkOption { + default = pkgs.linuxPackages; + type = types.unspecified // { merge = mergeEqualOption; }; + apply = kernelPackages: + kernelPackages.extend (self: super: { + kernel = super.kernel.override (originalArgs: { + inherit randstructSeed; + kernelPatches = (originalArgs.kernelPatches or [ ]) + ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + }); + }); + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. + defaultText = literalExpression "pkgs.linuxPackages"; + example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; + description = '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + }; + + boot.kernelPatches = mkOption { + type = types.listOf types.attrs; + default = [ ]; + example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + + boot.kernel.randstructSeed = mkOption { + type = types.str; + default = ""; + example = "my secret seed"; + description = '' + Provides a custom seed for the RANDSTRUCT security + option of the Linux kernel. Note that RANDSTRUCT is + only enabled in NixOS hardened kernels. Using a custom seed requires + building the kernel and dependent packages locally, since this + customization happens at build time. + ''; + }; + + boot.kernelParams = mkOption { + type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { + name = "kernelParam"; + description = "string, with spaces inside double quotes"; + }); + default = [ ]; + description = "Parameters added to the kernel command line."; + }; + + boot.consoleLogLevel = mkOption { + type = types.int; + default = 4; + description = '' + The kernel console loglevel. All Kernel Messages with a log level smaller + than this setting will be printed to the console. + ''; + }; + + boot.vesa = mkOption { + type = types.bool; + default = false; + description = '' + (Deprecated) This option, if set, activates the VESA 800x600 video + mode on boot and disables kernel modesetting. It is equivalent to + specifying [ "vga=0x317" "nomodeset" ] in the + option. This option is + deprecated as of 2020: Xorg now works better with modesetting, and + you might want a different VESA vga setting, anyway. + ''; + }; + + boot.extraModulePackages = mkOption { + type = types.listOf types.package; + default = [ ]; + example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; + description = "A list of additional packages supplying kernel modules."; + }; + + boot.kernelModules = mkOption { + type = types.listOf types.str; + default = [ ]; + description = '' + The set of kernel modules to be loaded in the second stage of + the boot process. Note that modules that are needed to + mount the root file system should be added to + or + . + ''; + }; + + boot.initrd.availableKernelModules = mkOption { + type = types.listOf types.str; + default = [ ]; + example = [ "sata_nv" "ext3" ]; + description = '' + The set of kernel modules in the initial ramdisk used during the + boot process. This set must include all modules necessary for + mounting the root device. That is, it should include modules + for the physical device (e.g., SCSI drivers) and for the file + system (e.g., ext3). The set specified here is automatically + closed under the module dependency relation, i.e., all + dependencies of the modules list here are included + automatically. The modules listed here are available in the + initrd, but are only loaded on demand (e.g., the ext3 module is + loaded automatically when an ext3 filesystem is mounted, and + modules for PCI devices are loaded when they match the PCI ID + of a device in your system). To force a module to be loaded, + include it in . + ''; + }; + + boot.initrd.kernelModules = mkOption { + type = types.listOf types.str; + default = [ ]; + description = "List of modules that are always loaded by the initrd."; + }; + + boot.initrd.includeDefaultModules = mkOption { + type = types.bool; + default = true; + description = '' + This option, if set, adds a collection of default kernel modules + to and + . + ''; + }; + + system.modulesTree = mkOption { + type = types.listOf types.path; + internal = true; + default = [ ]; + description = '' + Tree of kernel modules. This includes the kernel, plus modules + built outside of the kernel. Combine these into a single tree of + symlinks because modprobe only supports one directory. + ''; + # Convert the list of path to only one path. + apply = pkgs.aggregateModules; + }; + + system.requiredKernelConfig = mkOption { + default = [ ]; + example = literalExpression '' + with config.lib.kernelConfig; [ + (isYes "MODULES") + (isEnabled "FB_CON_DECOR") + (isEnabled "BLK_DEV_INITRD") + ] + ''; + internal = true; + type = types.listOf types.attrs; + description = '' + This option allows modules to specify the kernel config options that + must be set (or unset) for the module to work. Please use the + lib.kernelConfig functions to build list elements. + ''; + }; + + }; + + ###### implementation + + config = mkMerge [ + (mkIf config.boot.initrd.enable { + boot.initrd.availableKernelModules = + optionals config.boot.initrd.includeDefaultModules ([ + # Note: most of these (especially the SATA/PATA modules) + # shouldn't be included by default since nixos-generate-config + # detects them, but I'm keeping them for now for backwards + # compatibility. + + # Some SATA/PATA stuff. + "ahci" + "sata_nv" + "sata_via" + "sata_sis" + "sata_uli" + "ata_piix" + "pata_marvell" + + # Standard SCSI stuff. + "sd_mod" + "sr_mod" + + # SD cards and internal eMMC drives. + "mmc_block" + + # Support USB keyboards, in case the boot fails and we only have + # a USB keyboard, or for LUKS passphrase prompt. + "uhci_hcd" + "ehci_hcd" + "ehci_pci" + "ohci_hcd" + "ohci_pci" + "xhci_hcd" + "xhci_pci" + "usbhid" + "hid_generic" + "hid_lenovo" + "hid_apple" + "hid_roccat" + "hid_logitech_hidpp" + "hid_logitech_dj" + "hid_microsoft" + + ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ + # Misc. x86 keyboard stuff. + "pcips2" + "atkbd" + "i8042" + + # x86 RTC needed by the stage 2 init script. + "rtc_cmos" + ]); + + boot.initrd.kernelModules = + optionals config.boot.initrd.includeDefaultModules [ + # For LVM. + "dm_mod" + ]; + }) + + (mkIf (!config.boot.isContainer) { + system.build = { inherit kernel; }; + + system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; + + # Implement consoleLogLevel both in early boot and using sysctl + # (so you don't need to reboot to have changes take effect). + boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] + ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; + + boot.kernel.sysctl."kernel.printk" = + mkDefault config.boot.consoleLogLevel; + + boot.kernelModules = [ "loop" "atkbd" ]; + + # The Linux kernel >= 2.6.27 provides firmware. + hardware.firmware = [ kernel ]; + + # Create /etc/modules-load.d/nixos.conf, which is read by + # systemd-modules-load.service to load required kernel modules. + environment.etc = { + "modules-load.d/nixos.conf".source = kernelModulesConf; + }; + + systemd.services.systemd-modules-load = { + wantedBy = [ "multi-user.target" ]; + restartTriggers = [ kernelModulesConf ]; + serviceConfig = { # Ignore failed module loads. Typically some of the + # modules in ‘boot.kernelModules’ are "nice to have but + # not required" (e.g. acpi-cpufreq), so we don't want to + # barf on those. + SuccessExitStatus = "0 1"; + }; + }; + + lib.kernelConfig = { + isYes = option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + }; + + isNo = option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + }; + + isModule = option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + }; + + ### Usually you will just want to use these two + # True if yes or module + isEnabled = option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + }; + + # True if no or omitted + isDisabled = option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + }; + }; + + # The config options that all modules can depend upon + system.requiredKernelConfig = with config.lib.kernelConfig; + [ + # !!! Should this really be needed? + (isYes "MODULES") + (isYes "BINFMT_ELF") + ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); + + # nixpkgs kernels are assumed to have all required features + assertions = if config.boot.kernelPackages.kernel ? features then + [ ] + else + let cfg = config.boot.kernelPackages.kernel.config; + in map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig; + + }) + + ]; + +} diff --git a/test/diff/idioms_pkgs_1/in.nix b/test/diff/idioms_pkgs_1/in.nix new file mode 100644 index 00000000..777f1d25 --- /dev/null +++ b/test/diff/idioms_pkgs_1/in.nix @@ -0,0 +1,13 @@ +{stdenv, lib, fetchFrom, ... }: + +stdenv.mkDerivation rec { + pname = "test"; + version = "0.0"; + src = fetchFrom { + url = "example/${version}"; + }; + meta = with lib; { + maintainers = with maintainers; [ someone ]; + description = "something"; + }; +} diff --git a/test/diff/idioms_pkgs_1/out.nix b/test/diff/idioms_pkgs_1/out.nix new file mode 100644 index 00000000..fc9d729b --- /dev/null +++ b/test/diff/idioms_pkgs_1/out.nix @@ -0,0 +1,11 @@ +{ stdenv, lib, fetchFrom, ... }: + +stdenv.mkDerivation rec { + pname = "test"; + version = "0.0"; + src = fetchFrom { url = "example/${version}"; }; + meta = with lib; { + maintainers = with maintainers; [ someone ]; + description = "something"; + }; +} diff --git a/test/diff/idioms_pkgs_2/in.nix b/test/diff/idioms_pkgs_2/in.nix new file mode 100644 index 00000000..ce49cfd6 --- /dev/null +++ b/test/diff/idioms_pkgs_2/in.nix @@ -0,0 +1,43 @@ +{ lib +, stdenv +, fetchurl +, nixos +, testVersion +, testEqualDerivation +, hello +}: + +stdenv.mkDerivation rec { + pname = "hello"; + version = "2.12"; + + src = fetchurl { + url = "mirror://gnu/hello/${pname}-${version}.tar.gz"; + sha256 = "1ayhp9v4m4rdhjmnl2bq3cibrbqqkgjbl3s7yk2nhlh8vj3ay16g"; + }; + + doCheck = true; + + passthru.tests = { + version = testVersion { package = hello; }; + + invariant-under-noXlibs = + testEqualDerivation + "hello must not be rebuilt when environment.noXlibs is set." + hello + (nixos { environment.noXlibs = true; }).pkgs.hello; + }; + + meta = with lib; { + description = "A program that produces a familiar, friendly greeting"; + longDescription = '' + GNU Hello is a program that prints "Hello, world!" when you run it. + It is fully customizable. + ''; + homepage = "https://www.gnu.org/software/hello/manual/"; + changelog = "https://git.savannah.gnu.org/cgit/hello.git/plain/NEWS?h=v${version}"; + license = licenses.gpl3Plus; + maintainers = [ maintainers.eelco ]; + platforms = platforms.all; + }; +} diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix new file mode 100644 index 00000000..e72b643c --- /dev/null +++ b/test/diff/idioms_pkgs_2/out.nix @@ -0,0 +1,35 @@ +{ lib, stdenv, fetchurl, nixos, testVersion, testEqualDerivation, hello }: + +stdenv.mkDerivation rec { + pname = "hello"; + version = "2.12"; + + src = fetchurl { + url = "mirror://gnu/hello/${pname}-${version}.tar.gz"; + sha256 = "1ayhp9v4m4rdhjmnl2bq3cibrbqqkgjbl3s7yk2nhlh8vj3ay16g"; + }; + + doCheck = true; + + passthru.tests = { + version = testVersion { package = hello; }; + + invariant-under-noXlibs = testEqualDerivation + "hello must not be rebuilt when environment.noXlibs is set." hello + (nixos { environment.noXlibs = true; }).pkgs.hello; + }; + + meta = with lib; { + description = "A program that produces a familiar, friendly greeting"; + longDescription = '' + GNU Hello is a program that prints "Hello, world!" when you run it. + It is fully customizable. + ''; + homepage = "https://www.gnu.org/software/hello/manual/"; + changelog = + "https://git.savannah.gnu.org/cgit/hello.git/plain/NEWS?h=v${version}"; + license = licenses.gpl3Plus; + maintainers = [ maintainers.eelco ]; + platforms = platforms.all; + }; +} diff --git a/test/diff/idioms_pkgs_3/in.nix b/test/diff/idioms_pkgs_3/in.nix new file mode 100644 index 00000000..d147155d --- /dev/null +++ b/test/diff/idioms_pkgs_3/in.nix @@ -0,0 +1,350 @@ +{ config, lib, pkgs, ... }: + +with lib; + +let + + inherit (config.boot) kernelPatches; + inherit (config.boot.kernel) features randstructSeed; + inherit (config.boot.kernelPackages) kernel; + + kernelModulesConf = pkgs.writeText "nixos.conf" + '' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; + +in + +{ + + ###### interface + + options = { + + boot.kernel.features = mkOption { + default = {}; + example = literalExpression "{ debug = true; }"; + internal = true; + description = '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; + + boot.kernelPackages = mkOption { + default = pkgs.linuxPackages; + type = types.unspecified // { merge = mergeEqualOption; }; + apply = kernelPackages: kernelPackages.extend (self: super: { + kernel = super.kernel.override (originalArgs: { + inherit randstructSeed; + kernelPatches = (originalArgs.kernelPatches or []) ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + }); + }); + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. + defaultText = literalExpression "pkgs.linuxPackages"; + example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; + description = '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + }; + + boot.kernelPatches = mkOption { + type = types.listOf types.attrs; + default = []; + example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + + boot.kernel.randstructSeed = mkOption { + type = types.str; + default = ""; + example = "my secret seed"; + description = '' + Provides a custom seed for the RANDSTRUCT security + option of the Linux kernel. Note that RANDSTRUCT is + only enabled in NixOS hardened kernels. Using a custom seed requires + building the kernel and dependent packages locally, since this + customization happens at build time. + ''; + }; + + boot.kernelParams = mkOption { + type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { + name = "kernelParam"; + description = "string, with spaces inside double quotes"; + }); + default = [ ]; + description = "Parameters added to the kernel command line."; + }; + + boot.consoleLogLevel = mkOption { + type = types.int; + default = 4; + description = '' + The kernel console loglevel. All Kernel Messages with a log level smaller + than this setting will be printed to the console. + ''; + }; + + boot.vesa = mkOption { + type = types.bool; + default = false; + description = '' + (Deprecated) This option, if set, activates the VESA 800x600 video + mode on boot and disables kernel modesetting. It is equivalent to + specifying [ "vga=0x317" "nomodeset" ] in the + option. This option is + deprecated as of 2020: Xorg now works better with modesetting, and + you might want a different VESA vga setting, anyway. + ''; + }; + + boot.extraModulePackages = mkOption { + type = types.listOf types.package; + default = []; + example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; + description = "A list of additional packages supplying kernel modules."; + }; + + boot.kernelModules = mkOption { + type = types.listOf types.str; + default = []; + description = '' + The set of kernel modules to be loaded in the second stage of + the boot process. Note that modules that are needed to + mount the root file system should be added to + or + . + ''; + }; + + boot.initrd.availableKernelModules = mkOption { + type = types.listOf types.str; + default = []; + example = [ "sata_nv" "ext3" ]; + description = '' + The set of kernel modules in the initial ramdisk used during the + boot process. This set must include all modules necessary for + mounting the root device. That is, it should include modules + for the physical device (e.g., SCSI drivers) and for the file + system (e.g., ext3). The set specified here is automatically + closed under the module dependency relation, i.e., all + dependencies of the modules list here are included + automatically. The modules listed here are available in the + initrd, but are only loaded on demand (e.g., the ext3 module is + loaded automatically when an ext3 filesystem is mounted, and + modules for PCI devices are loaded when they match the PCI ID + of a device in your system). To force a module to be loaded, + include it in . + ''; + }; + + boot.initrd.kernelModules = mkOption { + type = types.listOf types.str; + default = []; + description = "List of modules that are always loaded by the initrd."; + }; + + boot.initrd.includeDefaultModules = mkOption { + type = types.bool; + default = true; + description = '' + This option, if set, adds a collection of default kernel modules + to and + . + ''; + }; + + system.modulesTree = mkOption { + type = types.listOf types.path; + internal = true; + default = []; + description = '' + Tree of kernel modules. This includes the kernel, plus modules + built outside of the kernel. Combine these into a single tree of + symlinks because modprobe only supports one directory. + ''; + # Convert the list of path to only one path. + apply = pkgs.aggregateModules; + }; + + system.requiredKernelConfig = mkOption { + default = []; + example = literalExpression '' + with config.lib.kernelConfig; [ + (isYes "MODULES") + (isEnabled "FB_CON_DECOR") + (isEnabled "BLK_DEV_INITRD") + ] + ''; + internal = true; + type = types.listOf types.attrs; + description = '' + This option allows modules to specify the kernel config options that + must be set (or unset) for the module to work. Please use the + lib.kernelConfig functions to build list elements. + ''; + }; + + }; + + + ###### implementation + + config = mkMerge + [ (mkIf config.boot.initrd.enable { + boot.initrd.availableKernelModules = + optionals config.boot.initrd.includeDefaultModules ([ + # Note: most of these (especially the SATA/PATA modules) + # shouldn't be included by default since nixos-generate-config + # detects them, but I'm keeping them for now for backwards + # compatibility. + + # Some SATA/PATA stuff. + "ahci" + "sata_nv" + "sata_via" + "sata_sis" + "sata_uli" + "ata_piix" + "pata_marvell" + + # Standard SCSI stuff. + "sd_mod" + "sr_mod" + + # SD cards and internal eMMC drives. + "mmc_block" + + # Support USB keyboards, in case the boot fails and we only have + # a USB keyboard, or for LUKS passphrase prompt. + "uhci_hcd" + "ehci_hcd" + "ehci_pci" + "ohci_hcd" + "ohci_pci" + "xhci_hcd" + "xhci_pci" + "usbhid" + "hid_generic" "hid_lenovo" "hid_apple" "hid_roccat" + "hid_logitech_hidpp" "hid_logitech_dj" "hid_microsoft" + + ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ + # Misc. x86 keyboard stuff. + "pcips2" "atkbd" "i8042" + + # x86 RTC needed by the stage 2 init script. + "rtc_cmos" + ]); + + boot.initrd.kernelModules = + optionals config.boot.initrd.includeDefaultModules [ + # For LVM. + "dm_mod" + ]; + }) + + (mkIf (!config.boot.isContainer) { + system.build = { inherit kernel; }; + + system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; + + # Implement consoleLogLevel both in early boot and using sysctl + # (so you don't need to reboot to have changes take effect). + boot.kernelParams = + [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ + optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; + + boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; + + boot.kernelModules = [ "loop" "atkbd" ]; + + # The Linux kernel >= 2.6.27 provides firmware. + hardware.firmware = [ kernel ]; + + # Create /etc/modules-load.d/nixos.conf, which is read by + # systemd-modules-load.service to load required kernel modules. + environment.etc = + { "modules-load.d/nixos.conf".source = kernelModulesConf; + }; + + systemd.services.systemd-modules-load = + { wantedBy = [ "multi-user.target" ]; + restartTriggers = [ kernelModulesConf ]; + serviceConfig = + { # Ignore failed module loads. Typically some of the + # modules in ‘boot.kernelModules’ are "nice to have but + # not required" (e.g. acpi-cpufreq), so we don't want to + # barf on those. + SuccessExitStatus = "0 1"; + }; + }; + + lib.kernelConfig = { + isYes = option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + }; + + isNo = option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + }; + + isModule = option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + }; + + ### Usually you will just want to use these two + # True if yes or module + isEnabled = option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + }; + + # True if no or omitted + isDisabled = option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + }; + }; + + # The config options that all modules can depend upon + system.requiredKernelConfig = with config.lib.kernelConfig; + [ + # !!! Should this really be needed? + (isYes "MODULES") + (isYes "BINFMT_ELF") + ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); + + # nixpkgs kernels are assumed to have all required features + assertions = if config.boot.kernelPackages.kernel ? features then [] else + let cfg = config.boot.kernelPackages.kernel.config; in map (attrs: + { assertion = attrs.assertion cfg; inherit (attrs) message; } + ) config.system.requiredKernelConfig; + + }) + + ]; + +} diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix new file mode 100644 index 00000000..fa81fe0f --- /dev/null +++ b/test/diff/idioms_pkgs_3/out.nix @@ -0,0 +1,358 @@ +{ config, lib, pkgs, ... }: + +with lib; + +let + + inherit (config.boot) kernelPatches; + inherit (config.boot.kernel) features randstructSeed; + inherit (config.boot.kernelPackages) kernel; + + kernelModulesConf = pkgs.writeText "nixos.conf" '' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; + +in { + + ###### interface + + options = { + + boot.kernel.features = mkOption { + default = { }; + example = literalExpression "{ debug = true; }"; + internal = true; + description = '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; + + boot.kernelPackages = mkOption { + default = pkgs.linuxPackages; + type = types.unspecified // { merge = mergeEqualOption; }; + apply = kernelPackages: + kernelPackages.extend (self: super: { + kernel = super.kernel.override (originalArgs: { + inherit randstructSeed; + kernelPatches = (originalArgs.kernelPatches or [ ]) + ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + }); + }); + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. + defaultText = literalExpression "pkgs.linuxPackages"; + example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; + description = '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + }; + + boot.kernelPatches = mkOption { + type = types.listOf types.attrs; + default = [ ]; + example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + + boot.kernel.randstructSeed = mkOption { + type = types.str; + default = ""; + example = "my secret seed"; + description = '' + Provides a custom seed for the RANDSTRUCT security + option of the Linux kernel. Note that RANDSTRUCT is + only enabled in NixOS hardened kernels. Using a custom seed requires + building the kernel and dependent packages locally, since this + customization happens at build time. + ''; + }; + + boot.kernelParams = mkOption { + type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { + name = "kernelParam"; + description = "string, with spaces inside double quotes"; + }); + default = [ ]; + description = "Parameters added to the kernel command line."; + }; + + boot.consoleLogLevel = mkOption { + type = types.int; + default = 4; + description = '' + The kernel console loglevel. All Kernel Messages with a log level smaller + than this setting will be printed to the console. + ''; + }; + + boot.vesa = mkOption { + type = types.bool; + default = false; + description = '' + (Deprecated) This option, if set, activates the VESA 800x600 video + mode on boot and disables kernel modesetting. It is equivalent to + specifying [ "vga=0x317" "nomodeset" ] in the + option. This option is + deprecated as of 2020: Xorg now works better with modesetting, and + you might want a different VESA vga setting, anyway. + ''; + }; + + boot.extraModulePackages = mkOption { + type = types.listOf types.package; + default = [ ]; + example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; + description = "A list of additional packages supplying kernel modules."; + }; + + boot.kernelModules = mkOption { + type = types.listOf types.str; + default = [ ]; + description = '' + The set of kernel modules to be loaded in the second stage of + the boot process. Note that modules that are needed to + mount the root file system should be added to + or + . + ''; + }; + + boot.initrd.availableKernelModules = mkOption { + type = types.listOf types.str; + default = [ ]; + example = [ "sata_nv" "ext3" ]; + description = '' + The set of kernel modules in the initial ramdisk used during the + boot process. This set must include all modules necessary for + mounting the root device. That is, it should include modules + for the physical device (e.g., SCSI drivers) and for the file + system (e.g., ext3). The set specified here is automatically + closed under the module dependency relation, i.e., all + dependencies of the modules list here are included + automatically. The modules listed here are available in the + initrd, but are only loaded on demand (e.g., the ext3 module is + loaded automatically when an ext3 filesystem is mounted, and + modules for PCI devices are loaded when they match the PCI ID + of a device in your system). To force a module to be loaded, + include it in . + ''; + }; + + boot.initrd.kernelModules = mkOption { + type = types.listOf types.str; + default = [ ]; + description = "List of modules that are always loaded by the initrd."; + }; + + boot.initrd.includeDefaultModules = mkOption { + type = types.bool; + default = true; + description = '' + This option, if set, adds a collection of default kernel modules + to and + . + ''; + }; + + system.modulesTree = mkOption { + type = types.listOf types.path; + internal = true; + default = [ ]; + description = '' + Tree of kernel modules. This includes the kernel, plus modules + built outside of the kernel. Combine these into a single tree of + symlinks because modprobe only supports one directory. + ''; + # Convert the list of path to only one path. + apply = pkgs.aggregateModules; + }; + + system.requiredKernelConfig = mkOption { + default = [ ]; + example = literalExpression '' + with config.lib.kernelConfig; [ + (isYes "MODULES") + (isEnabled "FB_CON_DECOR") + (isEnabled "BLK_DEV_INITRD") + ] + ''; + internal = true; + type = types.listOf types.attrs; + description = '' + This option allows modules to specify the kernel config options that + must be set (or unset) for the module to work. Please use the + lib.kernelConfig functions to build list elements. + ''; + }; + + }; + + ###### implementation + + config = mkMerge [ + (mkIf config.boot.initrd.enable { + boot.initrd.availableKernelModules = + optionals config.boot.initrd.includeDefaultModules ([ + # Note: most of these (especially the SATA/PATA modules) + # shouldn't be included by default since nixos-generate-config + # detects them, but I'm keeping them for now for backwards + # compatibility. + + # Some SATA/PATA stuff. + "ahci" + "sata_nv" + "sata_via" + "sata_sis" + "sata_uli" + "ata_piix" + "pata_marvell" + + # Standard SCSI stuff. + "sd_mod" + "sr_mod" + + # SD cards and internal eMMC drives. + "mmc_block" + + # Support USB keyboards, in case the boot fails and we only have + # a USB keyboard, or for LUKS passphrase prompt. + "uhci_hcd" + "ehci_hcd" + "ehci_pci" + "ohci_hcd" + "ohci_pci" + "xhci_hcd" + "xhci_pci" + "usbhid" + "hid_generic" + "hid_lenovo" + "hid_apple" + "hid_roccat" + "hid_logitech_hidpp" + "hid_logitech_dj" + "hid_microsoft" + + ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ + # Misc. x86 keyboard stuff. + "pcips2" + "atkbd" + "i8042" + + # x86 RTC needed by the stage 2 init script. + "rtc_cmos" + ]); + + boot.initrd.kernelModules = + optionals config.boot.initrd.includeDefaultModules [ + # For LVM. + "dm_mod" + ]; + }) + + (mkIf (!config.boot.isContainer) { + system.build = { inherit kernel; }; + + system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; + + # Implement consoleLogLevel both in early boot and using sysctl + # (so you don't need to reboot to have changes take effect). + boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] + ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; + + boot.kernel.sysctl."kernel.printk" = + mkDefault config.boot.consoleLogLevel; + + boot.kernelModules = [ "loop" "atkbd" ]; + + # The Linux kernel >= 2.6.27 provides firmware. + hardware.firmware = [ kernel ]; + + # Create /etc/modules-load.d/nixos.conf, which is read by + # systemd-modules-load.service to load required kernel modules. + environment.etc = { + "modules-load.d/nixos.conf".source = kernelModulesConf; + }; + + systemd.services.systemd-modules-load = { + wantedBy = [ "multi-user.target" ]; + restartTriggers = [ kernelModulesConf ]; + serviceConfig = { # Ignore failed module loads. Typically some of the + # modules in ‘boot.kernelModules’ are "nice to have but + # not required" (e.g. acpi-cpufreq), so we don't want to + # barf on those. + SuccessExitStatus = "0 1"; + }; + }; + + lib.kernelConfig = { + isYes = option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + }; + + isNo = option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + }; + + isModule = option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + }; + + ### Usually you will just want to use these two + # True if yes or module + isEnabled = option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + }; + + # True if no or omitted + isDisabled = option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + }; + }; + + # The config options that all modules can depend upon + system.requiredKernelConfig = with config.lib.kernelConfig; + [ + # !!! Should this really be needed? + (isYes "MODULES") + (isYes "BINFMT_ELF") + ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); + + # nixpkgs kernels are assumed to have all required features + assertions = if config.boot.kernelPackages.kernel ? features then + [ ] + else + let cfg = config.boot.kernelPackages.kernel.config; + in map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig; + + }) + + ]; + +} diff --git a/test/diff/if_else/in.nix b/test/diff/if_else/in.nix new file mode 100644 index 00000000..5212aa73 --- /dev/null +++ b/test/diff/if_else/in.nix @@ -0,0 +1,102 @@ +[ + (if true + then { + version = "1.2.3"; + } + else { + version = "3.2.1"; + }) + (if true + then '' + some text + '' + else '' + other text + '') + (if ./a then b else c) + (if /**/ a /**/ then /**/ b /**/ else /**/ c) + (if # test + a # test + then # test + b # test + else # test + c) + (if # test + /**/ + a # test + /**/ + then # test + b # test + /**/ + else # test + /**/ + c) + (if if a then b else c then b else if a then b else if a then b else c) + (if if a then b else c then b else if a then b else /*x*/ if a then b else c) + (if + (if + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)) + then + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)) + else + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c))) + then + (if + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)) + then + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)) + else + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c))) + else + (if + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)) + then + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)) + else + (if + (if a then b else c) + then + (if a then b else c) + else + (if a then b else c)))) +] diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix new file mode 100644 index 00000000..628141ab --- /dev/null +++ b/test/diff/if_else/out.nix @@ -0,0 +1,72 @@ +[ + (if true then { version = "1.2.3"; } else { version = "3.2.1"; }) + (if true then '' + some text + '' else '' + other text + '') + (if ./a then b else c) + (if a then b else c) + (if # test + a # test + then # test + b # test + else # test + c) + (if # test + a # test + then # test + b # test + else # test + c) + (if if a then b else c then b else if a then b else if a then b else c) + (if if a then b else c then + b + else if a then + b + else # x + if a then + b + else + c) + (if (if (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)) then + (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)) + else + (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c))) then + (if (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)) then + (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)) + else + (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c))) + else + (if (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)) then + (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)) + else + (if (if a then b else c) then + (if a then b else c) + else + (if a then b else c)))) +] diff --git a/test/diff/inherit/in.nix b/test/diff/inherit/in.nix new file mode 100644 index 00000000..84dfa140 --- /dev/null +++ b/test/diff/inherit/in.nix @@ -0,0 +1,29 @@ +[ + { + inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } + { inherit + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } + { inherit b d ; } + { inherit b d /*e*/ ; } + { inherit b /*c*/ d ; } + { inherit b /*c*/ d /*e*/ ; } + { inherit /*a*/ b d ; } + { inherit /*a*/ b d /*e*/ ; } + { inherit /*a*/ b /*c*/ d ; } + { inherit /*a*/ b /*c*/ d /*e*/ ; } + { + inherit # test + a # test + + b # test + c # test + d # test + + e + f + + g + h + ; + } +] diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix new file mode 100644 index 00000000..0717536b --- /dev/null +++ b/test/diff/inherit/out.nix @@ -0,0 +1,54 @@ +[ + { + inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + } + { + inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; + } + { inherit b d; } + { + inherit b d # e + ; + } + { + inherit b # c + d; + } + { + inherit b # c + d # e + ; + } + { + inherit # a + b d; + } + { + inherit # a + b d # e + ; + } + { + inherit # a + b # c + d; + } + { + inherit # a + b # c + d # e + ; + } + { + inherit # test + a # test + + b # test + c # test + d # test + + e f + + g h; + } +] diff --git a/test/diff/inherit_blank_trailing/in.nix b/test/diff/inherit_blank_trailing/in.nix new file mode 100644 index 00000000..a4c6f1aa --- /dev/null +++ b/test/diff/inherit_blank_trailing/in.nix @@ -0,0 +1,34 @@ +[ + { + inherit # test + a # test + + b # test + c # test + d # test + + e + f + + g + h + ; + } + { + inherit + a # mixed trivialities + + # comment 1 + # comment 2 + + # comment 3 after blanks + b # multiple newlines + + + c # multiple comments + # comment 1 + # comment 2 + # comment 3 + ; + } +] diff --git a/test/diff/inherit_blank_trailing/out.nix b/test/diff/inherit_blank_trailing/out.nix new file mode 100644 index 00000000..cac91152 --- /dev/null +++ b/test/diff/inherit_blank_trailing/out.nix @@ -0,0 +1,29 @@ +[ + { + inherit # test + a # test + + b # test + c # test + d # test + + e f + + g h; + } + { + inherit a # mixed trivialities + + # comment 1 + # comment 2 + + # comment 3 after blanks + b # multiple newlines + + c # multiple comments + # comment 1 + # comment 2 + # comment 3 + ; + } +] diff --git a/test/diff/inherit_comment/in.nix b/test/diff/inherit_comment/in.nix new file mode 100644 index 00000000..45c2bb99 --- /dev/null +++ b/test/diff/inherit_comment/in.nix @@ -0,0 +1,18 @@ +{ + inherit # eeby deeby + a + # b + c + ; + + # https://github.com/kamadorueda/alejandra/issues/372 + inherit (pkgs.haskell.lib) + # doJailbreak - remove package bounds from build-depends of a package + doJailbreak + # dontCheck - skip tests + dontCheck + # override deps of a package + # see what can be overriden - https://github.com/NixOS/nixpkgs/blob/0ba44a03f620806a2558a699dba143e6cf9858db/pkgs/development/haskell-modules/generic-builder.nix#L13 + overrideCabal + ; +} diff --git a/test/diff/inherit_comment/out.nix b/test/diff/inherit_comment/out.nix new file mode 100644 index 00000000..83721a44 --- /dev/null +++ b/test/diff/inherit_comment/out.nix @@ -0,0 +1,16 @@ +{ + inherit # eeby deeby + a + # b + c; + + # https://github.com/kamadorueda/alejandra/issues/372 + inherit (pkgs.haskell.lib) + # doJailbreak - remove package bounds from build-depends of a package + doJailbreak + # dontCheck - skip tests + dontCheck + # override deps of a package + # see what can be overriden - https://github.com/NixOS/nixpkgs/blob/0ba44a03f620806a2558a699dba143e6cf9858db/pkgs/development/haskell-modules/generic-builder.nix#L13 + overrideCabal; +} diff --git a/test/diff/inherit_from/in.nix b/test/diff/inherit_from/in.nix new file mode 100644 index 00000000..691cf365 --- /dev/null +++ b/test/diff/inherit_from/in.nix @@ -0,0 +1,66 @@ +[ + { inherit ( c ) f h ; } + { inherit ( c ) f h /*i*/; } + { inherit ( c ) f /*g*/ h ; } + { inherit ( c ) f /*g*/ h /*i*/; } + { inherit ( c ) /*e*/ f h ; } + { inherit ( c ) /*e*/ f h /*i*/; } + { inherit ( c ) /*e*/ f /*g*/ h ; } + { inherit ( c ) /*e*/ f /*g*/ h /*i*/; } + { inherit ( c /*d*/) f h ; } + { inherit ( c /*d*/) f h /*i*/; } + { inherit ( c /*d*/) f /*g*/ h ; } + { inherit ( c /*d*/) f /*g*/ h /*i*/; } + { inherit ( c /*d*/) /*e*/ f h ; } + { inherit ( c /*d*/) /*e*/ f h /*i*/; } + { inherit ( c /*d*/) /*e*/ f /*g*/ h ; } + { inherit ( c /*d*/) /*e*/ f /*g*/ h /*i*/; } + { inherit (/*b*/ c ) f h ; } + { inherit (/*b*/ c ) f h /*i*/; } + { inherit (/*b*/ c ) f /*g*/ h ; } + { inherit (/*b*/ c ) f /*g*/ h /*i*/; } + { inherit (/*b*/ c ) /*e*/ f h ; } + { inherit (/*b*/ c ) /*e*/ f h /*i*/; } + { inherit (/*b*/ c ) /*e*/ f /*g*/ h ; } + { inherit (/*b*/ c ) /*e*/ f /*g*/ h /*i*/; } + { inherit (/*b*/ c /*d*/) f h ; } + { inherit (/*b*/ c /*d*/) f h /*i*/; } + { inherit (/*b*/ c /*d*/) f /*g*/ h ; } + { inherit (/*b*/ c /*d*/) f /*g*/ h /*i*/; } + { inherit (/*b*/ c /*d*/) /*e*/ f h ; } + { inherit (/*b*/ c /*d*/) /*e*/ f h /*i*/; } + { inherit (/*b*/ c /*d*/) /*e*/ f /*g*/ h ; } + { inherit (/*b*/ c /*d*/) /*e*/ f /*g*/ h /*i*/; } + { inherit /*a*/ ( c ) f h ; } + { inherit /*a*/ ( c ) f h /*i*/; } + { inherit /*a*/ ( c ) f /*g*/ h ; } + { inherit /*a*/ ( c ) f /*g*/ h /*i*/; } + { inherit /*a*/ ( c ) /*e*/ f h ; } + { inherit /*a*/ ( c ) /*e*/ f h /*i*/; } + { inherit /*a*/ ( c ) /*e*/ f /*g*/ h ; } + { inherit /*a*/ ( c ) /*e*/ f /*g*/ h /*i*/; } + { inherit /*a*/ ( c /*d*/) f h ; } + { inherit /*a*/ ( c /*d*/) f h /*i*/; } + { inherit /*a*/ ( c /*d*/) f /*g*/ h ; } + { inherit /*a*/ ( c /*d*/) f /*g*/ h /*i*/; } + { inherit /*a*/ ( c /*d*/) /*e*/ f h ; } + { inherit /*a*/ ( c /*d*/) /*e*/ f h /*i*/; } + { inherit /*a*/ ( c /*d*/) /*e*/ f /*g*/ h ; } + { inherit /*a*/ ( c /*d*/) /*e*/ f /*g*/ h /*i*/; } + { inherit /*a*/ (/*b*/ c ) f h ; } + { inherit /*a*/ (/*b*/ c ) f h /*i*/; } + { inherit /*a*/ (/*b*/ c ) f /*g*/ h ; } + { inherit /*a*/ (/*b*/ c ) f /*g*/ h /*i*/; } + { inherit /*a*/ (/*b*/ c ) /*e*/ f h ; } + { inherit /*a*/ (/*b*/ c ) /*e*/ f h /*i*/; } + { inherit /*a*/ (/*b*/ c ) /*e*/ f /*g*/ h ; } + { inherit /*a*/ (/*b*/ c ) /*e*/ f /*g*/ h /*i*/; } + { inherit /*a*/ (/*b*/ c /*d*/) f h ; } + { inherit /*a*/ (/*b*/ c /*d*/) f h /*i*/; } + { inherit /*a*/ (/*b*/ c /*d*/) f /*g*/ h ; } + { inherit /*a*/ (/*b*/ c /*d*/) f /*g*/ h /*i*/; } + { inherit /*a*/ (/*b*/ c /*d*/) /*e*/ f h ; } + { inherit /*a*/ (/*b*/ c /*d*/) /*e*/ f h /*i*/; } + { inherit /*a*/ (/*b*/ c /*d*/) /*e*/ f /*g*/ h ; } + { inherit /*a*/ (/*b*/ c /*d*/) /*e*/ f /*g*/ h /*i*/; } +] diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix new file mode 100644 index 00000000..449e9f13 --- /dev/null +++ b/test/diff/inherit_from/out.nix @@ -0,0 +1,414 @@ +[ + { inherit (c) f h; } + { + inherit (c) f h # i + ; + } + { + inherit (c) + f # g + h; + } + { + inherit (c) + f # g + h # i + ; + } + { + inherit (c) # e + f h; + } + { + inherit (c) # e + f h # i + ; + } + { + inherit (c) # e + f # g + h; + } + { + inherit (c) # e + f # g + h # i + ; + } + { + inherit (c # d + ) + f h; + } + { + inherit (c # d + ) + f h # i + ; + } + { + inherit (c # d + ) + f # g + h; + } + { + inherit (c # d + ) + f # g + h # i + ; + } + { + inherit (c # d + ) # e + f h; + } + { + inherit (c # d + ) # e + f h # i + ; + } + { + inherit (c # d + ) # e + f # g + h; + } + { + inherit (c # d + ) # e + f # g + h # i + ; + } + { + inherit ( # b + c) + f h; + } + { + inherit ( # b + c) + f h # i + ; + } + { + inherit ( # b + c) + f # g + h; + } + { + inherit ( # b + c) + f # g + h # i + ; + } + { + inherit ( # b + c) # e + f h; + } + { + inherit ( # b + c) # e + f h # i + ; + } + { + inherit ( # b + c) # e + f # g + h; + } + { + inherit ( # b + c) # e + f # g + h # i + ; + } + { + inherit ( # b + c # d + ) + f h; + } + { + inherit ( # b + c # d + ) + f h # i + ; + } + { + inherit ( # b + c # d + ) + f # g + h; + } + { + inherit ( # b + c # d + ) + f # g + h # i + ; + } + { + inherit ( # b + c # d + ) # e + f h; + } + { + inherit ( # b + c # d + ) # e + f h # i + ; + } + { + inherit ( # b + c # d + ) # e + f # g + h; + } + { + inherit ( # b + c # d + ) # e + f # g + h # i + ; + } + { + inherit # a + (c) + f h; + } + { + inherit # a + (c) + f h # i + ; + } + { + inherit # a + (c) + f # g + h; + } + { + inherit # a + (c) + f # g + h # i + ; + } + { + inherit # a + (c) # e + f h; + } + { + inherit # a + (c) # e + f h # i + ; + } + { + inherit # a + (c) # e + f # g + h; + } + { + inherit # a + (c) # e + f # g + h # i + ; + } + { + inherit # a + (c # d + ) + f h; + } + { + inherit # a + (c # d + ) + f h # i + ; + } + { + inherit # a + (c # d + ) + f # g + h; + } + { + inherit # a + (c # d + ) + f # g + h # i + ; + } + { + inherit # a + (c # d + ) # e + f h; + } + { + inherit # a + (c # d + ) # e + f h # i + ; + } + { + inherit # a + (c # d + ) # e + f # g + h; + } + { + inherit # a + (c # d + ) # e + f # g + h # i + ; + } + { + inherit # a + ( # b + c) + f h; + } + { + inherit # a + ( # b + c) + f h # i + ; + } + { + inherit # a + ( # b + c) + f # g + h; + } + { + inherit # a + ( # b + c) + f # g + h # i + ; + } + { + inherit # a + ( # b + c) # e + f h; + } + { + inherit # a + ( # b + c) # e + f h # i + ; + } + { + inherit # a + ( # b + c) # e + f # g + h; + } + { + inherit # a + ( # b + c) # e + f # g + h # i + ; + } + { + inherit # a + ( # b + c # d + ) + f h; + } + { + inherit # a + ( # b + c # d + ) + f h # i + ; + } + { + inherit # a + ( # b + c # d + ) + f # g + h; + } + { + inherit # a + ( # b + c # d + ) + f # g + h # i + ; + } + { + inherit # a + ( # b + c # d + ) # e + f h; + } + { + inherit # a + ( # b + c # d + ) # e + f h # i + ; + } + { + inherit # a + ( # b + c # d + ) # e + f # g + h; + } + { + inherit # a + ( # b + c # d + ) # e + f # g + h # i + ; + } +] diff --git a/test/diff/key_value/in.nix b/test/diff/key_value/in.nix new file mode 100644 index 00000000..1b58a060 --- /dev/null +++ b/test/diff/key_value/in.nix @@ -0,0 +1,40 @@ +rec /**/ { + + a = (((4))); + a = (((a: b))); + + a = {a = 1 ;}; + + + b = {a = 1/*d*/;}; + + + c = {a =/*c*/1 ;}; + d = {a =/*c*/1/*d*/;}; + e = {a/*b*/= 1 ;}; + f = {a/*b*/= 1/*d*/;}; + h = {a/*b*/=/*c*/1 ;}; + i = {a/*b*/=/*c*/1/*d*/;}; + j = a: { b = 1 ;}; + k = a: { b = 1; c = 2;}; + l = a: /*b*/ { b = 1 ;}; + m = a: /*b*/ { b = 1; c = 2;}; + n = pkgs: { }; + o = { pkgs + , ... + }: { }; + + a + /*b*/ + = + /*c*/ + 1 + /*d*/ + ; + + p = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } + a; + + +} diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix new file mode 100644 index 00000000..81fa1d75 --- /dev/null +++ b/test/diff/key_value/out.nix @@ -0,0 +1,70 @@ +rec { + + a = (((4))); + a = (((a: b))); + + a = { a = 1; }; + + b = { + a = 1 # d + ; + }; + + c = { + a = # c + 1; + }; + d = { + a = # c + 1 # d + ; + }; + e = { + a # b + = 1; + }; + f = { + a # b + = 1 # d + ; + }; + h = { + a # b + = # c + 1; + }; + i = { + a # b + = # c + 1 # d + ; + }; + j = a: { b = 1; }; + k = a: { + b = 1; + c = 2; + }; + l = a: # b + { + b = 1; + }; + m = a: # b + { + b = 1; + c = 2; + }; + n = pkgs: { }; + o = { pkgs, ... }: { }; + + a + # b + = + # c + 1 + # d + ; + + p = + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a; + +} diff --git a/test/diff/lambda/in.nix b/test/diff/lambda/in.nix new file mode 100644 index 00000000..3711558b --- /dev/null +++ b/test/diff/lambda/in.nix @@ -0,0 +1,36 @@ +[ + (a: b: /*c*/ d) + ({}: b: /*c*/ d) + (a: {}: /*c*/ d) + (a : d) + (a : /*c*/ d) + (a /*b*/ : d) + (a /*b*/ : /*c*/ d) + ( + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ) + ( + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ) + ({ pkgs ? import ./.. { }, locationsXml }: null) + (a: b: c: + { }: + a: b: c: + a) + + ({pkgs, ...}: { + # Stuff + }) + + ({pkgs, ...}: let + in pkgs) + + (a: {b, + ...}: c: { + # Stuff + }) + + (a: {b, c, + ...}: d: { + # Stuff + }) +] diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix new file mode 100644 index 00000000..7ba1d670 --- /dev/null +++ b/test/diff/lambda/out.nix @@ -0,0 +1,45 @@ +[ + (a: b: # c + d) + ({ }: + b: # c + d) + (a: + { }: # c + d) + (a: d) + (a: # c + d) + (a # b + : + d) + (a # b + : # c + d) + (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) + ({ pkgs ? import ./.. { }, locationsXml }: null) + (a: b: c: { }: a: b: c: a) + + ({ pkgs, ... }: + { + # Stuff + }) + + ({ pkgs, ... }: let in pkgs) + + (a: + { b, ... }: + c: + { + # Stuff + }) + + (a: + { b, c, ... }: + d: + { + # Stuff + }) +] diff --git a/test/diff/let_in/in.nix b/test/diff/let_in/in.nix new file mode 100644 index 00000000..6f80d6f7 --- /dev/null +++ b/test/diff/let_in/in.nix @@ -0,0 +1,40 @@ +let + + + /**/ + a = let b=2; c=3; in d; + /**/ + a = let c=1; in f; + + + /**/ + a = let c=1; in /*e*/ f; + /**/ + a = let c=1; /*d*/ in f; + /**/ + + + a = let c=1; /*d*/ in /*e*/ f; + /**/ + a = let /*b*/ c=1; in f; + /**/ + a = let /*b*/ c=1; in /*e*/ f; + /**/ + a = let /*b*/ c=1; /*d*/ in f; + /**/ + a = let /*b*/ c=1; /*d*/ in /*e*/ f; + /**/ + + a = let + in [ + 1 + 2 + ]; + +in + + +/**/ + + +a diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix new file mode 100644 index 00000000..65cc06c0 --- /dev/null +++ b/test/diff/let_in/out.nix @@ -0,0 +1,37 @@ +let + + a = let + b = 2; + c = 3; + in d; + a = let c = 1; in f; + + a = let + c = 1; + # e + in f; + a = let c = 1; # d + in f; + + a = let + c = 1; # d + # e + in f; + a = let # b + c = 1; + in f; + a = let # b + c = 1; + # e + in f; + a = let # b + c = 1; # d + in f; + a = let # b + c = 1; # d + # e + in f; + + a = let in [ 1 2 ]; + +in a diff --git a/test/diff/lists/in.nix b/test/diff/lists/in.nix new file mode 100644 index 00000000..bf96dfb4 --- /dev/null +++ b/test/diff/lists/in.nix @@ -0,0 +1,46 @@ +[ + [ 1 ] + + [ 1 + ] + + [ b d ] + [ b d /*e*/ ] + [ b /*c*/ d ] + [ b /*c*/ d /*e*/ ] + [ /*a*/ b d ] + [ /*a*/ b d /*e*/ ] + [ /*a*/ b /*c*/ d ] + [ /*a*/ b /*c*/ d /*e*/ ] + + [ + + + b + + + d + + + ] + [ + + + /*a*/ + + + b + + + /*c*/ + + + d + + + /*e*/ + + + ] + +] diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix new file mode 100644 index 00000000..173cace2 --- /dev/null +++ b/test/diff/lists/out.nix @@ -0,0 +1,57 @@ +[ + [ 1 ] + + [ 1 ] + + [ b d ] + [ + b + d # e + ] + [ + b # c + d + ] + [ + b # c + d # e + ] + [ # a + b + d + ] + [ # a + b + d # e + ] + [ # a + b # c + d + ] + [ # a + b # c + d # e + ] + + [ + + b + + d + + ] + [ + + # a + + b + + # c + + d + + # e + + ] + +] diff --git a/test/diff/monsters_1/in.nix b/test/diff/monsters_1/in.nix new file mode 100644 index 00000000..2759c4b5 --- /dev/null +++ b/test/diff/monsters_1/in.nix @@ -0,0 +1,269 @@ +{ +# foo +stdenv +# foo +, +# foo +lib +# foo +, +# foo +fetchFromGitLab +# foo +, +# foo +cairo +# foo +, +# foo +desktop-file-utils +# foo +, +# foo +gettext +# foo +, +# foo +glib +# foo +, +# foo +gtk4 +# foo +, +# foo +libadwaita +# foo +, +# foo +meson +# foo +, +# foo +ninja +# foo +, +# foo +pango +# foo +, +# foo +pkg-config +# foo +, +# foo +python3 +# foo +, +# foo +rustPlatform +# foo +, +# foo +wrapGAppsHook4 +# foo +}: +# foo +stdenv.mkDerivation +# foo +rec +# foo +{ +# foo +pname +# foo += +# foo +"contrast"; +# foo +version +# foo += +# foo +"0.0.5"; +# foo +src +# foo += +# foo +fetchFromGitLab +# foo +{ +# foo +domain +# foo += +# foo +"gitlab.gnome.org"; +# foo +group +# foo += +# foo +"World"; +# foo +owner +# foo += +# foo +"design"; +# foo +repo +# foo += +# foo +"contrast"; +# foo +rev +# foo += +# foo +version; +# foo +sha256 +# foo += +# foo +"cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; +# foo +}; +# foo +cargoDeps +# foo += +# foo +rustPlatform.fetchCargoTarball +# foo +{ +# foo +inherit +# foo +src; +# foo +name +# foo += +# foo +"${pname}-${version}"; +# foo +hash +# foo += +# foo +"sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; +# foo +}; +# foo +nativeBuildInputs +# foo += +# foo +[ +# foo +desktop-file-utils +# foo +gettext +# foo +meson +# foo +ninja +# foo +pkg-config +# foo +python3 +# foo +rustPlatform.rust.cargo +# foo +rustPlatform.cargoSetupHook +# foo +rustPlatform.rust.rustc +# foo +wrapGAppsHook4 +# foo +glib +# foo +# for glib-compile-resources + +# foo +]; +# foo +buildInputs +# foo += +# foo +[ +# foo +cairo +# foo +glib +# foo +gtk4 +# foo +libadwaita +# foo +pango +# foo +]; +# foo +postPatch +# foo += +# foo +'' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; +# foo +meta +# foo += +# foo +with +# foo +lib; +# foo +{ +# foo +description +# foo += +# foo +"Checks whether the contrast between two colors meet the WCAG requirements"; +# foo +homepage +# foo += +# foo +"https://gitlab.gnome.org/World/design/contrast"; +# foo +license +# foo += +# foo +licenses.gpl3Plus; +# foo +maintainers +# foo += +# foo +with +# foo +maintainers; +# foo +[ +# foo +jtojnar +# foo +]; +# foo +platforms +# foo += +# foo +platforms.unix; +# foo +}; +# foo +} diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix new file mode 100644 index 00000000..65b0817a --- /dev/null +++ b/test/diff/monsters_1/out.nix @@ -0,0 +1,269 @@ +{ +# foo +stdenv +# foo +, +# foo +lib +# foo +, +# foo +fetchFromGitLab +# foo +, +# foo +cairo +# foo +, +# foo +desktop-file-utils +# foo +, +# foo +gettext +# foo +, +# foo +glib +# foo +, +# foo +gtk4 +# foo +, +# foo +libadwaita +# foo +, +# foo +meson +# foo +, +# foo +ninja +# foo +, +# foo +pango +# foo +, +# foo +pkg-config +# foo +, +# foo +python3 +# foo +, +# foo +rustPlatform +# foo +, +# foo +wrapGAppsHook4 +# foo +}: +# foo +stdenv.mkDerivation +# foo +rec +# foo +{ + # foo + pname + # foo + = + # foo + "contrast"; + # foo + version + # foo + = + # foo + "0.0.5"; + # foo + src + # foo + = + # foo + fetchFromGitLab + # foo + { + # foo + domain + # foo + = + # foo + "gitlab.gnome.org"; + # foo + group + # foo + = + # foo + "World"; + # foo + owner + # foo + = + # foo + "design"; + # foo + repo + # foo + = + # foo + "contrast"; + # foo + rev + # foo + = + # foo + version; + # foo + sha256 + # foo + = + # foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; + # foo + }; + # foo + cargoDeps + # foo + = + # foo + rustPlatform.fetchCargoTarball + # foo + { + # foo + inherit + # foo + src; + # foo + name + # foo + = + # foo + "${pname}-${version}"; + # foo + hash + # foo + = + # foo + "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; + # foo + }; + # foo + nativeBuildInputs + # foo + = + # foo + [ + # foo + desktop-file-utils + # foo + gettext + # foo + meson + # foo + ninja + # foo + pkg-config + # foo + python3 + # foo + rustPlatform.rust.cargo + # foo + rustPlatform.cargoSetupHook + # foo + rustPlatform.rust.rustc + # foo + wrapGAppsHook4 + # foo + glib + # foo + # for glib-compile-resources + + # foo + ]; + # foo + buildInputs + # foo + = + # foo + [ + # foo + cairo + # foo + glib + # foo + gtk4 + # foo + libadwaita + # foo + pango + # foo + ]; + # foo + postPatch + # foo + = + # foo + '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; + # foo + meta + # foo + = + # foo + with + # foo + lib; + # foo + { + # foo + description + # foo + = + # foo + "Checks whether the contrast between two colors meet the WCAG requirements"; + # foo + homepage + # foo + = + # foo + "https://gitlab.gnome.org/World/design/contrast"; + # foo + license + # foo + = + # foo + licenses.gpl3Plus; + # foo + maintainers + # foo + = + # foo + with + # foo + maintainers; + # foo + [ + # foo + jtojnar + # foo + ]; + # foo + platforms + # foo + = + # foo + platforms.unix; + # foo + }; + # foo +} diff --git a/test/diff/monsters_2/in.nix b/test/diff/monsters_2/in.nix new file mode 100644 index 00000000..c108b1a4 --- /dev/null +++ b/test/diff/monsters_2/in.nix @@ -0,0 +1,31 @@ + +{ + lib = { + + /* Concatenate two lists + + Type: concat :: [a] -> [a] -> [a] + + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] + */ + concat = x: y: x ++ y; + }; + + options = { + + boot.kernel.features = mkOption { + default = {}; + example = literalExpression "{ debug = true; }"; + internal = true; + description = '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; + }; +} diff --git a/test/diff/monsters_2/out.nix b/test/diff/monsters_2/out.nix new file mode 100644 index 00000000..09f521f8 --- /dev/null +++ b/test/diff/monsters_2/out.nix @@ -0,0 +1,30 @@ +{ + lib = { + + /* Concatenate two lists + + Type: concat :: [a] -> [a] -> [a] + + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] + */ + concat = x: y: x ++ y; + }; + + options = { + + boot.kernel.features = mkOption { + default = { }; + example = literalExpression "{ debug = true; }"; + internal = true; + description = '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; + }; +} diff --git a/test/diff/monsters_3/in.nix b/test/diff/monsters_3/in.nix new file mode 100644 index 00000000..5c09b5a7 --- /dev/null +++ b/test/diff/monsters_3/in.nix @@ -0,0 +1,7 @@ +{ stdenv , lib , fetchFromGitLab , cairo , desktop-file-utils , gettext , glib , gtk4 , libadwaita , meson , ninja , pango , pkg-config , python3 , rustPlatform , wrapGAppsHook4 }: stdenv.mkDerivation rec { pname = "contrast"; version = "0.0.5"; src = fetchFromGitLab { domain = "gitlab.gnome.org"; group = "World"; owner = "design"; repo = "contrast"; rev = version; sha256 = "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; }; cargoDeps = rustPlatform.fetchCargoTarball { inherit src; name = "${pname}-${version}"; hash = "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; }; nativeBuildInputs = [ desktop-file-utils gettext meson ninja pkg-config python3 rustPlatform.rust.cargo rustPlatform.cargoSetupHook rustPlatform.rust.rustc wrapGAppsHook4 glib # for glib-compile-resources + ]; buildInputs = [ cairo glib gtk4 libadwaita pango ]; postPatch = '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; meta = with lib; { description = "Checks whether the contrast between two colors meet the WCAG requirements"; homepage = "https://gitlab.gnome.org/World/design/contrast"; license = licenses.gpl3Plus; maintainers = with maintainers; [ jtojnar ]; platforms = platforms.unix; }; } diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix new file mode 100644 index 00000000..daf77bf8 --- /dev/null +++ b/test/diff/monsters_3/out.nix @@ -0,0 +1,48 @@ +{ stdenv, lib, fetchFromGitLab, cairo, desktop-file-utils, gettext, glib, gtk4 +, libadwaita, meson, ninja, pango, pkg-config, python3, rustPlatform +, wrapGAppsHook4 }: +stdenv.mkDerivation rec { + pname = "contrast"; + version = "0.0.5"; + src = fetchFromGitLab { + domain = "gitlab.gnome.org"; + group = "World"; + owner = "design"; + repo = "contrast"; + rev = version; + sha256 = "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; + }; + cargoDeps = rustPlatform.fetchCargoTarball { + inherit src; + name = "${pname}-${version}"; + hash = "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; + }; + nativeBuildInputs = [ + desktop-file-utils + gettext + meson + ninja + pkg-config + python3 + rustPlatform.rust.cargo + rustPlatform.cargoSetupHook + rustPlatform.rust.rustc + wrapGAppsHook4 + glib # for glib-compile-resources + ]; + buildInputs = [ cairo glib gtk4 libadwaita pango ]; + postPatch = '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; + meta = with lib; { + description = + "Checks whether the contrast between two colors meet the WCAG requirements"; + homepage = "https://gitlab.gnome.org/World/design/contrast"; + license = licenses.gpl3Plus; + maintainers = with maintainers; [ jtojnar ]; + platforms = platforms.unix; + }; +} diff --git a/test/diff/monsters_4/in.nix b/test/diff/monsters_4/in.nix new file mode 100644 index 00000000..a48c8632 --- /dev/null +++ b/test/diff/monsters_4/in.nix @@ -0,0 +1,7 @@ +{/*Foo*/stdenv/*Foo*/,/*Foo*/lib/*Foo*/,/*Foo*/fetchFromGitLab/*Foo*/,/*Foo*/cairo/*Foo*/,/*Foo*/desktop-file-utils/*Foo*/,/*Foo*/gettext/*Foo*/,/*Foo*/glib/*Foo*/,/*Foo*/gtk4/*Foo*/,/*Foo*/libadwaita/*Foo*/,/*Foo*/meson/*Foo*/,/*Foo*/ninja/*Foo*/,/*Foo*/pango/*Foo*/,/*Foo*/pkg-config/*Foo*/,/*Foo*/python3/*Foo*/,/*Foo*/rustPlatform/*Foo*/,/*Foo*/wrapGAppsHook4/*Foo*/}:/*Foo*/stdenv.mkDerivation/*Foo*/rec/*Foo*/{/*Foo*/pname/*Foo*/=/*Foo*/"contrast";/*Foo*/version/*Foo*/=/*Foo*/"0.0.5";/*Foo*/src/*Foo*/=/*Foo*/fetchFromGitLab/*Foo*/{/*Foo*/domain/*Foo*/=/*Foo*/"gitlab.gnome.org";/*Foo*/group/*Foo*/=/*Foo*/"World";/*Foo*/owner/*Foo*/=/*Foo*/"design";/*Foo*/repo/*Foo*/=/*Foo*/"contrast";/*Foo*/rev/*Foo*/=/*Foo*/version;/*Foo*/sha256/*Foo*/=/*Foo*/"cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0=";/*Foo*/};/*Foo*/cargoDeps/*Foo*/=/*Foo*/rustPlatform.fetchCargoTarball/*Foo*/{/*Foo*/inherit/*Foo*/src;/*Foo*/name/*Foo*/=/*Foo*/"${pname}-${version}";/*Foo*/hash/*Foo*/=/*Foo*/"sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ=";/*Foo*/};/*Foo*/nativeBuildInputs/*Foo*/=/*Foo*/[/*Foo*/desktop-file-utils/*Foo*/gettext/*Foo*/meson/*Foo*/ninja/*Foo*/pkg-config/*Foo*/python3/*Foo*/rustPlatform.rust.cargo/*Foo*/rustPlatform.cargoSetupHook/*Foo*/rustPlatform.rust.rustc/*Foo*/wrapGAppsHook4/*Foo*/glib/*Foo*/# for glib-compile-resources +/*Foo*/];/*Foo*/buildInputs/*Foo*/=/*Foo*/[/*Foo*/cairo/*Foo*/glib/*Foo*/gtk4/*Foo*/libadwaita/*Foo*/pango/*Foo*/];/*Foo*/postPatch/*Foo*/=/*Foo*/'' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + '';/*Foo*/meta/*Foo*/=/*Foo*/with/*Foo*/lib;/*Foo*/{/*Foo*/description/*Foo*/=/*Foo*/"Checks whether the contrast between two colors meet the WCAG requirements";/*Foo*/homepage/*Foo*/=/*Foo*/"https://gitlab.gnome.org/World/design/contrast";/*Foo*/license/*Foo*/=/*Foo*/licenses.gpl3Plus;/*Foo*/maintainers/*Foo*/=/*Foo*/with/*Foo*/maintainers;/*Foo*/[/*Foo*/jtojnar/*Foo*/];/*Foo*/platforms/*Foo*/=/*Foo*/platforms.unix;/*Foo*/};/*Foo*/} diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix new file mode 100644 index 00000000..e1d1c452 --- /dev/null +++ b/test/diff/monsters_4/out.nix @@ -0,0 +1,137 @@ +{ # Foo +stdenv # Foo +, # Foo +lib # Foo +, # Foo +fetchFromGitLab # Foo +, # Foo +cairo # Foo +, # Foo +desktop-file-utils # Foo +, # Foo +gettext # Foo +, # Foo +glib # Foo +, # Foo +gtk4 # Foo +, # Foo +libadwaita # Foo +, # Foo +meson # Foo +, # Foo +ninja # Foo +, # Foo +pango # Foo +, # Foo +pkg-config # Foo +, # Foo +python3 # Foo +, # Foo +rustPlatform # Foo +, # Foo +wrapGAppsHook4 # Foo +}: # Foo +stdenv.mkDerivation # Foo +rec # Foo +{ # Foo + pname # Foo + = # Foo + "contrast"; # Foo + version # Foo + = # Foo + "0.0.5"; # Foo + src # Foo + = # Foo + fetchFromGitLab # Foo + { # Foo + domain # Foo + = # Foo + "gitlab.gnome.org"; # Foo + group # Foo + = # Foo + "World"; # Foo + owner # Foo + = # Foo + "design"; # Foo + repo # Foo + = # Foo + "contrast"; # Foo + rev # Foo + = # Foo + version; # Foo + sha256 # Foo + = # Foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo + }; # Foo + cargoDeps # Foo + = # Foo + rustPlatform.fetchCargoTarball # Foo + { # Foo + inherit # Foo + src; # Foo + name # Foo + = # Foo + "${pname}-${version}"; # Foo + hash # Foo + = # Foo + "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo + }; # Foo + nativeBuildInputs # Foo + = # Foo + [ # Foo + desktop-file-utils # Foo + gettext # Foo + meson # Foo + ninja # Foo + pkg-config # Foo + python3 # Foo + rustPlatform.rust.cargo # Foo + rustPlatform.cargoSetupHook # Foo + rustPlatform.rust.rustc # Foo + wrapGAppsHook4 # Foo + glib # Foo for glib-compile-resources + # Foo + ]; # Foo + buildInputs # Foo + = # Foo + [ # Foo + cairo # Foo + glib # Foo + gtk4 # Foo + libadwaita # Foo + pango # Foo + ]; # Foo + postPatch # Foo + = # Foo + '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; # Foo + meta # Foo + = # Foo + with # Foo + lib; # Foo + { # Foo + description # Foo + = # Foo + "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo + homepage # Foo + = # Foo + "https://gitlab.gnome.org/World/design/contrast"; # Foo + license # Foo + = # Foo + licenses.gpl3Plus; # Foo + maintainers # Foo + = # Foo + with # Foo + maintainers; # Foo + [ # Foo + jtojnar # Foo + ]; # Foo + platforms # Foo + = # Foo + platforms.unix; # Foo + }; # Foo +} diff --git a/test/diff/monsters_5/in.nix b/test/diff/monsters_5/in.nix new file mode 100644 index 00000000..54ed1282 --- /dev/null +++ b/test/diff/monsters_5/in.nix @@ -0,0 +1,327 @@ +{ + +config, + +lib, + +pkgs, + +... + +}: + +with + +lib; + +let + + + + + +inherit + +(config.boot) + +kernelPatches; + + + + +inherit + +(config.boot.kernel) + +features + +randstructSeed; + + + + +inherit + +(config.boot.kernelPackages) + +kernel; + + + + + +kernelModulesConf + += + +pkgs.writeText + +"nixos.conf" + + + + + + + + +'' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; + +in + +{ + + + + + +###### interface + + + + + +options + += + +{ + + + + + + + + + +boot.kernel.features + += + +mkOption + +{ + + +default + += + +{}; + + +example + += + +literalExpression + +"{debug= true;}"; + + +internal + += + +true; + + +description + += + +'' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + + +}; + + + +boot.kernelPackages + += + +mkOption + +{ + + +default + += + +pkgs.linuxPackages; + + +type + += + +types.unspecified + +// + +{ + +merge + += + +mergeEqualOption; + +}; + + +apply + += + +kernelPackages: + +kernelPackages.extend + +(self: + +super: + +{ + + +kernel + += + +super.kernel.override + +(originalArgs: + +{ + + +inherit + +randstructSeed; + + +kernelPatches + += + +(originalArgs.kernelPatches + +or + +[]) + +++ + +kernelPatches; + + +features + += + +lib.recursiveUpdate + +super.kernel.features + +features; + + +}); + + +}); + + +# We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. + + +defaultText + += + +literalExpression + +"pkgs.linuxPackages"; + + +example + += + +literalExpression + +"pkgs.linuxKernel.packages.linux_5_10"; + + +description + += + +'' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + + +}; + + + +boot.kernelPatches + += + +mkOption + +{ + + +type + += + +types.listOf + +types.attrs; + + +default + += + +[]; + + +example + += + +literalExpression + +"[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + + +};} diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix new file mode 100644 index 00000000..a63065f0 --- /dev/null +++ b/test/diff/monsters_5/out.nix @@ -0,0 +1,262 @@ +{ + +config, + +lib, + +pkgs, + +... + +}: + +with + + lib; + +let + + inherit + + (config.boot) + + kernelPatches; + + inherit + + (config.boot.kernel) + + features + + randstructSeed; + + inherit + + (config.boot.kernelPackages) + + kernel; + + kernelModulesConf + + = + + pkgs.writeText + + "nixos.conf" + + '' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; + +in { + + ###### interface + + options + + = + + { + + boot.kernel.features + + = + + mkOption + + { + + default + + = + + { }; + + example + + = + + literalExpression + + "{debug= true;}"; + + internal + + = + + true; + + description + + = + + '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + + }; + + boot.kernelPackages + + = + + mkOption + + { + + default + + = + + pkgs.linuxPackages; + + type + + = + + types.unspecified + + // + + { + + merge + + = + + mergeEqualOption; + + }; + + apply + + = + + kernelPackages: + + kernelPackages.extend + + (self: + + super: + + { + + kernel + + = + + super.kernel.override + + (originalArgs: + + { + + inherit + + randstructSeed; + + kernelPatches + + = + + (originalArgs.kernelPatches + + or + + [ ]) + + ++ + + kernelPatches; + + features + + = + + lib.recursiveUpdate + + super.kernel.features + + features; + + }); + + }); + + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. + + defaultText + + = + + literalExpression + + "pkgs.linuxPackages"; + + example + + = + + literalExpression + + "pkgs.linuxKernel.packages.linux_5_10"; + + description + + = + + '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + + }; + + boot.kernelPatches + + = + + mkOption + + { + + type + + = + + types.listOf + + types.attrs; + + default + + = + + [ ]; + + example + + = + + literalExpression + + "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + + }; +} diff --git a/test/diff/or_default/in.nix b/test/diff/or_default/in.nix new file mode 100644 index 00000000..ee7b4ee5 --- /dev/null +++ b/test/diff/or_default/in.nix @@ -0,0 +1,14 @@ +[ + (a.b or c) + (a.b or/**/c) + (a.b/**/or c) + (a.b/**/or/**/c) + (a.b/**/or/**/(a.b/**/or/**/(a.b/**/or/**/c))) + (a.b/**/or/**/(a.b/**/or/**/(a.b/**/or/**/c))) + ( a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a ) + ( a.a or a.a # test + or a.a # test + or # test + a.a or + a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a) +] diff --git a/test/diff/or_default/out.nix b/test/diff/or_default/out.nix new file mode 100644 index 00000000..66fd5cfc --- /dev/null +++ b/test/diff/or_default/out.nix @@ -0,0 +1,13 @@ +[ + (a.b or c) + (a.b or c) + (a.b or c) + (a.b or c) + (a.b or (a.b or (a.b or c))) + (a.b or (a.b or (a.b or c))) + (a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a) + (a.a or a.a # test + or a.a # test + or # test + a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a) +] diff --git a/test/diff/paren/in.nix b/test/diff/paren/in.nix new file mode 100644 index 00000000..ec1b51d5 --- /dev/null +++ b/test/diff/paren/in.nix @@ -0,0 +1,21 @@ +( + ( # test + a # test + ) + ( ( c ) ) + ( ( c )/*e*/) + ( ( c/*d*/) ) + ( ( c/*d*/)/*e*/) + ( (/*b*/c ) ) + ( (/*b*/c )/*e*/) + ( (/*b*/c/*d*/) ) + ( (/*b*/c/*d*/)/*e*/) + (/*a*/( c ) ) + (/*a*/( c )/*e*/) + (/*a*/( c/*d*/) ) + (/*a*/( c/*d*/)/*e*/) + (/*a*/(/*b*/c ) ) + (/*a*/(/*b*/c )/*e*/) + (/*a*/(/*b*/c/*d*/) ) + (/*a*/(/*b*/c/*d*/)/*e*/) +) diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix new file mode 100644 index 00000000..2722d6bd --- /dev/null +++ b/test/diff/paren/out.nix @@ -0,0 +1,35 @@ +(( # test + a # test +) ((c)) ((c) # e +) ((c # d +)) ((c # d +) # e +) (( # b + c)) (( # b + c) # e + ) (( # b + c # d + )) (( # b + c # d + ) # e + ) ( # a + (c)) ( # a + (c) # e + ) ( # a + (c # d + )) ( # a + (c # d + ) # e + ) ( # a + ( # b + c)) ( # a + ( # b + c) # e + ) ( # a + ( # b + c # d + )) ( # a + ( # b + c # d + ) # e + )) diff --git a/test/diff/pat_bind/in.nix b/test/diff/pat_bind/in.nix new file mode 100644 index 00000000..e55187b0 --- /dev/null +++ b/test/diff/pat_bind/in.nix @@ -0,0 +1,11 @@ +[ + ({} @ a: _) + ({} @ /**/ a: _) + ({} /**/ @ a: _) + ({} /**/ @ /**/ a: _) + + (a @ {}: _) + (a @ /**/ {}: _) + (a /**/ @ {}: _) + (a /**/ @ /**/ {}: _) +] diff --git a/test/diff/pat_bind/out.nix b/test/diff/pat_bind/out.nix new file mode 100644 index 00000000..7105a893 --- /dev/null +++ b/test/diff/pat_bind/out.nix @@ -0,0 +1,11 @@ +[ + ({ }@a: _) + ({ }@a: _) + ({ }@a: _) + ({ }@a: _) + + (a@{ }: _) + (a@{ }: _) + (a@{ }: _) + (a@{ }: _) +] diff --git a/test/diff/pattern/in.nix b/test/diff/pattern/in.nix new file mode 100644 index 00000000..da418a4b --- /dev/null +++ b/test/diff/pattern/in.nix @@ -0,0 +1,144 @@ +[ + ({ foo + , bar + # Some comment + , baz + }: {}) + ({ foo + , bar # Some comment + }: {}) + (a@{ + self, + gomod2nix, + mach-nix, + }: _) + ({ + self, + gomod2nix, + mach-nix, + }@inp: _) + ({ + a ? [ + 1 + 2 + 3 + ], + b ? { + # ... + } + }: _) + ({}: _) + ({ a }: _) + ({ /**/ }: _) + ({ ... }: _) + ({ ... /**/}: _) + ({ /**/ ... }: _) + ({ /**/ ... /**/}: _) + + ({ b , e , ... }: _) + ({ b , e , ... /*h*/ }: _) + ({ b , e , /*g*/ ... }: _) + ({ b , e , /*g*/ ... /*h*/ }: _) + ({ b , e /*f*/ , ... }: _) + ({ b , e /*f*/ , ... /*h*/ }: _) + ({ b , e /*f*/ , /*g*/ ... }: _) + ({ b , e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ b , /*d*/ e , ... }: _) + ({ b , /*d*/ e , ... /*h*/ }: _) + ({ b , /*d*/ e , /*g*/ ... }: _) + ({ b , /*d*/ e , /*g*/ ... /*h*/ }: _) + ({ b , /*d*/ e /*f*/ , ... }: _) + ({ b , /*d*/ e /*f*/ , ... /*h*/ }: _) + ({ b , /*d*/ e /*f*/ , /*g*/ ... }: _) + ({ b , /*d*/ e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ b /*c*/ , e , ... }: _) + ({ b /*c*/ , e , ... /*h*/ }: _) + ({ b /*c*/ , e , /*g*/ ... }: _) + ({ b /*c*/ , e , /*g*/ ... /*h*/ }: _) + ({ b /*c*/ , e /*f*/ , ... }: _) + ({ b /*c*/ , e /*f*/ , ... /*h*/ }: _) + ({ b /*c*/ , e /*f*/ , /*g*/ ... }: _) + ({ b /*c*/ , e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ b /*c*/ , /*d*/ e , ... }: _) + ({ b /*c*/ , /*d*/ e , ... /*h*/ }: _) + ({ b /*c*/ , /*d*/ e , /*g*/ ... }: _) + ({ b /*c*/ , /*d*/ e , /*g*/ ... /*h*/ }: _) + ({ b /*c*/ , /*d*/ e /*f*/ , ... }: _) + ({ b /*c*/ , /*d*/ e /*f*/ , ... /*h*/ }: _) + ({ b /*c*/ , /*d*/ e /*f*/ , /*g*/ ... }: _) + ({ b /*c*/ , /*d*/ e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b , e , ... }: _) + ({ /*a*/ b , e , ... /*h*/ }: _) + ({ /*a*/ b , e , /*g*/ ... }: _) + ({ /*a*/ b , e , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b , e /*f*/ , ... }: _) + ({ /*a*/ b , e /*f*/ , ... /*h*/ }: _) + ({ /*a*/ b , e /*f*/ , /*g*/ ... }: _) + ({ /*a*/ b , e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b , /*d*/ e , ... }: _) + ({ /*a*/ b , /*d*/ e , ... /*h*/ }: _) + ({ /*a*/ b , /*d*/ e , /*g*/ ... }: _) + ({ /*a*/ b , /*d*/ e , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b , /*d*/ e /*f*/ , ... }: _) + ({ /*a*/ b , /*d*/ e /*f*/ , ... /*h*/ }: _) + ({ /*a*/ b , /*d*/ e /*f*/ , /*g*/ ... }: _) + ({ /*a*/ b , /*d*/ e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , e , ... }: _) + ({ /*a*/ b /*c*/ , e , ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , e , /*g*/ ... }: _) + ({ /*a*/ b /*c*/ , e , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , e /*f*/ , ... }: _) + ({ /*a*/ b /*c*/ , e /*f*/ , ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , e /*f*/ , /*g*/ ... }: _) + ({ /*a*/ b /*c*/ , e /*f*/ , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , /*d*/ e , ... }: _) + ({ /*a*/ b /*c*/ , /*d*/ e , ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , /*d*/ e , /*g*/ ... }: _) + ({ /*a*/ b /*c*/ , /*d*/ e , /*g*/ ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , /*d*/ e /*f*/ , ... }: _) + ({ /*a*/ b /*c*/ , /*d*/ e /*f*/ , ... /*h*/ }: _) + ({ /*a*/ b /*c*/ , /*d*/ e /*f*/ , /*g*/ ... }: _) + ({ /*a*/ b /*c*/ , /*d*/ e /*f*/ , /*g*/ ... /*h*/ }: _) + + ({ a ? null }: _) + ({ /*a*/ b /*a*/ ? /*a*/ null /*c*/ , /*d*/ e /*a*/ ? /*a*/ null /*f*/ , /*g*/ ... /*h*/ }: _) + + ({ + /*a*/ + # + b + /*a*/ + # + ? + /*a*/ + # + null + /*c*/ + # + , + /*d*/ + # + e + /*a*/ + # + ? + /*a*/ + # + null + /*f*/ + # + , + /*g*/ + # + ... + /*h*/ + # + } + /*i*/ + # + : + /*j*/ + # + _ + ) +] diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix new file mode 100644 index 00000000..23f5ebef --- /dev/null +++ b/test/diff/pattern/out.nix @@ -0,0 +1,394 @@ +[ + ({ foo, bar + # Some comment + , baz }: + { }) + ({ foo, bar # Some comment + }: + { }) + (a@{ self, gomod2nix, mach-nix, }: _) + ({ self, gomod2nix, mach-nix, }@inp: _) + ({ a ? [ 1 2 3 ], b ? { + # ... + } }: + _) + ({ }: _) + ({ a }: _) + ({ }: _) + ({ ... }: _) + ({ ... }: _) + ({ ... }: _) + ({ ... }: _) + + ({ b, e, ... }: _) + ({ b, e, ... # h + }: + _) + ({ b, e, # g + ... }: + _) + ({ b, e, # g + ... # h + }: + _) + ({ b, e # f + , ... }: + _) + ({ b, e # f + , ... # h + }: + _) + ({ b, e # f + , # g + ... }: + _) + ({ b, e # f + , # g + ... # h + }: + _) + ({ b, # d + e, ... }: + _) + ({ b, # d + e, ... # h + }: + _) + ({ b, # d + e, # g + ... }: + _) + ({ b, # d + e, # g + ... # h + }: + _) + ({ b, # d + e # f + , ... }: + _) + ({ b, # d + e # f + , ... # h + }: + _) + ({ b, # d + e # f + , # g + ... }: + _) + ({ b, # d + e # f + , # g + ... # h + }: + _) + ({ b # c + , e, ... }: + _) + ({ b # c + , e, ... # h + }: + _) + ({ b # c + , e, # g + ... }: + _) + ({ b # c + , e, # g + ... # h + }: + _) + ({ b # c + , e # f + , ... }: + _) + ({ b # c + , e # f + , ... # h + }: + _) + ({ b # c + , e # f + , # g + ... }: + _) + ({ b # c + , e # f + , # g + ... # h + }: + _) + ({ b # c + , # d + e, ... }: + _) + ({ b # c + , # d + e, ... # h + }: + _) + ({ b # c + , # d + e, # g + ... }: + _) + ({ b # c + , # d + e, # g + ... # h + }: + _) + ({ b # c + , # d + e # f + , ... }: + _) + ({ b # c + , # d + e # f + , ... # h + }: + _) + ({ b # c + , # d + e # f + , # g + ... }: + _) + ({ b # c + , # d + e # f + , # g + ... # h + }: + _) + ({ # a + b, e, ... }: + _) + ({ # a + b, e, ... # h + }: + _) + ({ # a + b, e, # g + ... }: + _) + ({ # a + b, e, # g + ... # h + }: + _) + ({ # a + b, e # f + , ... }: + _) + ({ # a + b, e # f + , ... # h + }: + _) + ({ # a + b, e # f + , # g + ... }: + _) + ({ # a + b, e # f + , # g + ... # h + }: + _) + ({ # a + b, # d + e, ... }: + _) + ({ # a + b, # d + e, ... # h + }: + _) + ({ # a + b, # d + e, # g + ... }: + _) + ({ # a + b, # d + e, # g + ... # h + }: + _) + ({ # a + b, # d + e # f + , ... }: + _) + ({ # a + b, # d + e # f + , ... # h + }: + _) + ({ # a + b, # d + e # f + , # g + ... }: + _) + ({ # a + b, # d + e # f + , # g + ... # h + }: + _) + ({ # a + b # c + , e, ... }: + _) + ({ # a + b # c + , e, ... # h + }: + _) + ({ # a + b # c + , e, # g + ... }: + _) + ({ # a + b # c + , e, # g + ... # h + }: + _) + ({ # a + b # c + , e # f + , ... }: + _) + ({ # a + b # c + , e # f + , ... # h + }: + _) + ({ # a + b # c + , e # f + , # g + ... }: + _) + ({ # a + b # c + , e # f + , # g + ... # h + }: + _) + ({ # a + b # c + , # d + e, ... }: + _) + ({ # a + b # c + , # d + e, ... # h + }: + _) + ({ # a + b # c + , # d + e, # g + ... }: + _) + ({ # a + b # c + , # d + e, # g + ... # h + }: + _) + ({ # a + b # c + , # d + e # f + , ... }: + _) + ({ # a + b # c + , # d + e # f + , ... # h + }: + _) + ({ # a + b # c + , # d + e # f + , # g + ... }: + _) + ({ # a + b # c + , # d + e # f + , # g + ... # h + }: + _) + + ({ a ? null }: _) + ({ # a + b # a + ? # a + null # c + , # d + e # a + ? # a + null # f + , # g + ... # h + }: + _) + + ({ + # a + # + b + # a + # + ? + # a + # + null + # c + # + , + # d + # + e + # a + # + ? + # a + # + null + # f + # + , + # g + # + ... + # h + # + } + # i + # + : + # j + # + _) +] diff --git a/test/diff/root/in.nix b/test/diff/root/in.nix new file mode 100644 index 00000000..cb913875 --- /dev/null +++ b/test/diff/root/in.nix @@ -0,0 +1,10 @@ +/* Some functions f + name attribute. + */ + /* Add to or over + derivation. + + Example: + addMetaAttrs {des + */ +1 diff --git a/test/diff/root/out.nix b/test/diff/root/out.nix new file mode 100644 index 00000000..1cadc1b6 --- /dev/null +++ b/test/diff/root/out.nix @@ -0,0 +1,10 @@ +/* Some functions f + name attribute. +*/ +/* Add to or over + derivation. + + Example: + addMetaAttrs {des +*/ +1 diff --git a/test/diff/select/in.nix b/test/diff/select/in.nix new file mode 100644 index 00000000..c66751e3 --- /dev/null +++ b/test/diff/select/in.nix @@ -0,0 +1,9 @@ +[ + (a . a) + (a ./**/a) + (a/**/. a) + (a/**/./**/a) + ( a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a ) + ( a.a + .a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a ) +] diff --git a/test/diff/select/out.nix b/test/diff/select/out.nix new file mode 100644 index 00000000..39c6e3da --- /dev/null +++ b/test/diff/select/out.nix @@ -0,0 +1,8 @@ +[ + (a.a) + (a.a) + (a.a) + (a.a) + (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) + (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) +] diff --git a/test/diff/string/in.nix b/test/diff/string/in.nix new file mode 100644 index 00000000..177facaa --- /dev/null +++ b/test/diff/string/in.nix @@ -0,0 +1,95 @@ +[ + '' + foo + bar +'' + "" +### + " + " +### + "a + ${x} + b + " +### + '''' +### + ''a'' +### + ''${""}'' +### + ''${""} + + '' +### + ''a + '' +### + ''a + + '' +### + '' a + '' +### + + ''a + '' +### + '' + a + ${""} + b + ${""} + c ${""} d + e + '' +### + '' + '' +### + '' + declare -a makefiles=(./*.mak) + sed -i -f ${makefile-sed} "''${makefiles[@]}" + ### assign Makefile variables eagerly & change backticks to `$(shell …)` + sed -i -e 's/ = `\([^`]\+\)`/ := $(shell \1)/' \ + -e 's/`\([^`]\+\)`/$(shell \1)/' \ + "''${makefiles[@]}" + '' +### + '' + [${ mkSectionName sectName }] + '' +### +''-couch_ini ${ cfg.package }/etc/default.ini ${ configFile } ${ pkgs.writeText "couchdb-extra.ini" cfg.extraConfig } ${ cfg.configFile }'' +### + ''exec i3-input -F "mark %s" -l 1 -P 'Mark: ' '' +### + ''exec i3-input -F '[con_mark="%s"] focus' -l 1 -P 'Go to: ' '' +### + ''"${ pkgs.name or "" }";'' +### + '' + ${pkgs.replace-secret}/bin/replace-secret '${placeholder}' '${secretFile}' '${targetFile}' '' +### +'' + mkdir -p "$out/lib/modules/${ kernel.modDirVersion }/kernel/net/wireless/" + '' +### + '' + + + ${ expr "" v } + '' + + '' + --${ + "test" + } + '' + + "--${ + "test" + }" +] diff --git a/test/diff/string/out.nix b/test/diff/string/out.nix new file mode 100644 index 00000000..4da864da --- /dev/null +++ b/test/diff/string/out.nix @@ -0,0 +1,93 @@ +[ + '' + foo +  bar + '' + "" + ### + "\n " + ### + "a\n ${x}\n b\n " + ### + "" + ### + "a" + ### + "${""}" + ### + '' + ${""} + + '' + ### + '' + a + '' + ### + '' + a + + '' + ### + '' + a + '' + ### + + '' + a + '' + ### + '' + a + ${""} + b + ${""} + c ${""} d + e + '' + ### + "" + ### + '' + declare -a makefiles=(./*.mak) + sed -i -f ${makefile-sed} "''${makefiles[@]}" + ### assign Makefile variables eagerly & change backticks to `$(shell …)` + sed -i -e 's/ = `\([^`]\+\)`/ := $(shell \1)/' \ + -e 's/`\([^`]\+\)`/$(shell \1)/' \ + "''${makefiles[@]}" + '' + ### + '' + [${mkSectionName sectName}] + '' + ### + "-couch_ini ${cfg.package}/etc/default.ini ${configFile} ${ + pkgs.writeText "couchdb-extra.ini" cfg.extraConfig + } ${cfg.configFile}" + ### + ''exec i3-input -F "mark %s" -l 1 -P 'Mark: ' '' + ### + ''exec i3-input -F '[con_mark="%s"] focus' -l 1 -P 'Go to: ' '' + ### + ''"${pkgs.name or ""}";'' + ### + "${pkgs.replace-secret}/bin/replace-secret '${placeholder}' '${secretFile}' '${targetFile}' " + ### + '' + mkdir -p "$out/lib/modules/${kernel.modDirVersion}/kernel/net/wireless/" + '' + ### + '' + + + + ${expr "" v} + '' + + '' + --${"test"} + '' + + "--${"test"}" +] diff --git a/test/diff/string_interpol/in.nix b/test/diff/string_interpol/in.nix new file mode 100644 index 00000000..29a7e92a --- /dev/null +++ b/test/diff/string_interpol/in.nix @@ -0,0 +1 @@ +"${/*a*/"${/*b*/"${c}"}"/*d*/}" diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix new file mode 100644 index 00000000..1b95d7b4 --- /dev/null +++ b/test/diff/string_interpol/out.nix @@ -0,0 +1,4 @@ +"${ # a +"${ # b +"${c}"}" # d +}" diff --git a/test/diff/with/in.nix b/test/diff/with/in.nix new file mode 100644 index 00000000..5c967140 --- /dev/null +++ b/test/diff/with/in.nix @@ -0,0 +1,34 @@ +[ + (with b; c) + (with b; /*b*/ c) + (with /*a*/ b; c) + (with /*a*/ b; /*b*/ c) + ( with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) + ( with b; + cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) + { a = with b; 1;} + { a = with b; 1 + 1;} + { a = with b; {c=1;};} + { a = with b; {c=1; d=2; e=3;};} + { a = with b; + # comment + 1; + } + { a = with b; + 1; + # comment + } + (with a; with b; with c; {a=1;}) + (with a; with b; with c; {a=1;b=2;}) + (with a; /* comment */ with b; with c; {a=1;b=2;}) + { a = with b;with b;with b; + 1; + } + { + binPath = + with pkgs; + makeBinPath ( + [ + rsync + util-linux]);} +] diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix new file mode 100644 index 00000000..a94e480c --- /dev/null +++ b/test/diff/with/out.nix @@ -0,0 +1,47 @@ +[ + (with b; c) + (with b; # b + c) + (with # a + b; + c) + (with # a + b; # b + c) + (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) + (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) + { a = with b; 1; } + { a = with b; 1 + 1; } + { a = with b; { c = 1; }; } + { + a = with b; { + c = 1; + d = 2; + e = 3; + }; + } + { + a = with b; + # comment + 1; + } + { + a = with b; 1; + # comment + } + (with a; with b; with c; { a = 1; }) + (with a; + with b; + with c; { + a = 1; + b = 2; + }) + (with a; # comment + with b; + with c; { + a = 1; + b = 2; + }) + { a = with b; with b; with b; 1; } + { binPath = with pkgs; makeBinPath ([ rsync util-linux ]); } +] diff --git a/test/dist-newstyle/cache/compiler b/test/dist-newstyle/cache/compiler new file mode 100644 index 0000000000000000000000000000000000000000..ac4874862e65fe737a8895c1ceb844f54ae32871 GIT binary patch literal 18340 zcmeHPNs}DMb zy?c|qUTj}|($PP_5&j*%IqV2U_&50MlfTTWmz})~9W$g(rXr+iPum0_mfBpSme{}et|MSoNcUk_Q3&v~3uP2*vIN9WbB=a__(=kuE6*tRKHXfzN z_N3SDO#^>|5<9NArXM(FXQRAPHOJu~FjLFvS-!_N?J(X1W*EQvm;d_r|G4*y3#9$W zn)b#t8%=s?aNLi>;}biyd*hQ55~Sz{QQAd=b4*d=y<5<_%iJ-)cr_P#~bxZHJ+8jS=a5>Cc(JwH?vl` zR_}NHlSyZW0U9`g7j@0@My0V)7Dg@9+}G5UM^W7LCr-z%j$ZB8eq~xNmn*GqyAw{NrWFl( zTPAUL(kb_9v#3+IVtYF3owO^XY*glLx5_6|(~m;iF{>N3hFNLWOyPO+Uj0yOi`#JO z6CSm!k$>V$TIF=y?nkp)lvc`ay*+K24qSdX2qO-cu4qag=t{WdXMMXiZq?hzQ(hkX z(J1S-8cjaV%I%;b>d$qMebBOwrc7^9SZj}477rZw{H#6;Dq-87*>=ropjoZTWUg#U ziQXcoXIK1gQ0t!5I+d{5_Pbf^q~SQSFyyV)u^BtVjCCC96Ra64V+mPwmT=CN?@OsDo41mz-%w(>G1+{-_g`r`4ct zwX<2kTm43>SqrN@C-mDDlf$(m__x!8s`f^C$r<#S61G~kz_O-MHXFOa%!=Yk+^C4x2I zt_HT!l<1SB+Rn<;%CysuTg^()JC3T=Mt@wL^|GnkIkB3i9}l_bn)L+@-`6bTccM10 zc6+tf_@sK`^d~3XQE)P9*Xq`^YNunN!Oy%D1E!C>-iT=0nDv6R?v^W#Uw2%8V)xSW zNwpQ#;#wIa?_1-Z*}!n?Q$ue=r^d&2IH`3T=}CFkj>mC%=FX}-?sZSnb_xxc85RP@ zMomWZBJgyye#FPE#>lo&C->7Z4H}ivY}|;O;mCD5Qy<}C7N$^8scNRwhqXEy$Nj8a zp84JJxY}zvCr*cRn~z+-4Zr554Fy$bfPXA`hu)Q_6_$^W`-slHiqnfbfs-|Q$F|)Y zjnZys%0*ZDR?owb)U=l9tAp#-T9sPA-yWYt^{nbPjwh3Hx6$@1&A8jI2d0gQFYIZi zm8PacZ$@+6XjOw&r&>RWr=xDGJ&P*!k;NMox9ykv?L3?#_O&*26?!wAdMj>rWA2W4 za~7n%jul6C+6fx9>X^67V{{2Q78o7T?+olD@Z@hMsTrkr8Ylt1we6=-_JIy}mi**=CeDR-~0)mZkGBenVsN zdGY3Q9l0JJSjb(vku^xI-ljK6lWZVUlEUNO&9#O0=JBY%>3Usj7!9=A-=^9(c{uQ1 zVUddp$vX-ed9j;hIyRRQ>xhoLx4xP4eiYi}pDRc^F6agMZ_1z8RrBSeJY06#l%QNw zWz}+}oC_GQlgOJZd|d~zt`;nz;S{}}Q~71{<%^hGU5|Z6MQFlNHspgbY#mJ53o3uZ ze0eB{9u?d*Uv5QFGT!Rjp+8K9{Aikb+)(&C=F9zL4TJqXX#is@8hBZ34Z@MPXHApg z;Q27}48?da*Rh7f{(-c7`xGrlnH6K$!z8vML$NK=;Gg z%BFkpZcJouDClh|wE(i;A-Olrm)l!uxV!t{iG;mw~2WX%!30%{ri$+9UQP< z5(6dMFAkq@LzO@~G>J0yePUr8w-clqnH9#KyB%4aKlKJd;&MZAK9F+jS?ncgx}|9v zJi*e=4Tara(2%3-4@eR{+_45$E~84}?)!-#L$^*#5n0=c`P7s1UH=|d@g z3XMG`U9jU$vK70JyGMZ+KZv+zC``_jC6xUsNs73F1-Q4B`NO^!!}ArC$CU+;T_8Ec zf}I3yHdKj>1+t8##6r~H8KzO_EO$^bWYk~FVSh|oFqp-W0y%6I!a2cXva&1O=3sH1Vur0 z`^kC|tCAi>v4>kbM~BmRU`-5FETh;QU=`wHUWsCEs1iA^WEp!%ER55`N83d&9`{AA ze2|5GLlNXSt)sASk`5R`##}23XP&$7jl}{-G0af3Z;D=?PGsL&qYwMuWqpdapl_AP zZje6A0rX7HfdebE`rJ^EoCAv>`+(#S3l)@k(a`k_g~?dBgtEURN%$8q*b>t>!tC|j zgM<$Zh082=4TJrVG{C)qXPzr(ex4k1L&0+XtrFO4BrjSJJ4xVWh$HhEpzyo}s|+?K z4H$Tl5A0g~Fq$s-t)fW3T~A`4kRCWF)sMu68w$X%>?b>OZ!LwvMh58)1b;eG6yWxQ9I^tUCH{VqvjwD&?=Wb_IIQKYv3NTY%3EAxS`5r)}bNn+a!Ut^r_{C4mOT~p-Sais><1Y zVxxsmv8Qsk6XDfJEjWTIHxw>gxQ4+7%NlmA5Mh)LeJc~|s>0_Q78&drX}~z5hGb8i zHed^c>_|a!92Y@WBRLG1fUwKTr4%4NScljpl0h~ifPRvtLCE{hJ#1q_M~uAz#hFU|q>XT%rN1!)}G z`~vG$#>JrqHxw-6&nkgEB6(q&gJ{T~sJ*Fzq^%c0_Mt9^d?Qa^4~B3N1?6%JAPbk} zJ`W>z+sZJu3YyC)ko}zG1SlsPjuL1;tUwtvmSOfMn(QNQvKuAVK*=gl$}Yp~kYr`( zgk_z~vpD?tvB(Ora}-IQBFPM6KUq&>4(XC(6-C(6>+Yf8Vyu=4%qDp;XNP@cxM5!$ z2dHv6_cequl7Px**cnCm1SH!|36>(rtYIC6jYtP9FA0f-9C6RGJyfkgX}x8b{SnC` zQfeTQWo{@;M#?3Wl}Qrl9K-$$&F6+f5vBH%6`cKmq~X;E`8Upd@#cntq?av%>}Lyd zh|ZB0;atd?azjCdoDQ;!BnMDTdm*=nUW(vpC{WsH8D;^=B5nW_dkDEE%+C}QL&lA@ z9QF;;0v{-5@WY{;Rtk|T<^sm9lN796Aljm-P-*2AocSaT&4kiQrZ73WODOv(Nn%Yp zNTO+eTBAzknxx9vRbmSZft|-_M;JGW<;GPpatp2Fus_$d&?XIsRCE#rk5mk)Wi5yO zh_r~2MvB-CC(m%;Y~e(N8w$)vdI@GfCRy|k+IjftFc~07t8zJiHH7``qC}pVBD+%M zBtZy!lO(WyJh$RrHBS#zv0Ojq0K2lp-_QA~Sn+d!?GYdSf9~N(T%I8ndmIJI{x8GK zBw5imdFCP43ss!gr2zJO#D{<7e6=1J3X}e|gtFI35|##r@2PoKs>-F^G=%*lNdS57 zMb<=wIB`;KC`8Vm1&q~63UQ`Dgo8q{p&%JA7D4uhBqw^7MBY{$C;3{!4Ta@BTSVD4 zlEj=mbduC_#ejW=)JhzBaYNxUyIR9wACU$O(joTQt`%VxsokG~{6IBFJKr!`Zxu`_8~nMe=MuFJyh<$@U1I zIQ}tIanT+E*gM3B?TPCZ=itP=n`C{pgeg?61S>e( zC27o_Bb@qqhn`HGxuFm_dloQuLQ)uh;l*l~C^i}jl(A$PW*Nz1)CKrB7XNFgVmaz_ zfPIJf07S9eC5tm11&9PV(INIR$%tM-W*+DjlJ`o-*gcZM1QJrk=8pEw+)xCWbFHJW zCh0)UFJe1EG?J#{hC*b`3mBV`6rx^%91gLoROQgNpJ)g(NCIsY+Xg3;;e6g!MUZV> zM`4_Fzy~$L;SkFr?R*qR`rs)n_Fd8>dmTE7D~u-&&lFPhTEp0HlN7w@MT~`TfX&G6 zV_{crC{TLQGR*#Zjcjpz#SH~6$P&!9NfsXUS?G<69ETeUkRGK&#b@IE;_vnQ3D*Ct zBtBVS8&Q?6ZoX>P&0*Y&lW}ZDxWqImu(!8M4l*Nr zw$H?mJ|awk=og31d1Y+VaSCNOwQBI`-seR*{kf~*XkM?RldhXx+>kLN_lG{dLX`@c z4>S=zOyxCzk{Kr^E+rI{3qO5uSp0l@`{R%2J=L`r1a^7Hvxk03S@yO4XC%8bjd4uo zll-|Lsmb5RyjJ0%VG*p^5aP_#gS|148bR8X!;El8()kBYu< zlJ9x27aAtamml^NislaX2F?$6LbAlCU%6Km72bX7q0yzpKE|5QmwNbAtJOXCRm{!E z-4KDIsPXnSCOe5Z zdbe9`*K2O0=DMzDw_6RzuGAZr-R@Ld)rMy|jXDkXTcivThQih+zRi{}-?I=GXz;`0 zeljkpc_G8KJW47ZPVpg;!u$i%9e+w(&HU!o)$qbBJ=ghh(@(gcN4jVSR6|CAuHsIa!v3mQ4XIT ztfIFGMd!paU=EUGmGus>(&9v?WSZg<;VSceVrCvj0xiSk&wk>H@29KekBK}8!Z;R= zi50qpuRdrA{z3N8y;|$o?IXF*E5%ruN`nN`&0W)=dq*;m(ArkAVI+LUq{i%TKP-OU zD2QjsFRs6cGhC5?n`R+C;uVVKlj+(E?v-}L`1|P33VcPth)m*xP5z&`=v9Fo1vp`K z*BI`GK)-N3xCI7R7VLS-<23_{=1D&starI9)^ggUKY=*=4e(8iBGP4O)<@MiDGYEM z0H=J%8kEG9%L39GejWGk;$eSzEd4&svKvm8a2bG+{H-(n4L6F!E%&7ueMMZQ-0b2c znQDEnn4Ygh2z!Oe5iN<_S|Jqey@G6RG3oq`tN@o$jc&@KcJ>y^Lj>6U7bUe?XePV^ zSQ*+DiM6T1yheLpr-@wJ!qPB|$2ja-9hL>1V&rf`o>uU=XWu|%USr2gMRB3_TC#?7 zQ5F`A>)4t@X356-rTcSuXs)xU;cA|Pl&s7NilQr9`2AAuIEs=F3Q}P4(ncsggp^#w zckKB`9LQ{)Py2Qf zQ4pDr!<&UnLeQmWhkM%Q>0W_TJVYDC7l)$TUzCxNBreptB}~;4;%#Wrrf%MXn?((h z$8rCn&~3DfAJ+!S&p9Q+ zEnWVcyKr5_8DDJaqUU_7rK>pm8?6QDbMFXrEoYB-y7c*59(% z@=90o<;M0r54QB$&;C+Nmpr*RT_RMdrbm6l-uKHy8Dbdoas!!wtrTiI`TwBEJD)l2T7Z0db^c2u( zFQ*EzlDNrvRG1 zOX6@8kH`!4^v|#J68Zll@O55t&PU^Vr1&~7k*~0IlYE_*obBnjZo9AZlK /dev/null; then + echo "[ERROR] $file failed nixfmt verification" + exit 1 + else + echo "[OK] $file" + fi +done + +# Verify "invalid" +for file in test/invalid/*.nix; do + if nixfmt < "$file" > /dev/null 2>&1; then + echo "[ERROR] $file should have failed nixfmt" + exit 1 + else + echo "[OK] $file" + fi +done + +# Verify "diff" +for file in test/diff/**/in.nix; do + outfile="$(dirname "$file")/out.nix" + + echo "Checking $file …" + out="$(nixfmt < "$file")" + + if diff --color=always --unified "$outfile" <(echo "$out"); then + echo "[OK]" + elif [[ $* == *--update-diff* ]]; then + echo "$out" > "$outfile" + echo "[UPDATED] $outfile" + else + echo "[ERROR] (run with --update-diff to update the diff)" + exit 1 + fi +done From 9ce4ce33b636616a5abaccc45a30b742e7f1d843 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 18 Apr 2023 23:33:39 +0200 Subject: [PATCH 010/125] Rework function declarations --- src/Nixfmt/Pretty.hs | 24 +- test/diff/apply/out.nix | 4 +- test/diff/comment/out.nix | 5 +- test/diff/idioms_lib_2/out.nix | 4 +- test/diff/idioms_lib_3/out.nix | 60 +-- test/diff/idioms_nixos_1/out.nix | 7 +- test/diff/idioms_pkgs_1/out.nix | 7 +- test/diff/idioms_pkgs_2/out.nix | 10 +- test/diff/idioms_pkgs_3/out.nix | 7 +- test/diff/key_value/out.nix | 6 +- test/diff/lambda/out.nix | 29 +- test/diff/monsters_1/out.nix | 125 +++--- test/diff/monsters_3/out.nix | 21 +- test/diff/monsters_4/out.nix | 63 +-- test/diff/monsters_5/out.nix | 8 +- test/diff/pattern/out.nix | 649 +++++++++++++++++++------------ 16 files changed, 642 insertions(+), 387 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index eb4d7200..707f49a4 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -124,27 +124,33 @@ toLeading :: Maybe TrailingComment -> Trivia toLeading Nothing = [] toLeading (Just (TrailingComment c)) = [LineComment (" " <> c)] -prettyComma :: Maybe Leaf -> Doc -prettyComma Nothing = mempty -prettyComma (Just comma) = softline' <> pretty comma <> hardspace - instance Pretty ParamAttr where - pretty (ParamAttr name Nothing comma) - = pretty name <> prettyComma comma + -- Simple parameter + pretty (ParamAttr name Nothing maybeComma) + = pretty name <> (fromMaybe (text ",") (fmap pretty maybeComma)) <> softline + -- With ? default pretty (ParamAttr name (Just (qmark, def)) comma) = group (pretty name <> hardspace <> pretty qmark <> absorb softline mempty (Just 2) def) - <> prettyComma comma + <> pretty comma <> softline + -- ... pretty (ParamEllipsis ellipsis) = pretty ellipsis instance Pretty Parameter where + -- param: pretty (IDParameter i) = pretty i + + -- {}: + pretty (SetParameter bopen [] bclose) + = group $ pretty bopen <> hardspace <> pretty bclose + + -- { stuff }: pretty (SetParameter bopen attrs bclose) - = group $ pretty bopen <> hardspace - <> hcat attrs <> softline + = group $ pretty bopen <> hardline + <> nest 2 (sepBy hardline attrs) <> hardline <> pretty bclose pretty (ContextParameter param1 at param2) diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index c14df116..d43eb23d 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -56,7 +56,9 @@ } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { - outputs = { utils }: + outputs = { + utils, + }: # For each supported platform, utils.lib.eachDefaultSystem (system: { }); } diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index 4ce451b9..fe313652 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -73,8 +73,9 @@ #7 in d) - ({ a, # comment - b ? 2, # comment + ({ + a, # comment + b ? 2, # comment }: _) ] diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 50127d5b..93264ab6 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -1,4 +1,6 @@ -{ lib }: +{ + lib, +}: rec { diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index bcfd80b8..eb1a8c24 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -12,7 +12,9 @@ # # Tests can be found in ./tests/misc.nix # Documentation in the manual, #sec-generators -{ lib, }: +{ + lib, +}: with (lib).trivial; let libStr = lib.strings; @@ -75,7 +77,9 @@ in rec { # # mkKeyValueDefault {} ":" "f:oo" "bar" # > "f\:oo:bar" - mkKeyValueDefault = { mkValueString ? mkValueStringDefault { } }: + mkKeyValueDefault = { + mkValueString ? mkValueStringDefault { } + }: sep: k: v: "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; @@ -84,8 +88,10 @@ in rec { # Generate a key-value-style config file from an attrset. # # mkKeyValue is the same as in toINI. - toKeyValue = - { mkKeyValue ? mkKeyValueDefault { } "=", listsAsDuplicateKeys ? false }: + toKeyValue = { + mkKeyValue ? mkKeyValueDefault { } "=", + listsAsDuplicateKeys ? false + }: let mkLine = k: v: mkKeyValue k v + "\n"; mkLines = if listsAsDuplicateKeys then @@ -117,11 +123,12 @@ in rec { # For more examples see the test cases in ./tests/misc.nix. toINI = { # apply transformations (e.g. escapes) to section names - mkSectionName ? (name: libStr.escape [ "[" "]" ] name), - # format a setting line from key and value - mkKeyValue ? mkKeyValueDefault { } "=", - # allow lists as values for duplicate keys - listsAsDuplicateKeys ? false }: + mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + # format a setting line from key and value + mkKeyValue ? mkKeyValueDefault { } "=", + # allow lists as values for duplicate keys + listsAsDuplicateKeys ? false + }: attrsOfAttrs: let # map function to string for each key val @@ -166,12 +173,16 @@ in rec { # the part in `sections`. toINIWithGlobalSection = { # apply transformations (e.g. escapes) to section names - mkSectionName ? (name: libStr.escape [ "[" "]" ] name), - # format a setting line from key and value - mkKeyValue ? mkKeyValueDefault { } "=", - # allow lists as values for duplicate keys - listsAsDuplicateKeys ? false }: - { globalSection, sections, }: + mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + # format a setting line from key and value + mkKeyValue ? mkKeyValueDefault { } "=", + # allow lists as values for duplicate keys + listsAsDuplicateKeys ? false + }: + { + globalSection, + sections, + }: (if globalSection == { } then "" else @@ -247,9 +258,11 @@ in rec { withRecursion = { # If this option is not null, the given value will stop evaluating at a certain depth - depthLimit - # If this option is true, an error will be thrown, if a certain given depth is exceeded - , throwOnDepthLimit ? true }: + depthLimit + # If this option is true, an error will be thrown, if a certain given depth is exceeded + , + throwOnDepthLimit ? true + }: assert builtins.isInt depthLimit; let specialAttrs = [ "__functor" "__functionArgs" "__toString" "__pretty" ]; @@ -286,11 +299,12 @@ in rec { will use fn to convert val to a pretty printed representation. (This means fn is type Val -> String.) */ - allowPrettyValues ? false, - # If this option is true, the output is indented with newlines for attribute sets and lists - multiline ? true, - # Initial indentation level - indent ? "" }: + allowPrettyValues ? false, + # If this option is true, the output is indented with newlines for attribute sets and lists + multiline ? true, + # Initial indentation level + indent ? "" + }: let go = indent: v: with builtins; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index fa81fe0f..1abee780 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -1,4 +1,9 @@ -{ config, lib, pkgs, ... }: +{ + config, + lib, + pkgs, + ... +}: with lib; diff --git a/test/diff/idioms_pkgs_1/out.nix b/test/diff/idioms_pkgs_1/out.nix index fc9d729b..afdbed26 100644 --- a/test/diff/idioms_pkgs_1/out.nix +++ b/test/diff/idioms_pkgs_1/out.nix @@ -1,4 +1,9 @@ -{ stdenv, lib, fetchFrom, ... }: +{ + stdenv, + lib, + fetchFrom, + ... +}: stdenv.mkDerivation rec { pname = "test"; diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index e72b643c..4ff5fbf9 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -1,4 +1,12 @@ -{ lib, stdenv, fetchurl, nixos, testVersion, testEqualDerivation, hello }: +{ + lib, + stdenv, + fetchurl, + nixos, + testVersion, + testEqualDerivation, + hello, +}: stdenv.mkDerivation rec { pname = "hello"; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index fa81fe0f..1abee780 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -1,4 +1,9 @@ -{ config, lib, pkgs, ... }: +{ + config, + lib, + pkgs, + ... +}: with lib; diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 81fa1d75..b99a70e7 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -54,7 +54,11 @@ rec { c = 2; }; n = pkgs: { }; - o = { pkgs, ... }: { }; + o = { + pkgs, + ... + }: + { }; a # b diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 7ba1d670..c8fb3d58 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -19,25 +19,44 @@ (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) - ({ pkgs ? import ./.. { }, locationsXml }: null) + ({ + pkgs ? import ./.. { }, + locationsXml, + }: + null) (a: b: c: { }: a: b: c: a) - ({ pkgs, ... }: + ({ + pkgs, + ... + }: { # Stuff }) - ({ pkgs, ... }: let in pkgs) + ({ + pkgs, + ... + }: + let + in pkgs) (a: - { b, ... }: + { + b, + ... + }: c: { # Stuff }) (a: - { b, c, ... }: + { + b, + c, + ... + }: d: { # Stuff diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index 65b0817a..02d7ee2b 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -1,67 +1,68 @@ { # foo -stdenv -# foo -, -# foo -lib -# foo -, -# foo -fetchFromGitLab -# foo -, -# foo -cairo -# foo -, -# foo -desktop-file-utils -# foo -, -# foo -gettext -# foo -, -# foo -glib -# foo -, -# foo -gtk4 -# foo -, -# foo -libadwaita -# foo -, -# foo -meson -# foo -, -# foo -ninja -# foo -, -# foo -pango -# foo -, -# foo -pkg-config -# foo -, -# foo -python3 -# foo -, -# foo -rustPlatform -# foo -, -# foo -wrapGAppsHook4 -# foo + stdenv + # foo + , + # foo + lib + # foo + , + # foo + fetchFromGitLab + # foo + , + # foo + cairo + # foo + , + # foo + desktop-file-utils + # foo + , + # foo + gettext + # foo + , + # foo + glib + # foo + , + # foo + gtk4 + # foo + , + # foo + libadwaita + # foo + , + # foo + meson + # foo + , + # foo + ninja + # foo + , + # foo + pango + # foo + , + # foo + pkg-config + # foo + , + # foo + python3 + # foo + , + # foo + rustPlatform + # foo + , + # foo + wrapGAppsHook4 + # foo + , }: # foo stdenv.mkDerivation diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index daf77bf8..0500dce3 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -1,6 +1,21 @@ -{ stdenv, lib, fetchFromGitLab, cairo, desktop-file-utils, gettext, glib, gtk4 -, libadwaita, meson, ninja, pango, pkg-config, python3, rustPlatform -, wrapGAppsHook4 }: +{ + stdenv, + lib, + fetchFromGitLab, + cairo, + desktop-file-utils, + gettext, + glib, + gtk4, + libadwaita, + meson, + ninja, + pango, + pkg-config, + python3, + rustPlatform, + wrapGAppsHook4, +}: stdenv.mkDerivation rec { pname = "contrast"; version = "0.0.5"; diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index e1d1c452..9360bc69 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -1,35 +1,36 @@ { # Foo -stdenv # Foo -, # Foo -lib # Foo -, # Foo -fetchFromGitLab # Foo -, # Foo -cairo # Foo -, # Foo -desktop-file-utils # Foo -, # Foo -gettext # Foo -, # Foo -glib # Foo -, # Foo -gtk4 # Foo -, # Foo -libadwaita # Foo -, # Foo -meson # Foo -, # Foo -ninja # Foo -, # Foo -pango # Foo -, # Foo -pkg-config # Foo -, # Foo -python3 # Foo -, # Foo -rustPlatform # Foo -, # Foo -wrapGAppsHook4 # Foo + stdenv # Foo + , # Foo + lib # Foo + , # Foo + fetchFromGitLab # Foo + , # Foo + cairo # Foo + , # Foo + desktop-file-utils # Foo + , # Foo + gettext # Foo + , # Foo + glib # Foo + , # Foo + gtk4 # Foo + , # Foo + libadwaita # Foo + , # Foo + meson # Foo + , # Foo + ninja # Foo + , # Foo + pango # Foo + , # Foo + pkg-config # Foo + , # Foo + python3 # Foo + , # Foo + rustPlatform # Foo + , # Foo + wrapGAppsHook4 # Foo + , }: # Foo stdenv.mkDerivation # Foo rec # Foo diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index a63065f0..af37fdaa 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -1,12 +1,12 @@ { -config, + config, -lib, + lib, -pkgs, + pkgs, -... + ... }: diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 23f5ebef..39326a69 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -1,389 +1,556 @@ [ - ({ foo, bar - # Some comment - , baz }: + ({ + foo, + bar + # Some comment + , + baz, + }: { }) - ({ foo, bar # Some comment + ({ + foo, + bar # Some comment + , }: { }) - (a@{ self, gomod2nix, mach-nix, }: _) - ({ self, gomod2nix, mach-nix, }@inp: _) - ({ a ? [ 1 2 3 ], b ? { - # ... - } }: + (a@{ + self, + gomod2nix, + mach-nix, + }: + _) + ({ + self, + gomod2nix, + mach-nix, + }@inp: + _) + ({ + a ? [ 1 2 3 ], + b ? { + # ... + } + }: _) ({ }: _) - ({ a }: _) + ({ + a, + }: + _) ({ }: _) - ({ ... }: _) - ({ ... }: _) - ({ ... }: _) - ({ ... }: _) + ({ + ... + }: + _) + ({ + ... + }: + _) + ({ + ... + }: + _) + ({ + ... + }: + _) - ({ b, e, ... }: _) - ({ b, e, ... # h + ({ + b, + e, + ... + }: + _) + ({ + b, + e, + ... # h }: _) - ({ b, e, # g - ... }: + ({ + b, + e, # g + ... + }: _) - ({ b, e, # g - ... # h + ({ + b, + e, # g + ... # h }: _) - ({ b, e # f - , ... }: + ({ + b, + e # f + , + ... + }: _) - ({ b, e # f - , ... # h + ({ + b, + e # f + , + ... # h }: _) - ({ b, e # f - , # g - ... }: + ({ + b, + e # f + , # g + ... + }: _) - ({ b, e # f - , # g - ... # h + ({ + b, + e # f + , # g + ... # h }: _) - ({ b, # d - e, ... }: + ({ + b, # d + e, + ... + }: _) - ({ b, # d - e, ... # h + ({ + b, # d + e, + ... # h }: _) - ({ b, # d - e, # g - ... }: + ({ + b, # d + e, # g + ... + }: _) - ({ b, # d - e, # g - ... # h + ({ + b, # d + e, # g + ... # h }: _) - ({ b, # d - e # f - , ... }: + ({ + b, # d + e # f + , + ... + }: _) - ({ b, # d - e # f - , ... # h + ({ + b, # d + e # f + , + ... # h }: _) - ({ b, # d - e # f - , # g - ... }: + ({ + b, # d + e # f + , # g + ... + }: _) - ({ b, # d - e # f - , # g - ... # h + ({ + b, # d + e # f + , # g + ... # h }: _) - ({ b # c - , e, ... }: + ({ + b # c + , + e, + ... + }: _) - ({ b # c - , e, ... # h + ({ + b # c + , + e, + ... # h }: _) - ({ b # c - , e, # g - ... }: + ({ + b # c + , + e, # g + ... + }: _) - ({ b # c - , e, # g - ... # h + ({ + b # c + , + e, # g + ... # h }: _) - ({ b # c - , e # f - , ... }: + ({ + b # c + , + e # f + , + ... + }: _) - ({ b # c - , e # f - , ... # h + ({ + b # c + , + e # f + , + ... # h }: _) - ({ b # c - , e # f - , # g - ... }: + ({ + b # c + , + e # f + , # g + ... + }: _) - ({ b # c - , e # f - , # g - ... # h + ({ + b # c + , + e # f + , # g + ... # h }: _) - ({ b # c - , # d - e, ... }: + ({ + b # c + , # d + e, + ... + }: _) - ({ b # c - , # d - e, ... # h + ({ + b # c + , # d + e, + ... # h }: _) - ({ b # c - , # d - e, # g - ... }: + ({ + b # c + , # d + e, # g + ... + }: _) - ({ b # c - , # d - e, # g - ... # h + ({ + b # c + , # d + e, # g + ... # h }: _) - ({ b # c - , # d - e # f - , ... }: + ({ + b # c + , # d + e # f + , + ... + }: _) - ({ b # c - , # d - e # f - , ... # h + ({ + b # c + , # d + e # f + , + ... # h }: _) - ({ b # c - , # d - e # f - , # g - ... }: + ({ + b # c + , # d + e # f + , # g + ... + }: _) - ({ b # c - , # d - e # f - , # g - ... # h + ({ + b # c + , # d + e # f + , # g + ... # h }: _) ({ # a - b, e, ... }: + b, + e, + ... + }: _) ({ # a - b, e, ... # h + b, + e, + ... # h }: _) ({ # a - b, e, # g - ... }: + b, + e, # g + ... + }: _) ({ # a - b, e, # g - ... # h + b, + e, # g + ... # h }: _) ({ # a - b, e # f - , ... }: + b, + e # f + , + ... + }: _) ({ # a - b, e # f - , ... # h + b, + e # f + , + ... # h }: _) ({ # a - b, e # f - , # g - ... }: + b, + e # f + , # g + ... + }: _) ({ # a - b, e # f - , # g - ... # h + b, + e # f + , # g + ... # h }: _) ({ # a - b, # d - e, ... }: + b, # d + e, + ... + }: _) ({ # a - b, # d - e, ... # h + b, # d + e, + ... # h }: _) ({ # a - b, # d - e, # g - ... }: + b, # d + e, # g + ... + }: _) ({ # a - b, # d - e, # g - ... # h + b, # d + e, # g + ... # h }: _) ({ # a - b, # d - e # f - , ... }: + b, # d + e # f + , + ... + }: _) ({ # a - b, # d - e # f - , ... # h + b, # d + e # f + , + ... # h }: _) ({ # a - b, # d - e # f - , # g - ... }: + b, # d + e # f + , # g + ... + }: _) ({ # a - b, # d - e # f - , # g - ... # h + b, # d + e # f + , # g + ... # h }: _) ({ # a - b # c - , e, ... }: + b # c + , + e, + ... + }: _) ({ # a - b # c - , e, ... # h + b # c + , + e, + ... # h }: _) ({ # a - b # c - , e, # g - ... }: + b # c + , + e, # g + ... + }: _) ({ # a - b # c - , e, # g - ... # h + b # c + , + e, # g + ... # h }: _) ({ # a - b # c - , e # f - , ... }: + b # c + , + e # f + , + ... + }: _) ({ # a - b # c - , e # f - , ... # h + b # c + , + e # f + , + ... # h }: _) ({ # a - b # c - , e # f - , # g - ... }: + b # c + , + e # f + , # g + ... + }: _) ({ # a - b # c - , e # f - , # g - ... # h + b # c + , + e # f + , # g + ... # h }: _) ({ # a - b # c - , # d - e, ... }: + b # c + , # d + e, + ... + }: _) ({ # a - b # c - , # d - e, ... # h + b # c + , # d + e, + ... # h }: _) ({ # a - b # c - , # d - e, # g - ... }: + b # c + , # d + e, # g + ... + }: _) ({ # a - b # c - , # d - e, # g - ... # h + b # c + , # d + e, # g + ... # h }: _) ({ # a - b # c - , # d - e # f - , ... }: + b # c + , # d + e # f + , + ... + }: _) ({ # a - b # c - , # d - e # f - , ... # h + b # c + , # d + e # f + , + ... # h }: _) ({ # a - b # c - , # d - e # f - , # g - ... }: + b # c + , # d + e # f + , # g + ... + }: _) ({ # a - b # c - , # d - e # f - , # g - ... # h + b # c + , # d + e # f + , # g + ... # h }: _) - ({ a ? null }: _) + ({ + a ? null + }: + _) ({ # a - b # a - ? # a - null # c - , # d - e # a - ? # a - null # f - , # g - ... # h + b # a + ? # a + null # c + , # d + e # a + ? # a + null # f + , # g + ... # h }: _) ({ # a # - b - # a - # - ? - # a - # - null - # c + b + # a # - , - # d - # - e - # a - # - ? - # a - # - null - # f + ? + # a + # + null + # c + # + , + # d + # + e + # a + # + ? + # a + # + null + # f + # + , + # g + # + ... + # h # - , - # g - # - ... - # h - # } # i # From e05d6a228cd017b88395b3235e4db56415a7183c Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 18 Apr 2023 23:46:10 +0200 Subject: [PATCH 011/125] Force-expand lists with more than one item --- src/Nixfmt/Pretty.hs | 14 ++++++++----- test/diff/idioms_lib_2/out.nix | 21 ++++++++++---------- test/diff/idioms_lib_3/out.nix | 34 ++++++++++++++++++++++++++------ test/diff/idioms_nixos_1/out.nix | 15 +++++++++++--- test/diff/idioms_pkgs_3/out.nix | 15 +++++++++++--- test/diff/let_in/out.nix | 6 +++++- test/diff/lists/out.nix | 5 ++++- test/diff/monsters_3/out.nix | 8 +++++++- test/diff/pattern/out.nix | 6 +++++- test/diff/with/out.nix | 8 +++++++- 10 files changed, 100 insertions(+), 32 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 707f49a4..16557ff8 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -91,21 +91,25 @@ prettyTerm (String s) = pretty s prettyTerm (Path p) = pretty p prettyTerm (Selection term selectors) = pretty term <> hcat selectors +-- Empty list prettyTerm (List (Ann paropen Nothing []) [] parclose) = pretty paropen <> hardspace <> pretty parclose +-- Singleton list prettyTerm (List (Ann paropen Nothing []) [item] parclose) - | isAbsorbable item - = pretty paropen <> pretty item <> pretty parclose + = pretty paropen <> hardspace <> pretty item <> hardspace <> pretty parclose +-- General list prettyTerm (List (Ann paropen trailing leading) items parclose) - = base $ pretty paropen <> pretty trailing <> line - <> nest 2 (pretty leading <> sepBy line (map group items)) <> line + = base $ pretty paropen <> pretty trailing <> hardline + <> nest 2 (pretty leading <> sepBy hardline (map group items)) <> hardline <> pretty parclose +-- Empty, non-recursive attribute set prettyTerm (Set Nothing (Ann paropen Nothing []) [] parclose) = pretty paropen <> hardspace <> pretty parclose +-- General set prettyTerm (Set krec (Ann paropen trailing leading) binders parclose) = base $ pretty (fmap ((<>hardspace) . pretty) krec) <> pretty paropen <> pretty trailing <> line @@ -160,7 +164,7 @@ isAbsorbable :: Term -> Bool isAbsorbable (String (Ann parts@(_:_:_) _ _)) = not $ isSimpleString parts isAbsorbable (Set _ _ (_:_) _) = True -isAbsorbable (List (Ann _ Nothing []) [item] _) = isAbsorbable item +isAbsorbable (List (Ann _ Nothing []) [_item] _) = True isAbsorbable (Parenthesized (Ann _ Nothing []) (Term t) _) = isAbsorbable t isAbsorbable (List _ (_:_:_) _) = True isAbsorbable _ = False diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 93264ab6..a265b747 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -304,13 +304,16 @@ rec { Type: string -> a -> a */ - warn = - if lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ "1" "true" "yes" ] then - msg: - builtins.trace "warning: ${msg}" (abort - "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") - else - msg: builtins.trace "warning: ${msg}"; + warn = if lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ + "1" + "true" + "yes" + ] then + msg: + builtins.trace "warning: ${msg}" (abort + "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") + else + msg: builtins.trace "warning: ${msg}"; /* Like warn, but only warn when the first argument is `true`. @@ -433,9 +436,7 @@ rec { toBaseDigits = base: i: let go = i: - if i < base then - [ i ] - else + if i < base then [ i ] else let r = i - ((i / base) * base); q = (i - r) / base; diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index eb1a8c24..b334af1a 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -123,7 +123,11 @@ in rec { # For more examples see the test cases in ./tests/misc.nix. toINI = { # apply transformations (e.g. escapes) to section names - mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + mkSectionName ? (name: + libStr.escape [ + "[" + "]" + ] name), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys @@ -173,7 +177,11 @@ in rec { # the part in `sections`. toINIWithGlobalSection = { # apply transformations (e.g. escapes) to section names - mkSectionName ? (name: libStr.escape [ "[" "]" ] name), + mkSectionName ? (name: + libStr.escape [ + "[" + "]" + ] name), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys @@ -265,7 +273,12 @@ in rec { }: assert builtins.isInt depthLimit; let - specialAttrs = [ "__functor" "__functionArgs" "__toString" "__pretty" ]; + specialAttrs = [ + "__functor" + "__functionArgs" + "__toString" + "__pretty" + ]; stepIntoAttr = evalNext: name: if builtins.elem name specialAttrs then id else evalNext; transform = depth: @@ -328,9 +341,18 @@ in rec { else if isString v then let lines = filter (v: !isList v) (builtins.split "\n" v); - escapeSingleline = libStr.escape [ "\\" ''"'' "\${" ]; - escapeMultiline = - libStr.replaceStrings [ "\${" "''" ] [ "''\${" "'''" ]; + escapeSingleline = libStr.escape [ + "\\" + ''"'' + "\${" + ]; + escapeMultiline = libStr.replaceStrings [ + "\${" + "''" + ] [ + "''\${" + "'''" + ]; singlelineResult = ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; multilineResult = let diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 1abee780..a16b6963 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -139,7 +139,10 @@ in { boot.initrd.availableKernelModules = mkOption { type = types.listOf types.str; default = [ ]; - example = [ "sata_nv" "ext3" ]; + example = [ + "sata_nv" + "ext3" + ]; description = '' The set of kernel modules in the initial ramdisk used during the boot process. This set must include all modules necessary for @@ -276,12 +279,18 @@ in { # Implement consoleLogLevel both in early boot and using sysctl # (so you don't need to reboot to have changes take effect). boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] - ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; + ++ optionals config.boot.vesa [ + "vga=0x317" + "nomodeset" + ]; boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; - boot.kernelModules = [ "loop" "atkbd" ]; + boot.kernelModules = [ + "loop" + "atkbd" + ]; # The Linux kernel >= 2.6.27 provides firmware. hardware.firmware = [ kernel ]; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 1abee780..a16b6963 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -139,7 +139,10 @@ in { boot.initrd.availableKernelModules = mkOption { type = types.listOf types.str; default = [ ]; - example = [ "sata_nv" "ext3" ]; + example = [ + "sata_nv" + "ext3" + ]; description = '' The set of kernel modules in the initial ramdisk used during the boot process. This set must include all modules necessary for @@ -276,12 +279,18 @@ in { # Implement consoleLogLevel both in early boot and using sysctl # (so you don't need to reboot to have changes take effect). boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] - ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; + ++ optionals config.boot.vesa [ + "vga=0x317" + "nomodeset" + ]; boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; - boot.kernelModules = [ "loop" "atkbd" ]; + boot.kernelModules = [ + "loop" + "atkbd" + ]; # The Linux kernel >= 2.6.27 provides firmware. hardware.firmware = [ kernel ]; diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index 65cc06c0..46ac00d4 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -32,6 +32,10 @@ let # e in f; - a = let in [ 1 2 ]; + a = let + in [ + 1 + 2 + ]; in a diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 173cace2..83a2a53f 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -3,7 +3,10 @@ [ 1 ] - [ b d ] + [ + b + d + ] [ b d # e diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index 0500dce3..0f66f531 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -45,7 +45,13 @@ stdenv.mkDerivation rec { wrapGAppsHook4 glib # for glib-compile-resources ]; - buildInputs = [ cairo glib gtk4 libadwaita pango ]; + buildInputs = [ + cairo + glib + gtk4 + libadwaita + pango + ]; postPatch = '' patchShebangs build-aux/meson_post_install.py # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 39326a69..27875c1b 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -26,7 +26,11 @@ }@inp: _) ({ - a ? [ 1 2 3 ], + a ? [ + 1 + 2 + 3 + ], b ? { # ... } diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index a94e480c..8eb76a24 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -43,5 +43,11 @@ b = 2; }) { a = with b; with b; with b; 1; } - { binPath = with pkgs; makeBinPath ([ rsync util-linux ]); } + { + binPath = with pkgs; + makeBinPath ([ + rsync + util-linux + ]); + } ] From 305ed77c8dff7f773ce793080eb6c59c5fee1f02 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 18 Apr 2023 23:51:49 +0200 Subject: [PATCH 012/125] Expand let statements more --- src/Nixfmt/Pretty.hs | 16 +++++-- test/diff/apply/out.nix | 5 ++- test/diff/comment/out.nix | 4 +- test/diff/idioms_lib_2/out.nix | 38 ++++++++++------ test/diff/idioms_lib_3/out.nix | 74 +++++++++++++++++++++----------- test/diff/idioms_nixos_1/out.nix | 13 +++--- test/diff/idioms_pkgs_3/out.nix | 13 +++--- test/diff/lambda/out.nix | 4 +- test/diff/let_in/out.nix | 46 ++++++++++++++------ 9 files changed, 146 insertions(+), 67 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 16557ff8..036b8cb5 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -188,6 +188,16 @@ absorbThen :: Expression -> Doc absorbThen (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace absorbThen x = line <> nest 2 (group x) <> line +-- What is allowed to come on the same line as `in`? +-- Absorbable terms like sets +-- if, with, let +absorbIn :: Expression -> Doc +absorbIn (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace +absorbIn x@(If _ _ _ _ _ _) = group x +absorbIn x@(With _ _ _ _) = group x +absorbIn x@(Let _ _ _ _) = group x +absorbIn x = line <> nest 2 (group x) <> line + absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) = hardspace <> pretty if_ <> hardspace <> group cond <> hardspace @@ -212,9 +222,9 @@ instance Pretty Expression where pretty (Let (Ann let_ letTrailing letLeading) binders (Ann in_ inTrailing inLeading) expr) - = base $ group letPart <> line <> group inPart - where letPart = pretty let_ <> pretty letTrailing <> line <> letBody - inPart = pretty in_ <> hardspace <> pretty expr + = base $ group letPart <> line <> inPart + where letPart = pretty let_ <> pretty letTrailing <> hardline <> letBody + inPart = pretty in_ <> hardspace <> absorbIn expr letBody = nest 2 $ pretty letLeading <> sepBy hardline binders diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index d43eb23d..1cdf5e2c 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -14,8 +14,9 @@ buildScript = "true"; installMethod = "copy"; }); - in "${pkg}/lib/node_modules/${pname}/node_modules") - outputs.subPackages)) + in + "${pkg}/lib/node_modules/${pname}/node_modules" + ) outputs.subPackages)) } '' { diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index fe313652..670504a7 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -71,7 +71,9 @@ d = 1; #7 - in d) + in + d + ) ({ a, # comment diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index a265b747..f570eda5 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -63,8 +63,11 @@ rec { final value. */ pipe = val: functions: - let reverseApply = x: f: f x; - in builtins.foldl' reverseApply val functions; + let + reverseApply = x: f: f x; + in + builtins.foldl' reverseApply val functions + ; # note please don’t add a function like `compose = flip pipe`. # This would confuse users, because the order of the functions @@ -175,7 +178,8 @@ rec { codeName = "Quokka"; # Returns the current nixpkgs version suffix as string. - versionSuffix = let suffixFile = ../.version-suffix; + versionSuffix = let + suffixFile = ../.version-suffix; in if pathExists suffixFile then lib.strings.fileContents suffixFile else @@ -352,12 +356,16 @@ rec { Type: String -> List ComparableVal -> List ComparableVal -> a -> a */ checkListOfEnum = msg: valid: given: - let unexpected = lib.subtractLists valid given; - in lib.throwIfNot (unexpected == [ ]) "${msg}: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) - } unexpected; valid ones: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString valid) - }"; + let + unexpected = lib.subtractLists valid given; + in + lib.throwIfNot (unexpected == [ ]) "${msg}: ${ + builtins.concatStringsSep ", " + (builtins.map builtins.toString unexpected) + } unexpected; valid ones: ${ + builtins.concatStringsSep ", " (builtins.map builtins.toString valid) + }" + ; info = msg: builtins.trace "INFO: ${msg}"; @@ -422,7 +430,9 @@ rec { "14" = "E"; "15" = "F"; }.${toString d}; - in lib.concatMapStrings toHexDigit (toBaseDigits 16 i); + in + lib.concatMapStrings toHexDigit (toBaseDigits 16 i) + ; /* `toBaseDigits base i` converts the positive integer i to a list of its digits in the given base. For example: @@ -440,6 +450,10 @@ rec { let r = i - ((i / base) * base); q = (i - r) / base; - in [ r ] ++ go q; - in assert (base >= 2); assert (i >= 0); lib.reverseList (go i); + in + [ r ] ++ go q + ; + in + assert (base >= 2); assert (i >= 0); lib.reverseList (go i) + ; } diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index b334af1a..8761e1c9 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -98,9 +98,11 @@ in rec { k: v: map (mkLine k) (if lib.isList v then v else [ v ]) else k: v: [ (mkLine k v) ]; - in attrs: - libStr.concatStrings - (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); + in + attrs: + libStr.concatStrings + (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) + ; # Generate an INI-style config file from an # attrset of sections to an attrset of key-value pairs. @@ -143,7 +145,9 @@ in rec { [${mkSectionName sectName}] '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; # map input to ini sections - in mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + in + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ; # Generate an INI-style config file from an attrset # specifying the global section (no header), and an @@ -233,8 +237,11 @@ in rec { # generation for multiple ini values mkKeyValue = k: v: - let mkKeyValue = mkKeyValueDefault { } " = " k; - in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)); + let + mkKeyValue = mkKeyValueDefault { } " = " k; + in + concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)) + ; # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI gitFlattenAttrs = let @@ -248,11 +255,15 @@ in rec { } else { ${head path} = value; }; - in attrs: - lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); + in + attrs: + lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) + ; toINI_ = toINI { inherit mkKeyValue mkSectionName; }; - in toINI_ (gitFlattenAttrs attrs); + in + toINI_ (gitFlattenAttrs attrs) + ; # Generates JSON from an arbitrary (non-function) value. # For more information see the documentation of the builtin. @@ -293,14 +304,17 @@ in rec { id; mapAny = with builtins; depth: v: - let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); + let + evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); in if isAttrs v then mapAttrs (stepIntoAttr evalNext) v else if isList v then map evalNext v else transform (depth + 1) v; - in mapAny 0; + in + mapAny 0 + ; # Pretty print a value, akin to `builtins.trace`. # Should probably be a builtin as well. @@ -360,10 +374,12 @@ in rec { # The last line gets a special treatment: if it's empty, '' is on its own line at the "outer" # indentation level. Otherwise, '' is appended to the last line. lastLine = lib.last escapedLines; - in "''" + introSpace - + concatStringsSep introSpace (lib.init escapedLines) - + (if lastLine == "" then outroSpace else introSpace + lastLine) - + "''"; + in + "''" + introSpace + + concatStringsSep introSpace (lib.init escapedLines) + + (if lastLine == "" then outroSpace else introSpace + lastLine) + + "''" + ; in if multiline && length lines > 1 then multilineResult else @@ -410,7 +426,9 @@ in rec { };") v) + outroSpace + "}" else abort "generators.toPretty: should never happen (v = ${v})"; - in go indent; + in + go indent + ; # PLIST handling toPlist = { }: @@ -462,21 +480,24 @@ in rec { (literal ind "") ]; - attr = let attrFilter = name: value: name != "_module" && value != null; - in ind: x: - libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList - (name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ]) x)); + attr = let + attrFilter = name: value: name != "_module" && value != null; + in + ind: x: + libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList + (name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ]) x)) + ; in '' ${expr "" v} - ''; + '' ; # Translate a simple Nix expression to Dhall notation. # Note that integers are translated to Integer and never @@ -484,7 +505,8 @@ in rec { toDhall = { }@args: v: with builtins; - let concatItems = lib.strings.concatStringsSep ", "; + let + concatItems = lib.strings.concatStringsSep ", "; in if isAttrs v then "{ ${ concatItems (lib.attrsets.mapAttrsToList diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index a16b6963..9b14d57e 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -359,11 +359,14 @@ in { assertions = if config.boot.kernelPackages.kernel ? features then [ ] else - let cfg = config.boot.kernelPackages.kernel.config; - in map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig; + let + cfg = config.boot.kernelPackages.kernel.config; + in + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig + ; }) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index a16b6963..9b14d57e 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -359,11 +359,14 @@ in { assertions = if config.boot.kernelPackages.kernel ? features then [ ] else - let cfg = config.boot.kernelPackages.kernel.config; - in map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig; + let + cfg = config.boot.kernelPackages.kernel.config; + in + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig + ; }) diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index c8fb3d58..7cb68ead 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -39,7 +39,9 @@ ... }: let - in pkgs) + in + pkgs + ) (a: { diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index 46ac00d4..9a8f92c1 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -3,39 +3,61 @@ let a = let b = 2; c = 3; - in d; - a = let c = 1; in f; + in + d + ; + a = let + c = 1; + in + f + ; a = let c = 1; # e - in f; - a = let c = 1; # d - in f; + in + f + ; + a = let + c = 1; # d + in + f + ; a = let c = 1; # d # e - in f; + in + f + ; a = let # b c = 1; - in f; + in + f + ; a = let # b c = 1; # e - in f; + in + f + ; a = let # b c = 1; # d - in f; + in + f + ; a = let # b c = 1; # d # e - in f; + in + f + ; a = let in [ 1 2 - ]; + ] ; -in a +in + a From 73e7ec4e3be4831d6f93b86b26342fc71c37d511 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 19 Apr 2023 00:46:03 +0200 Subject: [PATCH 013/125] Rework if statements - Disallow single-line if statements - Handle multi-line conditions differently (indent instead of absorb) --- src/Nixfmt/Pretty.hs | 10 +- test/diff/idioms_lib_1/out.nix | 7 +- test/diff/idioms_lib_2/out.nix | 130 ++++++++++++--- test/diff/idioms_lib_3/out.nix | 123 +++++++++++--- test/diff/idioms_nixos_1/out.nix | 4 +- test/diff/idioms_pkgs_3/out.nix | 4 +- test/diff/if_else/out.nix | 272 ++++++++++++++++++++++++++----- 7 files changed, 455 insertions(+), 95 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 036b8cb5..f5c5e443 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -184,9 +184,11 @@ absorb left right (Just level) x absorbSet :: Expression -> Doc absorbSet = absorb line mempty Nothing +-- Don't absorb the if body, always force content on new line absorbThen :: Expression -> Doc +-- XXX this should be removed, but does not appear to work anyways? absorbThen (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace -absorbThen x = line <> nest 2 (group x) <> line +absorbThen x = hardline <> nest 2 (group x) <> hardline -- What is allowed to come on the same line as `in`? -- Absorbable terms like sets @@ -198,12 +200,13 @@ absorbIn x@(With _ _ _ _) = group x absorbIn x@(Let _ _ _ _) = group x absorbIn x = line <> nest 2 (group x) <> line +-- Only absorb "else if" absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) = hardspace <> pretty if_ <> hardspace <> group cond <> hardspace <> pretty then_ <> absorbThen expr0 <> pretty else_ <> absorbElse expr1 - +-- XXX Same as for Then absorbElse (Term t) | isAbsorbable t = hardspace <> prettyTerm t absorbElse x = line <> nest 2 (group x) @@ -238,7 +241,8 @@ instance Pretty Expression where pretty (If if_ cond then_ expr0 else_ expr1) = base $ group $ - pretty if_ <> hardspace <> group cond <> hardspace + -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) + pretty if_ <> hardspace <> line' <> nest 2 (group cond) <> hardspace <> line' <> pretty then_ <> absorbThen expr0 <> pretty else_ <> absorbElse expr1 diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix index 3c4520d9..310240a7 100644 --- a/test/diff/idioms_lib_1/out.nix +++ b/test/diff/idioms_lib_1/out.nix @@ -6,5 +6,10 @@ msg: # Value to return x: - if pred then trace msg x else x; + if + pred + then + trace msg x + else + x; } diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index f570eda5..e2fa6c58 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -93,16 +93,31 @@ rec { and = x: y: x && y; # bitwise “and” - bitAnd = builtins.bitAnd or (import ./zip-int-bits.nix - (a: b: if a == 1 && b == 1 then 1 else 0)); + bitAnd = builtins.bitAnd or (import ./zip-int-bits.nix (a: b: + if + a == 1 && b == 1 + then + 1 + else + 0)); # bitwise “or” - bitOr = builtins.bitOr or (import ./zip-int-bits.nix - (a: b: if a == 1 || b == 1 then 1 else 0)); + bitOr = builtins.bitOr or (import ./zip-int-bits.nix (a: b: + if + a == 1 || b == 1 + then + 1 + else + 0)); # bitwise “xor” - bitXor = builtins.bitXor or (import ./zip-int-bits.nix - (a: b: if a != b then 1 else 0)); + bitXor = builtins.bitXor or (import ./zip-int-bits.nix (a: b: + if + a != b + then + 1 + else + 0)); # bitwise “not” bitNot = builtins.sub (-1); @@ -115,7 +130,13 @@ rec { Type: boolToString :: bool -> string */ - boolToString = b: if b then "true" else "false"; + boolToString = b: + if + b + then + "true" + else + "false"; /* Merge two attribute sets shallowly, right side trumps left @@ -155,7 +176,12 @@ rec { f: # Argument to check for null before passing it to `f` a: - if a == null then a else f a; + if + a == null + then + a + else + f a; # Pull in some builtins not included elsewhere. inherit (builtins) @@ -180,7 +206,9 @@ rec { # Returns the current nixpkgs version suffix as string. versionSuffix = let suffixFile = ../.version-suffix; - in if pathExists suffixFile then + in if + pathExists suffixFile + then lib.strings.fileContents suffixFile else "pre-git"; @@ -196,7 +224,9 @@ rec { let revisionFile = "${toString ./..}/.git-revision"; gitRepo = "${toString ./..}/.git"; - in if lib.pathIsGitRepo gitRepo then + in if + lib.pathIsGitRepo gitRepo + then lib.commitIdFromGitRepo gitRepo else if lib.pathExists revisionFile then lib.fileContents revisionFile @@ -216,10 +246,22 @@ rec { ## Integer operations # Return minimum of two numbers. - min = x: y: if x < y then x else y; + min = x: y: + if + x < y + then + x + else + y; # Return maximum of two numbers. - max = x: y: if x > y then x else y; + max = x: y: + if + x > y + then + x + else + y; /* Integer modulus @@ -239,7 +281,15 @@ rec { a == b, compare a b => 0 a > b, compare a b => 1 */ - compare = a: b: if a < b then -1 else if a > b then 1 else 0; + compare = a: b: + if + a < b + then + -1 + else if a > b then + 1 + else + 0; /* Split type into two subtypes by predicate `p`, take all elements of the first subtype to be less than all the elements of the @@ -270,7 +320,19 @@ rec { a: # Second value to compare b: - if p a then if p b then yes a b else -1 else if p b then 1 else no a b; + if + p a + then + if + p b + then + yes a b + else + -1 + else if p b then + 1 + else + no a b; /* Reads a JSON file. @@ -308,11 +370,13 @@ rec { Type: string -> a -> a */ - warn = if lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ - "1" - "true" - "yes" - ] then + warn = if + lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ + "1" + "true" + "yes" + ] + then msg: builtins.trace "warning: ${msg}" (abort "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") @@ -323,7 +387,13 @@ rec { Type: bool -> string -> a -> a */ - warnIf = cond: msg: if cond then warn msg else id; + warnIf = cond: msg: + if + cond + then + warn msg + else + id; /* Like the `assert b; e` expression, but with a custom error message and without the semicolon. @@ -343,7 +413,13 @@ rec { lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays pkgs */ - throwIfNot = cond: msg: if cond then x: x else throw msg; + throwIfNot = cond: msg: + if + cond + then + x: x + else + throw msg; /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. @@ -396,7 +472,9 @@ rec { setFunctionArgs : (a → b) → Map String Bool. */ functionArgs = f: - if f ? __functor then + if + f ? __functor + then f.__functionArgs or (lib.functionArgs (f.__functor f)) else builtins.functionArgs f; @@ -419,7 +497,9 @@ rec { toHexString = i: let toHexDigit = d: - if d < 10 then + if + d < 10 + then toString d else { @@ -446,7 +526,9 @@ rec { toBaseDigits = base: i: let go = i: - if i < base then [ i ] else + if + i < base + then [ i ] else let r = i - ((i / base) * base); q = (i - r) / base; diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 8761e1c9..a21db911 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -36,7 +36,9 @@ in rec { err = t: v: abort ("generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}"); - in if isInt v then + in if + isInt v + then toString v # convert derivations to store paths else if lib.isDerivation v then @@ -94,8 +96,15 @@ in rec { }: let mkLine = k: v: mkKeyValue k v + "\n"; - mkLines = if listsAsDuplicateKeys then - k: v: map (mkLine k) (if lib.isList v then v else [ v ]) + mkLines = if + listsAsDuplicateKeys + then + k: v: + map (mkLine k) (if + lib.isList v + then + v + else [ v ]) else k: v: [ (mkLine k v) ]; in @@ -195,7 +204,9 @@ in rec { globalSection, sections, }: - (if globalSection == { } then + (if + globalSection == { } + then "" else (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) @@ -230,7 +241,9 @@ in rec { section = head sections; subsections = tail sections; subsection = concatStringsSep "." subsections; - in if containsQuote || subsections == [ ] then + in if + containsQuote || subsections == [ ] + then name else ''${section} "${subsection}"''; @@ -246,7 +259,9 @@ in rec { # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI gitFlattenAttrs = let recurse = path: value: - if isAttrs value && !lib.isDerivation value then + if + isAttrs value && !lib.isDerivation value + then lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) value else if length path > 1 then { @@ -291,10 +306,19 @@ in rec { "__pretty" ]; stepIntoAttr = evalNext: name: - if builtins.elem name specialAttrs then id else evalNext; + if + builtins.elem name specialAttrs + then + id + else + evalNext; transform = depth: - if depthLimit != null && depth > depthLimit then - if throwOnDepthLimit then + if + depthLimit != null && depth > depthLimit + then + if + throwOnDepthLimit + then throw "Exceeded maximum eval-depth limit of ${ toString depthLimit } while trying to evaluate with `generators.withRecursion'!" @@ -306,7 +330,9 @@ in rec { depth: v: let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); - in if isAttrs v then + in if + isAttrs v + then mapAttrs (stepIntoAttr evalNext) v else if isList v then map evalNext v @@ -337,15 +363,21 @@ in rec { with builtins; let isPath = v: typeOf v == "path"; - introSpace = if multiline then '' + introSpace = if + multiline + then '' ${indent} '' else " "; - outroSpace = if multiline then '' + outroSpace = if + multiline + then '' ${indent}'' else " "; - in if isInt v then + in if + isInt v + then toString v # toString loses precision on floats, so we use toJSON instead. This isn't perfect # as the resulting string may not parse back as a float (e.g. 42, 1e-06), but for @@ -376,11 +408,16 @@ in rec { lastLine = lib.last escapedLines; in "''" + introSpace - + concatStringsSep introSpace (lib.init escapedLines) - + (if lastLine == "" then outroSpace else introSpace + lastLine) - + "''" + + concatStringsSep introSpace (lib.init escapedLines) + (if + lastLine == "" + then + outroSpace + else + introSpace + lastLine) + "''" ; - in if multiline && length lines > 1 then + in if + multiline && length lines > 1 + then multilineResult else singlelineResult @@ -393,7 +430,9 @@ in rec { else if isPath v then toString v else if isList v then - if v == [ ] then + if + v == [ ] + then "[ ]" else "[" + introSpace @@ -403,14 +442,24 @@ in rec { let fna = lib.functionArgs v; showFnas = concatStringsSep ", " (libAttr.mapAttrsToList - (name: hasDefVal: if hasDefVal then name + "?" else name) fna); - in if fna == { } then + (name: hasDefVal: + if + hasDefVal + then + name + "?" + else + name) fna); + in if + fna == { } + then "" else "" else if isAttrs v then # apply pretty values if allowed - if allowPrettyValues && v ? __pretty && v ? val then + if + allowPrettyValues && v ? __pretty && v ? val + then v.__pretty v.val else if v == { } then "{ }" @@ -437,7 +486,9 @@ in rec { isFloat = builtins.isFloat or (x: false); expr = ind: x: with builtins; - if x == null then + if + x == null + then "" else if isBool x then bool ind x @@ -456,7 +507,13 @@ in rec { literal = ind: x: ind + x; - bool = ind: x: literal ind (if x then "" else ""); + bool = ind: x: + literal ind (if + x + then + "" + else + ""); int = ind: x: literal ind "${toString x}"; str = ind: x: literal ind "${x}"; key = ind: x: literal ind "${x}"; @@ -507,7 +564,9 @@ in rec { with builtins; let concatItems = lib.strings.concatStringsSep ", "; - in if isAttrs v then + in if + isAttrs v + then "{ ${ concatItems (lib.attrsets.mapAttrsToList (key: value: "${key} = ${toDhall args value}") v) @@ -515,9 +574,21 @@ in rec { else if isList v then "[ ${concatItems (map (toDhall args) v)} ]" else if isInt v then - "${if v < 0 then "" else "+"}${toString v}" + "${ + if + v < 0 + then + "" + else + "+" + }${toString v}" else if isBool v then - (if v then "True" else "False") + (if + v + then + "True" + else + "False") else if isFunction v then abort "generators.toDhall: cannot convert a function to Dhall" else if v == null then diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 9b14d57e..5d9d3b91 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -356,7 +356,9 @@ in { ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); # nixpkgs kernels are assumed to have all required features - assertions = if config.boot.kernelPackages.kernel ? features then + assertions = if + config.boot.kernelPackages.kernel ? features + then [ ] else let diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 9b14d57e..5d9d3b91 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -356,7 +356,9 @@ in { ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); # nixpkgs kernels are assumed to have all required features - assertions = if config.boot.kernelPackages.kernel ? features then + assertions = if + config.boot.kernelPackages.kernel ? features + then [ ] else let diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index 628141ab..5f912f4b 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -1,72 +1,266 @@ [ (if true then { version = "1.2.3"; } else { version = "3.2.1"; }) - (if true then '' + (if + true + then '' some text '' else '' other text '') - (if ./a then b else c) - (if a then b else c) + (if + ./a + then + b + else + c) + (if + a + then + b + else + c) (if # test - a # test + a # test then # test b # test else # test c) (if # test - a # test + a # test then # test b # test else # test c) - (if if a then b else c then b else if a then b else if a then b else c) - (if if a then b else c then + (if + if + a + then + b + else + c + then b else if a then b - else # x - if a then + else if a then b else c) - (if (if (if (if a then b else c) then - (if a then b else c) - else - (if a then b else c)) then - (if (if a then b else c) then - (if a then b else c) + (if + if + a + then + b else - (if a then b else c)) + c + then + b + else if a then + b + else # x + if a then + b else - (if (if a then b else c) then - (if a then b else c) - else - (if a then b else c))) then - (if (if (if a then b else c) then - (if a then b else c) + c) + (if + (if + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) + else + (if + a + then + b + else + c)) + then + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) + else + (if + a + then + b + else + c)) else - (if a then b else c)) then - (if (if a then b else c) then - (if a then b else c) + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) + else + (if + a + then + b + else + c))) + then + (if + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) else - (if a then b else c)) + (if + a + then + b + else + c)) + then + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) + else + (if + a + then + b + else + c)) else - (if (if a then b else c) then - (if a then b else c) + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) else - (if a then b else c))) + (if + a + then + b + else + c))) else - (if (if (if a then b else c) then - (if a then b else c) - else - (if a then b else c)) then - (if (if a then b else c) then - (if a then b else c) + (if + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) + else + (if + a + then + b + else + c)) + then + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) else - (if a then b else c)) + (if + a + then + b + else + c)) else - (if (if a then b else c) then - (if a then b else c) + (if + (if + a + then + b + else + c) + then + (if + a + then + b + else + c) else - (if a then b else c)))) + (if + a + then + b + else + c)))) ] From cd0acd392d7e2600b8fcb4d6abb07241bae4cea6 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 13:27:09 +0200 Subject: [PATCH 014/125] Don't indent `in` body anymore --- src/Nixfmt/Pretty.hs | 2 +- test/diff/apply/out.nix | 2 +- test/diff/comment/out.nix | 2 +- test/diff/idioms_lib_2/out.nix | 19 ++++++------- test/diff/idioms_lib_3/out.nix | 47 ++++++++++++++++---------------- test/diff/idioms_nixos_1/out.nix | 8 +++--- test/diff/idioms_pkgs_3/out.nix | 8 +++--- test/diff/lambda/out.nix | 2 +- test/diff/let_in/out.nix | 20 +++++++------- 9 files changed, 54 insertions(+), 56 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index f5c5e443..9f3f9e65 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -198,7 +198,7 @@ absorbIn (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace absorbIn x@(If _ _ _ _ _ _) = group x absorbIn x@(With _ _ _ _) = group x absorbIn x@(Let _ _ _ _) = group x -absorbIn x = line <> nest 2 (group x) <> line +absorbIn x = line <> group x <> line -- Only absorb "else if" absorbElse :: Expression -> Doc diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 1cdf5e2c..9b00a175 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -15,7 +15,7 @@ installMethod = "copy"; }); in - "${pkg}/lib/node_modules/${pname}/node_modules" + "${pkg}/lib/node_modules/${pname}/node_modules" ) outputs.subPackages)) } '' diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index 670504a7..01c854ba 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -72,7 +72,7 @@ d = 1; #7 in - d + d ) ({ diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index e2fa6c58..5c36db66 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -66,7 +66,7 @@ rec { let reverseApply = x: f: f x; in - builtins.foldl' reverseApply val functions + builtins.foldl' reverseApply val functions ; # note please don’t add a function like `compose = flip pipe`. @@ -435,12 +435,11 @@ rec { let unexpected = lib.subtractLists valid given; in - lib.throwIfNot (unexpected == [ ]) "${msg}: ${ - builtins.concatStringsSep ", " - (builtins.map builtins.toString unexpected) - } unexpected; valid ones: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString valid) - }" + lib.throwIfNot (unexpected == [ ]) "${msg}: ${ + builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) + } unexpected; valid ones: ${ + builtins.concatStringsSep ", " (builtins.map builtins.toString valid) + }" ; info = msg: builtins.trace "INFO: ${msg}"; @@ -511,7 +510,7 @@ rec { "15" = "F"; }.${toString d}; in - lib.concatMapStrings toHexDigit (toBaseDigits 16 i) + lib.concatMapStrings toHexDigit (toBaseDigits 16 i) ; /* `toBaseDigits base i` converts the positive integer i to a list of its @@ -533,9 +532,9 @@ rec { r = i - ((i / base) * base); q = (i - r) / base; in - [ r ] ++ go q + [ r ] ++ go q ; in - assert (base >= 2); assert (i >= 0); lib.reverseList (go i) + assert (base >= 2); assert (i >= 0); lib.reverseList (go i) ; } diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index a21db911..9409840a 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -108,9 +108,9 @@ in rec { else k: v: [ (mkLine k v) ]; in - attrs: - libStr.concatStrings - (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) + attrs: + libStr.concatStrings + (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) ; # Generate an INI-style config file from an @@ -155,7 +155,7 @@ in rec { '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; # map input to ini sections in - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs ; # Generate an INI-style config file from an attrset @@ -253,7 +253,7 @@ in rec { let mkKeyValue = mkKeyValueDefault { } " = " k; in - concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)) + concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)) ; # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI @@ -271,13 +271,12 @@ in rec { ${head path} = value; }; in - attrs: - lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) + attrs: lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) ; toINI_ = toINI { inherit mkKeyValue mkSectionName; }; in - toINI_ (gitFlattenAttrs attrs) + toINI_ (gitFlattenAttrs attrs) ; # Generates JSON from an arbitrary (non-function) value. @@ -339,7 +338,7 @@ in rec { else transform (depth + 1) v; in - mapAny 0 + mapAny 0 ; # Pretty print a value, akin to `builtins.trace`. @@ -407,13 +406,13 @@ in rec { # indentation level. Otherwise, '' is appended to the last line. lastLine = lib.last escapedLines; in - "''" + introSpace - + concatStringsSep introSpace (lib.init escapedLines) + (if - lastLine == "" - then - outroSpace - else - introSpace + lastLine) + "''" + "''" + introSpace + + concatStringsSep introSpace (lib.init escapedLines) + (if + lastLine == "" + then + outroSpace + else + introSpace + lastLine) + "''" ; in if multiline && length lines > 1 @@ -476,7 +475,7 @@ in rec { else abort "generators.toPretty: should never happen (v = ${v})"; in - go indent + go indent ; # PLIST handling @@ -540,13 +539,13 @@ in rec { attr = let attrFilter = name: value: name != "_module" && value != null; in - ind: x: - libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList - (name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ]) x)) + ind: x: + libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList + (name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ]) x)) ; in '' diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 5d9d3b91..4e0bcc08 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -364,10 +364,10 @@ in { let cfg = config.boot.kernelPackages.kernel.config; in - map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig ; }) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 5d9d3b91..4e0bcc08 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -364,10 +364,10 @@ in { let cfg = config.boot.kernelPackages.kernel.config; in - map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig ; }) diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 7cb68ead..0f417180 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -40,7 +40,7 @@ }: let in - pkgs + pkgs ) (a: diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index 9a8f92c1..8fc183fd 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -4,53 +4,53 @@ let b = 2; c = 3; in - d + d ; a = let c = 1; in - f + f ; a = let c = 1; # e in - f + f ; a = let c = 1; # d in - f + f ; a = let c = 1; # d # e in - f + f ; a = let # b c = 1; in - f + f ; a = let # b c = 1; # e in - f + f ; a = let # b c = 1; # d in - f + f ; a = let # b c = 1; # d # e in - f + f ; a = let @@ -60,4 +60,4 @@ let ] ; in - a +a From 8315ca3a983501a56c5ae21bcc2316dc87bfdf30 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 14:02:31 +0200 Subject: [PATCH 015/125] Rework `inherit` statements - The (from) case needs to be improved - Somehow it indents the comments *after* the statement now, no idea why or how to fix --- src/Nixfmt/Pretty.hs | 11 +- test/diff/idioms_lib_2/out.nix | 22 +- test/diff/inherit/out.nix | 38 ++- test/diff/inherit_blank_trailing/out.nix | 12 +- test/diff/inherit_comment/out.nix | 8 +- test/diff/inherit_from/in.nix | 9 + test/diff/inherit_from/out.nix | 373 ++++++++++++++--------- test/diff/monsters_1/out.nix | 5 +- test/diff/monsters_4/out.nix | 3 +- test/diff/monsters_5/out.nix | 18 +- 10 files changed, 316 insertions(+), 183 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 9f3f9e65..2fd92170 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -69,16 +69,19 @@ instance Pretty Selector where = pretty dot <> pretty sel <> hardspace <> pretty kw <> hardspace <> pretty def +-- in attrsets and let bindings instance Pretty Binder where + -- `inherit bar` statement pretty (Inherit inherit Nothing ids semicolon) - = base $ group (pretty inherit <> softline - <> nest 2 (sepBy softline ids)) <> pretty semicolon + = base $ group (pretty inherit <> line + <> nest 2 (sepBy line ids <> line' <> pretty semicolon)) + -- `inherit (foo) bar` statement pretty (Inherit inherit source ids semicolon) = base $ group (pretty inherit <> hardspace - <> pretty source <> line - <> nest 2 (sepBy softline ids)) <> pretty semicolon + <> nest 2 ((pretty source) <> line <> sepBy line ids <> line' <> pretty semicolon)) + -- `foo = bar` pretty (Assignment selectors assign expr semicolon) = base $ group (hcat selectors <> hardspace <> nest 2 (pretty assign <> softline <> pretty expr)) diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 5c36db66..43b8b9b8 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -185,12 +185,22 @@ rec { # Pull in some builtins not included elsewhere. inherit (builtins) - pathExists readFile isBool isInt isFloat add sub lessThan seq deepSeq - genericClosure; - - ## nixpkgs version strings - - # Returns the current full nixpkgs version number. + pathExists + readFile + isBool + isInt + isFloat + add + sub + lessThan + seq + deepSeq + genericClosure + ; + + ## nixpkgs version strings + + # Returns the current full nixpkgs version number. version = release + versionSuffix; # Returns the current nixpkgs release number as string. diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index 0717536b..31f53916 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -7,37 +7,46 @@ } { inherit b d; } { - inherit b d # e - ; + inherit + b + d # e + ; } { - inherit b # c - d; + inherit + b # c + d + ; } { - inherit b # c + inherit + b # c d # e - ; + ; } { inherit # a - b d; + b + d + ; } { inherit # a - b d # e - ; + b + d # e + ; } { inherit # a b # c - d; + d + ; } { inherit # a b # c d # e - ; + ; } { inherit # test @@ -47,8 +56,11 @@ c # test d # test - e f + e + f - g h; + g + h + ; } ] diff --git a/test/diff/inherit_blank_trailing/out.nix b/test/diff/inherit_blank_trailing/out.nix index cac91152..7e8b2469 100644 --- a/test/diff/inherit_blank_trailing/out.nix +++ b/test/diff/inherit_blank_trailing/out.nix @@ -7,12 +7,16 @@ c # test d # test - e f + e + f - g h; + g + h + ; } { - inherit a # mixed trivialities + inherit + a # mixed trivialities # comment 1 # comment 2 @@ -24,6 +28,6 @@ # comment 1 # comment 2 # comment 3 - ; + ; } ] diff --git a/test/diff/inherit_comment/out.nix b/test/diff/inherit_comment/out.nix index 83721a44..a8d2746e 100644 --- a/test/diff/inherit_comment/out.nix +++ b/test/diff/inherit_comment/out.nix @@ -2,9 +2,10 @@ inherit # eeby deeby a # b - c; + c + ; - # https://github.com/kamadorueda/alejandra/issues/372 + # https://github.com/kamadorueda/alejandra/issues/372 inherit (pkgs.haskell.lib) # doJailbreak - remove package bounds from build-depends of a package doJailbreak @@ -12,5 +13,6 @@ dontCheck # override deps of a package # see what can be overriden - https://github.com/NixOS/nixpkgs/blob/0ba44a03f620806a2558a699dba143e6cf9858db/pkgs/development/haskell-modules/generic-builder.nix#L13 - overrideCabal; + overrideCabal + ; } diff --git a/test/diff/inherit_from/in.nix b/test/diff/inherit_from/in.nix index 691cf365..d1175b68 100644 --- a/test/diff/inherit_from/in.nix +++ b/test/diff/inherit_from/in.nix @@ -1,4 +1,13 @@ [ + { + inherit (builtins) + pathExists readFile isBool + isInt isFloat add sub lessThan + seq deepSeq genericClosure; + } + { + inherit ({ foo = "1"; bar = "2"; /* force multiline */}) foo bar; + } { inherit ( c ) f h ; } { inherit ( c ) f h /*i*/; } { inherit ( c ) f /*g*/ h ; } diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 449e9f13..bb746aad 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -1,155 +1,206 @@ [ + { + inherit (builtins) + pathExists + readFile + isBool + isInt + isFloat + add + sub + lessThan + seq + deepSeq + genericClosure + ; + } + { + inherit ({ + foo = "1"; + bar = "2"; # force multiline + }) + foo + bar + ; + } { inherit (c) f h; } { - inherit (c) f h # i - ; + inherit (c) + f + h # i + ; } { inherit (c) f # g - h; + h + ; } { inherit (c) f # g h # i - ; + ; } { inherit (c) # e - f h; + f + h + ; } { inherit (c) # e - f h # i - ; + f + h # i + ; } { inherit (c) # e f # g - h; + h + ; } { inherit (c) # e f # g h # i - ; + ; } { inherit (c # d ) - f h; + f + h + ; } { inherit (c # d ) - f h # i - ; + f + h # i + ; } { inherit (c # d ) f # g - h; + h + ; } { inherit (c # d ) f # g h # i - ; + ; } { inherit (c # d ) # e - f h; + f + h + ; } { inherit (c # d ) # e - f h # i - ; + f + h # i + ; } { inherit (c # d ) # e f # g - h; + h + ; } { inherit (c # d ) # e f # g h # i - ; + ; } { inherit ( # b c) - f h; + f + h + ; } { inherit ( # b c) - f h # i - ; + f + h # i + ; } { inherit ( # b c) f # g - h; + h + ; } { inherit ( # b c) f # g h # i - ; + ; } { inherit ( # b c) # e - f h; + f + h + ; } { inherit ( # b c) # e - f h # i - ; + f + h # i + ; } { inherit ( # b c) # e f # g - h; + h + ; } { inherit ( # b c) # e f # g h # i - ; + ; } { inherit ( # b c # d ) - f h; + f + h + ; } { inherit ( # b c # d ) - f h # i - ; + f + h # i + ; } { inherit ( # b c # d ) f # g - h; + h + ; } { inherit ( # b @@ -157,27 +208,31 @@ ) f # g h # i - ; + ; } { inherit ( # b c # d ) # e - f h; + f + h + ; } { inherit ( # b c # d ) # e - f h # i - ; + f + h # i + ; } { inherit ( # b c # d ) # e f # g - h; + h + ; } { inherit ( # b @@ -185,230 +240,262 @@ ) # e f # g h # i - ; + ; } { inherit # a - (c) - f h; + (c) + f + h + ; } { inherit # a - (c) - f h # i - ; + (c) + f + h # i + ; } { inherit # a - (c) + (c) f # g - h; + h + ; } { inherit # a - (c) + (c) f # g h # i - ; + ; } { inherit # a - (c) # e - f h; + (c) # e + f + h + ; } { inherit # a - (c) # e - f h # i - ; + (c) # e + f + h # i + ; } { inherit # a - (c) # e + (c) # e f # g - h; + h + ; } { inherit # a - (c) # e + (c) # e f # g h # i - ; + ; } { inherit # a - (c # d - ) - f h; + (c # d + ) + f + h + ; } { inherit # a - (c # d - ) - f h # i - ; + (c # d + ) + f + h # i + ; } { inherit # a - (c # d - ) + (c # d + ) f # g - h; + h + ; } { inherit # a - (c # d - ) + (c # d + ) f # g h # i - ; + ; } { inherit # a - (c # d - ) # e - f h; + (c # d + ) # e + f + h + ; } { inherit # a - (c # d - ) # e - f h # i - ; + (c # d + ) # e + f + h # i + ; } { inherit # a - (c # d - ) # e + (c # d + ) # e f # g - h; + h + ; } { inherit # a - (c # d - ) # e + (c # d + ) # e f # g h # i - ; + ; } { inherit # a - ( # b - c) - f h; + ( # b + c) + f + h + ; } { inherit # a - ( # b - c) - f h # i - ; + ( # b + c) + f + h # i + ; } { inherit # a - ( # b - c) + ( # b + c) f # g - h; + h + ; } { inherit # a - ( # b - c) + ( # b + c) f # g h # i - ; + ; } { inherit # a - ( # b - c) # e - f h; + ( # b + c) # e + f + h + ; } { inherit # a - ( # b - c) # e - f h # i - ; + ( # b + c) # e + f + h # i + ; } { inherit # a - ( # b - c) # e + ( # b + c) # e f # g - h; + h + ; } { inherit # a - ( # b - c) # e + ( # b + c) # e f # g h # i - ; + ; } { inherit # a - ( # b - c # d - ) - f h; + ( # b + c # d + ) + f + h + ; } { inherit # a - ( # b - c # d - ) - f h # i - ; + ( # b + c # d + ) + f + h # i + ; } { inherit # a - ( # b - c # d - ) + ( # b + c # d + ) f # g - h; + h + ; } { inherit # a - ( # b - c # d - ) + ( # b + c # d + ) f # g h # i - ; + ; } { inherit # a - ( # b - c # d - ) # e - f h; + ( # b + c # d + ) # e + f + h + ; } { inherit # a - ( # b - c # d - ) # e - f h # i - ; + ( # b + c # d + ) # e + f + h # i + ; } { inherit # a - ( # b - c # d - ) # e + ( # b + c # d + ) # e f # g - h; + h + ; } { inherit # a - ( # b - c # d - ) # e + ( # b + c # d + ) # e f # g h # i - ; + ; } ] diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index 02d7ee2b..f1b408a9 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -139,8 +139,9 @@ rec # foo inherit # foo - src; - # foo + src + ; + # foo name # foo = diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 9360bc69..10c74252 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -69,7 +69,8 @@ rec # Foo rustPlatform.fetchCargoTarball # Foo { # Foo inherit # Foo - src; # Foo + src + ; # Foo name # Foo = # Foo "${pname}-${version}"; # Foo diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index af37fdaa..f580e883 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -18,23 +18,26 @@ let inherit - (config.boot) + (config.boot) - kernelPatches; + kernelPatches + ; inherit - (config.boot.kernel) + (config.boot.kernel) features - randstructSeed; + randstructSeed + ; inherit - (config.boot.kernelPackages) + (config.boot.kernelPackages) - kernel; + kernel + ; kernelModulesConf @@ -158,7 +161,8 @@ in { inherit - randstructSeed; + randstructSeed + ; kernelPatches From 28a54b3557f32638ec798fb7e057b07da4677129 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 14:29:02 +0200 Subject: [PATCH 016/125] fixup! Rework if statements --- src/Nixfmt/Pretty.hs | 20 ++-- test/diff/idioms_lib_1/out.nix | 4 +- test/diff/idioms_lib_2/out.nix | 70 ++++--------- test/diff/idioms_lib_3/out.nix | 126 ++++++++-------------- test/diff/idioms_nixos_1/out.nix | 4 +- test/diff/idioms_pkgs_3/out.nix | 4 +- test/diff/if_else/in.nix | 25 +++++ test/diff/if_else/out.nix | 174 +++++++++++++------------------ 8 files changed, 171 insertions(+), 256 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 2fd92170..8ec7a8df 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -187,12 +187,6 @@ absorb left right (Just level) x absorbSet :: Expression -> Doc absorbSet = absorb line mempty Nothing --- Don't absorb the if body, always force content on new line -absorbThen :: Expression -> Doc --- XXX this should be removed, but does not appear to work anyways? -absorbThen (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace -absorbThen x = hardline <> nest 2 (group x) <> hardline - -- What is allowed to come on the same line as `in`? -- Absorbable terms like sets -- if, with, let @@ -206,12 +200,12 @@ absorbIn x = line <> group x <> line -- Only absorb "else if" absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) - = hardspace <> pretty if_ <> hardspace <> group cond <> hardspace - <> pretty then_ <> absorbThen expr0 + -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) + = hardspace <> (group (pretty if_ <> nest 2 (line <> pretty cond <> line) <> pretty then_)) + <> hardline <> nest 2 (group expr0) <> hardline <> pretty else_ <> absorbElse expr1 --- XXX Same as for Then -absorbElse (Term t) | isAbsorbable t = hardspace <> prettyTerm t -absorbElse x = line <> nest 2 (group x) +absorbElse x + = hardline <> nest 2 (group x) absorbApp :: Expression -> Doc absorbApp (Application f x) = softline <> pretty f <> absorbApp x @@ -245,8 +239,8 @@ instance Pretty Expression where pretty (If if_ cond then_ expr0 else_ expr1) = base $ group $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - pretty if_ <> hardspace <> line' <> nest 2 (group cond) <> hardspace <> line' - <> pretty then_ <> absorbThen expr0 + (group (pretty if_ <> nest 2 (line <> pretty cond <> line) <> pretty then_)) + <> hardline <> nest 2 (group expr0) <> hardline <> pretty else_ <> absorbElse expr1 pretty (Abstraction (IDParameter param) colon body) diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix index 310240a7..8f28264f 100644 --- a/test/diff/idioms_lib_1/out.nix +++ b/test/diff/idioms_lib_1/out.nix @@ -6,9 +6,7 @@ msg: # Value to return x: - if - pred - then + if pred then trace msg x else x; diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 43b8b9b8..205d1897 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -94,27 +94,21 @@ rec { # bitwise “and” bitAnd = builtins.bitAnd or (import ./zip-int-bits.nix (a: b: - if - a == 1 && b == 1 - then + if a == 1 && b == 1 then 1 else 0)); # bitwise “or” bitOr = builtins.bitOr or (import ./zip-int-bits.nix (a: b: - if - a == 1 || b == 1 - then + if a == 1 || b == 1 then 1 else 0)); # bitwise “xor” bitXor = builtins.bitXor or (import ./zip-int-bits.nix (a: b: - if - a != b - then + if a != b then 1 else 0)); @@ -131,9 +125,7 @@ rec { Type: boolToString :: bool -> string */ boolToString = b: - if - b - then + if b then "true" else "false"; @@ -176,9 +168,7 @@ rec { f: # Argument to check for null before passing it to `f` a: - if - a == null - then + if a == null then a else f a; @@ -216,9 +206,7 @@ rec { # Returns the current nixpkgs version suffix as string. versionSuffix = let suffixFile = ../.version-suffix; - in if - pathExists suffixFile - then + in if pathExists suffixFile then lib.strings.fileContents suffixFile else "pre-git"; @@ -234,9 +222,7 @@ rec { let revisionFile = "${toString ./..}/.git-revision"; gitRepo = "${toString ./..}/.git"; - in if - lib.pathIsGitRepo gitRepo - then + in if lib.pathIsGitRepo gitRepo then lib.commitIdFromGitRepo gitRepo else if lib.pathExists revisionFile then lib.fileContents revisionFile @@ -257,18 +243,14 @@ rec { # Return minimum of two numbers. min = x: y: - if - x < y - then + if x < y then x else y; # Return maximum of two numbers. max = x: y: - if - x > y - then + if x > y then x else y; @@ -292,9 +274,7 @@ rec { a > b, compare a b => 1 */ compare = a: b: - if - a < b - then + if a < b then -1 else if a > b then 1 @@ -330,12 +310,8 @@ rec { a: # Second value to compare b: - if - p a - then - if - p b - then + if p a then + if p b then yes a b else -1 @@ -398,9 +374,7 @@ rec { Type: bool -> string -> a -> a */ warnIf = cond: msg: - if - cond - then + if cond then warn msg else id; @@ -424,9 +398,7 @@ rec { pkgs */ throwIfNot = cond: msg: - if - cond - then + if cond then x: x else throw msg; @@ -481,9 +453,7 @@ rec { setFunctionArgs : (a → b) → Map String Bool. */ functionArgs = f: - if - f ? __functor - then + if f ? __functor then f.__functionArgs or (lib.functionArgs (f.__functor f)) else builtins.functionArgs f; @@ -506,9 +476,7 @@ rec { toHexString = i: let toHexDigit = d: - if - d < 10 - then + if d < 10 then toString d else { @@ -535,9 +503,9 @@ rec { toBaseDigits = base: i: let go = i: - if - i < base - then [ i ] else + if i < base then + [ i ] + else let r = i - ((i / base) * base); q = (i - r) / base; diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 9409840a..cb4a2184 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -36,9 +36,7 @@ in rec { err = t: v: abort ("generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}"); - in if - isInt v - then + in if isInt v then toString v # convert derivations to store paths else if lib.isDerivation v then @@ -96,15 +94,12 @@ in rec { }: let mkLine = k: v: mkKeyValue k v + "\n"; - mkLines = if - listsAsDuplicateKeys - then + mkLines = if listsAsDuplicateKeys then k: v: - map (mkLine k) (if - lib.isList v - then + map (mkLine k) (if lib.isList v then v - else [ v ]) + else + [ v ]) else k: v: [ (mkLine k v) ]; in @@ -204,9 +199,7 @@ in rec { globalSection, sections, }: - (if - globalSection == { } - then + (if globalSection == { } then "" else (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) @@ -241,9 +234,7 @@ in rec { section = head sections; subsections = tail sections; subsection = concatStringsSep "." subsections; - in if - containsQuote || subsections == [ ] - then + in if containsQuote || subsections == [ ] then name else ''${section} "${subsection}"''; @@ -259,17 +250,17 @@ in rec { # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI gitFlattenAttrs = let recurse = path: value: - if - isAttrs value && !lib.isDerivation value - then + if isAttrs value && !lib.isDerivation value then lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) value - else if length path > 1 then { - ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = - value; - } else { - ${head path} = value; - }; + else if length path > 1 then + { + ${concatStringsSep "." (lib.reverseList (tail path))}.${ + head path + } = value; + } + else + { ${head path} = value; }; in attrs: lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) ; @@ -305,19 +296,13 @@ in rec { "__pretty" ]; stepIntoAttr = evalNext: name: - if - builtins.elem name specialAttrs - then + if builtins.elem name specialAttrs then id else evalNext; transform = depth: - if - depthLimit != null && depth > depthLimit - then - if - throwOnDepthLimit - then + if depthLimit != null && depth > depthLimit then + if throwOnDepthLimit then throw "Exceeded maximum eval-depth limit of ${ toString depthLimit } while trying to evaluate with `generators.withRecursion'!" @@ -329,9 +314,7 @@ in rec { depth: v: let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); - in if - isAttrs v - then + in if isAttrs v then mapAttrs (stepIntoAttr evalNext) v else if isList v then map evalNext v @@ -362,21 +345,19 @@ in rec { with builtins; let isPath = v: typeOf v == "path"; - introSpace = if - multiline - then '' + introSpace = if multiline then + '' - ${indent} '' else + ${indent} '' + else " "; - outroSpace = if - multiline - then '' + outroSpace = if multiline then + '' - ${indent}'' else + ${indent}'' + else " "; - in if - isInt v - then + in if isInt v then toString v # toString loses precision on floats, so we use toJSON instead. This isn't perfect # as the resulting string may not parse back as a float (e.g. 42, 1e-06), but for @@ -407,16 +388,13 @@ in rec { lastLine = lib.last escapedLines; in "''" + introSpace - + concatStringsSep introSpace (lib.init escapedLines) + (if - lastLine == "" - then + + concatStringsSep introSpace (lib.init escapedLines) + + (if lastLine == "" then outroSpace else introSpace + lastLine) + "''" ; - in if - multiline && length lines > 1 - then + in if multiline && length lines > 1 then multilineResult else singlelineResult @@ -429,9 +407,7 @@ in rec { else if isPath v then toString v else if isList v then - if - v == [ ] - then + if v == [ ] then "[ ]" else "[" + introSpace @@ -442,23 +418,19 @@ in rec { fna = lib.functionArgs v; showFnas = concatStringsSep ", " (libAttr.mapAttrsToList (name: hasDefVal: - if - hasDefVal - then + if hasDefVal then name + "?" else name) fna); - in if - fna == { } - then + in if fna == { } then "" else "" - else if isAttrs v then + else if + isAttrs v + then # apply pretty values if allowed - if - allowPrettyValues && v ? __pretty && v ? val - then + if allowPrettyValues && v ? __pretty && v ? val then v.__pretty v.val else if v == { } then "{ }" @@ -485,9 +457,7 @@ in rec { isFloat = builtins.isFloat or (x: false); expr = ind: x: with builtins; - if - x == null - then + if x == null then "" else if isBool x then bool ind x @@ -507,9 +477,7 @@ in rec { literal = ind: x: ind + x; bool = ind: x: - literal ind (if - x - then + literal ind (if x then "" else ""); @@ -563,9 +531,7 @@ in rec { with builtins; let concatItems = lib.strings.concatStringsSep ", "; - in if - isAttrs v - then + in if isAttrs v then "{ ${ concatItems (lib.attrsets.mapAttrsToList (key: value: "${key} = ${toDhall args value}") v) @@ -574,17 +540,13 @@ in rec { "[ ${concatItems (map (toDhall args) v)} ]" else if isInt v then "${ - if - v < 0 - then + if v < 0 then "" else "+" }${toString v}" else if isBool v then - (if - v - then + (if v then "True" else "False") diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 4e0bcc08..aec88cdc 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -356,9 +356,7 @@ in { ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); # nixpkgs kernels are assumed to have all required features - assertions = if - config.boot.kernelPackages.kernel ? features - then + assertions = if config.boot.kernelPackages.kernel ? features then [ ] else let diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 4e0bcc08..aec88cdc 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -356,9 +356,7 @@ in { ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); # nixpkgs kernels are assumed to have all required features - assertions = if - config.boot.kernelPackages.kernel ? features - then + assertions = if config.boot.kernelPackages.kernel ? features then [ ] else let diff --git a/test/diff/if_else/in.nix b/test/diff/if_else/in.nix index 5212aa73..eb3cec76 100644 --- a/test/diff/if_else/in.nix +++ b/test/diff/if_else/in.nix @@ -31,6 +31,31 @@ else # test /**/ c) + (if [ + multiline + # tmp + condition + ] then + foo + else if [ + more + multi + line + ] then + bar + else + baz + ) + (if unabsorbable # comment + == multiline + then + foo + else if unabsorbable # comment + == multiline then + bar + else + baz + ) (if if a then b else c then b else if a then b else if a then b else c) (if if a then b else c then b else if a then b else /*x*/ if a then b else c) (if diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index 5f912f4b..acb5206d 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -1,21 +1,21 @@ [ - (if true then { version = "1.2.3"; } else { version = "3.2.1"; }) - (if - true - then '' - some text - '' else '' - other text - '') - (if - ./a - then + (if true then + { version = "1.2.3"; } + else + { version = "3.2.1"; }) + (if true then + '' + some text + '' + else + '' + other text + '') + (if ./a then b else c) - (if - a - then + (if a then b else c) @@ -32,9 +32,37 @@ else # test c) (if - if - a - then + [ + multiline + # tmp + condition + ] + then + foo + else if + [ + more + multi + line + ] + then + bar + else + baz) + (if + unabsorbable # comment + == multiline + then + foo + else if + unabsorbable # comment + == multiline + then + bar + else + baz) + (if + if a then b else c @@ -47,9 +75,7 @@ else c) (if - if - a - then + if a then b else c @@ -65,201 +91,147 @@ (if (if (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)) then (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)) else (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c))) then (if (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)) then (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)) else (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c))) else (if (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)) then (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)) else (if - (if - a - then + (if a then b else c) then - (if - a - then + (if a then b else c) else - (if - a - then + (if a then b else c)))) From 7fe6a995e7383309e8b4e64137a6bfc6d6e13fb0 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 16:26:53 +0200 Subject: [PATCH 017/125] Add some code documentation --- src/Nixfmt/Predoc.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 4e1b41c6..05d0f5ad 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -39,13 +39,22 @@ import Data.Text as Text (Text, concat, length, pack, replicate) -- This means that e.g. a Space followed by an Emptyline results in just an -- Emptyline. data Spacing - = Softbreak + = + -- | Line break or nothing (soft) + Softbreak + -- | Line break or nothing | Break + -- | Always a space | Hardspace + -- | Line break or space (soft) | Softspace + -- | Line break or space | Space + -- | Always a line break | Hardline + -- | Two line breaks | Emptyline + -- | n line breaks | Newlines Int deriving (Show, Eq, Ord) @@ -105,24 +114,31 @@ nest level = pure . Node (Nest level) base :: Doc -> Doc base = pure . Node Base +-- | Line break or nothing (soft) softline' :: Doc softline' = [Spacing Softbreak] +-- | Line break or nothing line' :: Doc line' = [Spacing Break] +-- | Line break or space (soft) softline :: Doc softline = [Spacing Softspace] +-- | Line break or space line :: Doc line = [Spacing Space] +-- | Always space hardspace :: Doc hardspace = [Spacing Hardspace] +-- | Always line break hardline :: Doc hardline = [Spacing Hardline] +-- | Two line breaks emptyline :: Doc emptyline = [Spacing Emptyline] From e9cdac6a14fbd776c09a779791267b492ea3bf82 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 17:28:28 +0200 Subject: [PATCH 018/125] Rework bindings --- src/Nixfmt/Pretty.hs | 18 +- test/diff/apply/out.nix | 6 +- test/diff/attr_set/out.nix | 4 +- test/diff/comment/out.nix | 12 +- test/diff/idioms_lib_1/out.nix | 3 +- test/diff/idioms_lib_2/out.nix | 590 +++++++++++++++++-------------- test/diff/idioms_lib_3/out.nix | 449 ++++++++++++----------- test/diff/idioms_nixos_1/out.nix | 129 ++++--- test/diff/idioms_pkgs_3/out.nix | 129 ++++--- test/diff/key_value/out.nix | 38 +- test/diff/let_in/out.nix | 121 ++++--- test/diff/monsters_1/out.nix | 45 +-- test/diff/monsters_3/out.nix | 3 +- test/diff/monsters_4/out.nix | 3 +- test/diff/monsters_5/out.nix | 7 +- test/diff/with/out.nix | 5 +- 16 files changed, 869 insertions(+), 693 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 8ec7a8df..3a3d7b52 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -83,9 +83,21 @@ instance Pretty Binder where -- `foo = bar` pretty (Assignment selectors assign expr semicolon) - = base $ group (hcat selectors <> hardspace - <> nest 2 (pretty assign <> softline <> pretty expr)) - <> pretty semicolon + = base $ group $ hcat selectors <> hardspace + <> nest 2 (pretty assign <> absorbInner expr) + where + -- Function declaration / If statement / Let binding + -- If it is multi-line, force it into a new line with indentation, semicolon on separate line + absorbInner expr@(Abstraction _ _ _) = line <> pretty expr <> line' <> pretty semicolon + absorbInner expr@(If _ _ _ _ _ _) = line <> pretty expr <> line' <> pretty semicolon + absorbInner expr@(Let _ _ _ _) = line <> pretty expr <> line' <> pretty semicolon + -- Absorbable term (list/attrset) + -- force-absorb the term and then the semicolon + absorbInner expr@(Term t) | isAbsorbable t = hardspace <> group expr <> softline' <> pretty semicolon + -- `foo = bar`, otherwise + -- Try to absorb and keep the semicolon attached, spread otherwise + absorbInner expr = softline <> group (pretty expr <> softline' <> pretty semicolon) + -- | Pretty print a term without wrapping it in a group. prettyTerm :: Term -> Doc diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 9b00a175..87619c4b 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -57,10 +57,12 @@ } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { - outputs = { + outputs = + { utils, }: # For each supported platform, - utils.lib.eachDefaultSystem (system: { }); + utils.lib.eachDefaultSystem (system: { }) + ; } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index b95620b0..8cb17e75 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -71,11 +71,11 @@ c = 1; - # d + # d e = 1; - # f + # f } ] diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index 01c854ba..1f5f795f 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -52,12 +52,12 @@ a = 1; # 3 b = 1; c = 1; # 4 - #5 + #5 - #6 + #6 d = 1; - #7 + #7 } (let # 1 @@ -65,12 +65,12 @@ a = 1; # 3 b = 1; c = 1; # 4 - #5 + #5 - #6 + #6 d = 1; - #7 + #7 in d ) diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix index 8f28264f..50646a88 100644 --- a/test/diff/idioms_lib_1/out.nix +++ b/test/diff/idioms_lib_1/out.nix @@ -9,5 +9,6 @@ if pred then trace msg x else - x; + x + ; } diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 205d1897..7b42e87a 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -14,155 +14,173 @@ rec { id = # The value to return x: - x; + x + ; - /* The constant function + /* The constant function - Ignores the second argument. If called with only one argument, - constructs a function that always returns a static value. + Ignores the second argument. If called with only one argument, + constructs a function that always returns a static value. - Type: const :: a -> b -> a - Example: - let f = const 5; in f 10 - => 5 - */ + Type: const :: a -> b -> a + Example: + let f = const 5; in f 10 + => 5 + */ const = # Value to return x: # Value to ignore y: - x; + x + ; - /* Pipes a value through a list of functions, left to right. + /* Pipes a value through a list of functions, left to right. - Type: pipe :: a -> [] -> - Example: - pipe 2 [ - (x: x + 2) # 2 + 2 = 4 - (x: x * 2) # 4 * 2 = 8 - ] - => 8 + Type: pipe :: a -> [] -> + Example: + pipe 2 [ + (x: x + 2) # 2 + 2 = 4 + (x: x * 2) # 4 * 2 = 8 + ] + => 8 - # ideal to do text transformations - pipe [ "a/b" "a/c" ] [ + # ideal to do text transformations + pipe [ "a/b" "a/c" ] [ - # create the cp command - (map (file: ''cp "${src}/${file}" $out\n'')) + # create the cp command + (map (file: ''cp "${src}/${file}" $out\n'')) - # concatenate all commands into one string - lib.concatStrings + # concatenate all commands into one string + lib.concatStrings - # make that string into a nix derivation - (pkgs.runCommand "copy-to-out" {}) + # make that string into a nix derivation + (pkgs.runCommand "copy-to-out" {}) - ] - => + ] + => - The output type of each function has to be the input type - of the next function, and the last function returns the - final value. - */ - pipe = val: functions: + The output type of each function has to be the input type + of the next function, and the last function returns the + final value. + */ + pipe = + val: functions: let reverseApply = x: f: f x; in builtins.foldl' reverseApply val functions - ; + ; - # note please don’t add a function like `compose = flip pipe`. - # This would confuse users, because the order of the functions - # in the list is not clear. With pipe, it’s obvious that it - # goes first-to-last. With `compose`, not so much. + # note please don’t add a function like `compose = flip pipe`. + # This would confuse users, because the order of the functions + # in the list is not clear. With pipe, it’s obvious that it + # goes first-to-last. With `compose`, not so much. - ## Named versions corresponding to some builtin operators. + ## Named versions corresponding to some builtin operators. - /* Concatenate two lists + /* Concatenate two lists - Type: concat :: [a] -> [a] -> [a] + Type: concat :: [a] -> [a] -> [a] - Example: - concat [ 1 2 ] [ 3 4 ] - => [ 1 2 3 4 ] - */ - concat = x: y: x ++ y; + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] + */ + concat = + x: y: + x ++ y + ; - # boolean “or” - or = x: y: x || y; + # boolean “or” + or = + x: y: + x || y + ; - # boolean “and” - and = x: y: x && y; + # boolean “and” + and = + x: y: + x && y + ; - # bitwise “and” + # bitwise “and” bitAnd = builtins.bitAnd or (import ./zip-int-bits.nix (a: b: if a == 1 && b == 1 then 1 else 0)); - # bitwise “or” + # bitwise “or” bitOr = builtins.bitOr or (import ./zip-int-bits.nix (a: b: if a == 1 || b == 1 then 1 else 0)); - # bitwise “xor” + # bitwise “xor” bitXor = builtins.bitXor or (import ./zip-int-bits.nix (a: b: if a != b then 1 else 0)); - # bitwise “not” + # bitwise “not” bitNot = builtins.sub (-1); - /* Convert a boolean to a string. + /* Convert a boolean to a string. - This function uses the strings "true" and "false" to represent - boolean values. Calling `toString` on a bool instead returns "1" - and "" (sic!). + This function uses the strings "true" and "false" to represent + boolean values. Calling `toString` on a bool instead returns "1" + and "" (sic!). - Type: boolToString :: bool -> string - */ - boolToString = b: + Type: boolToString :: bool -> string + */ + boolToString = + b: if b then "true" else - "false"; + "false" + ; - /* Merge two attribute sets shallowly, right side trumps left + /* Merge two attribute sets shallowly, right side trumps left - mergeAttrs :: attrs -> attrs -> attrs + mergeAttrs :: attrs -> attrs -> attrs - Example: - mergeAttrs { a = 1; b = 2; } { b = 3; c = 4; } - => { a = 1; b = 3; c = 4; } - */ + Example: + mergeAttrs { a = 1; b = 2; } { b = 3; c = 4; } + => { a = 1; b = 3; c = 4; } + */ mergeAttrs = # Left attribute set x: # Right attribute set (higher precedence for equal keys) y: - x // y; + x // y + ; - /* Flip the order of the arguments of a binary function. + /* Flip the order of the arguments of a binary function. - Type: flip :: (a -> b -> c) -> (b -> a -> c) + Type: flip :: (a -> b -> c) -> (b -> a -> c) - Example: - flip concat [1] [2] - => [ 2 1 ] - */ - flip = f: a: b: f b a; + Example: + flip concat [1] [2] + => [ 2 1 ] + */ + flip = + f: a: b: + f b a + ; - /* Apply function if the supplied argument is non-null. + /* Apply function if the supplied argument is non-null. - Example: - mapNullable (x: x+1) null - => null - mapNullable (x: x+1) 22 - => 23 - */ + Example: + mapNullable (x: x+1) null + => null + mapNullable (x: x+1) 22 + => 23 + */ mapNullable = # Function to call f: @@ -171,9 +189,10 @@ rec { if a == null then a else - f a; + f a + ; - # Pull in some builtins not included elsewhere. + # Pull in some builtins not included elsewhere. inherit (builtins) pathExists readFile @@ -193,29 +212,31 @@ rec { # Returns the current full nixpkgs version number. version = release + versionSuffix; - # Returns the current nixpkgs release number as string. + # Returns the current nixpkgs release number as string. release = lib.strings.fileContents ../.version; - /* Returns the current nixpkgs release code name. + /* Returns the current nixpkgs release code name. - On each release the first letter is bumped and a new animal is chosen - starting with that new letter. - */ + On each release the first letter is bumped and a new animal is chosen + starting with that new letter. + */ codeName = "Quokka"; - # Returns the current nixpkgs version suffix as string. - versionSuffix = let - suffixFile = ../.version-suffix; - in if pathExists suffixFile then - lib.strings.fileContents suffixFile - else - "pre-git"; + # Returns the current nixpkgs version suffix as string. + versionSuffix = + let + suffixFile = ../.version-suffix; + in if pathExists suffixFile then + lib.strings.fileContents suffixFile + else + "pre-git" + ; - /* Attempts to return the the current revision of nixpkgs and - returns the supplied default value otherwise. + /* Attempts to return the the current revision of nixpkgs and + returns the supplied default value otherwise. - Type: revisionWithDefault :: string -> string - */ + Type: revisionWithDefault :: string -> string + */ revisionWithDefault = # Default value to return if revision can not be determined default: @@ -227,78 +248,88 @@ rec { else if lib.pathExists revisionFile then lib.fileContents revisionFile else - default; + default + ; nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version; - /* Determine whether the function is being called from inside a Nix - shell. + /* Determine whether the function is being called from inside a Nix + shell. - Type: inNixShell :: bool - */ + Type: inNixShell :: bool + */ inNixShell = builtins.getEnv "IN_NIX_SHELL" != ""; - ## Integer operations + ## Integer operations - # Return minimum of two numbers. - min = x: y: + # Return minimum of two numbers. + min = + x: y: if x < y then x else - y; + y + ; - # Return maximum of two numbers. - max = x: y: + # Return maximum of two numbers. + max = + x: y: if x > y then x else - y; - - /* Integer modulus + y + ; - Example: - mod 11 10 - => 1 - mod 1 10 - => 1 - */ - mod = base: int: base - (int * (builtins.div base int)); + /* Integer modulus + + Example: + mod 11 10 + => 1 + mod 1 10 + => 1 + */ + mod = + base: int: + base - (int * (builtins.div base int)) + ; - ## Comparisons + ## Comparisons - /* C-style comparisons + /* C-style comparisons - a < b, compare a b => -1 - a == b, compare a b => 0 - a > b, compare a b => 1 - */ - compare = a: b: + a < b, compare a b => -1 + a == b, compare a b => 0 + a > b, compare a b => 1 + */ + compare = + a: b: if a < b then -1 else if a > b then 1 else - 0; + 0 + ; - /* Split type into two subtypes by predicate `p`, take all elements - of the first subtype to be less than all the elements of the - second subtype, compare elements of a single subtype with `yes` - and `no` respectively. + /* Split type into two subtypes by predicate `p`, take all elements + of the first subtype to be less than all the elements of the + second subtype, compare elements of a single subtype with `yes` + and `no` respectively. - Type: (a -> bool) -> (a -> a -> int) -> (a -> a -> int) -> (a -> a -> int) + Type: (a -> bool) -> (a -> a -> int) -> (a -> a -> int) -> (a -> a -> int) - Example: - let cmp = splitByAndCompare (hasPrefix "foo") compare compare; in + Example: + let cmp = splitByAndCompare (hasPrefix "foo") compare compare; in - cmp "a" "z" => -1 - cmp "fooa" "fooz" => -1 + cmp "a" "z" => -1 + cmp "fooa" "fooz" => -1 - cmp "f" "a" => 1 - cmp "fooa" "a" => -1 - # while - compare "fooa" "a" => 1 - */ + cmp "f" "a" => 1 + cmp "fooa" "a" => -1 + # while + compare "fooa" "a" => 1 + */ splitByAndCompare = # Predicate p: @@ -318,102 +349,116 @@ rec { else if p b then 1 else - no a b; + no a b + ; - /* Reads a JSON file. + /* Reads a JSON file. - Type :: path -> any - */ - importJSON = path: builtins.fromJSON (builtins.readFile path); + Type :: path -> any + */ + importJSON = + path: + builtins.fromJSON (builtins.readFile path) + ; - /* Reads a TOML file. + /* Reads a TOML file. - Type :: path -> any - */ - importTOML = path: builtins.fromTOML (builtins.readFile path); - - ## Warnings - - # See https://github.com/NixOS/nix/issues/749. Eventually we'd like these - # to expand to Nix builtins that carry metadata so that Nix can filter out - # the INFO messages without parsing the message string. - # - # Usage: - # { - # foo = lib.warn "foo is deprecated" oldFoo; - # bar = lib.warnIf (bar == "") "Empty bar is deprecated" bar; - # } - # - # TODO: figure out a clever way to integrate location information from - # something like __unsafeGetAttrPos. - - /* Print a warning before returning the second argument. This function behaves - like `builtins.trace`, but requires a string message and formats it as a - warning, including the `warning: ` prefix. - - To get a call stack trace and abort evaluation, set the environment variable - `NIX_ABORT_ON_WARN=true` and set the Nix options `--option pure-eval false --show-trace` - - Type: string -> a -> a - */ - warn = if - lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ - "1" - "true" - "yes" - ] - then - msg: - builtins.trace "warning: ${msg}" (abort - "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") - else - msg: builtins.trace "warning: ${msg}"; - - /* Like warn, but only warn when the first argument is `true`. - - Type: bool -> string -> a -> a - */ - warnIf = cond: msg: + Type :: path -> any + */ + importTOML = + path: + builtins.fromTOML (builtins.readFile path) + ; + + ## Warnings + + # See https://github.com/NixOS/nix/issues/749. Eventually we'd like these + # to expand to Nix builtins that carry metadata so that Nix can filter out + # the INFO messages without parsing the message string. + # + # Usage: + # { + # foo = lib.warn "foo is deprecated" oldFoo; + # bar = lib.warnIf (bar == "") "Empty bar is deprecated" bar; + # } + # + # TODO: figure out a clever way to integrate location information from + # something like __unsafeGetAttrPos. + + /* Print a warning before returning the second argument. This function behaves + like `builtins.trace`, but requires a string message and formats it as a + warning, including the `warning: ` prefix. + + To get a call stack trace and abort evaluation, set the environment variable + `NIX_ABORT_ON_WARN=true` and set the Nix options `--option pure-eval false --show-trace` + + Type: string -> a -> a + */ + warn = + if + lib.elem (builtins.getEnv "NIX_ABORT_ON_WARN") [ + "1" + "true" + "yes" + ] + then + msg: + builtins.trace "warning: ${msg}" (abort + "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") + else + msg: builtins.trace "warning: ${msg}" + ; + + /* Like warn, but only warn when the first argument is `true`. + + Type: bool -> string -> a -> a + */ + warnIf = + cond: msg: if cond then warn msg else - id; + id + ; - /* Like the `assert b; e` expression, but with a custom error message and - without the semicolon. + /* Like the `assert b; e` expression, but with a custom error message and + without the semicolon. - If true, return the identity function, `r: r`. + If true, return the identity function, `r: r`. - If false, throw the error message. + If false, throw the error message. - Calls can be juxtaposed using function application, as `(r: r) a = a`, so - `(r: r) (r: r) a = a`, and so forth. + Calls can be juxtaposed using function application, as `(r: r) a = a`, so + `(r: r) (r: r) a = a`, and so forth. - Type: bool -> string -> a -> a + Type: bool -> string -> a -> a - Example: + Example: - throwIfNot (lib.isList overlays) "The overlays argument to nixpkgs must be a list." - lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays - pkgs - */ - throwIfNot = cond: msg: + throwIfNot (lib.isList overlays) "The overlays argument to nixpkgs must be a list." + lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays + pkgs + */ + throwIfNot = + cond: msg: if cond then x: x else - throw msg; + throw msg + ; - /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. + /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. - Example: - let colorVariants = ["bright" "dark" "black"] - in checkListOfEnum "color variants" [ "standard" "light" "dark" ] colorVariants; - => - error: color variants: bright, black unexpected; valid ones: standard, light, dark + Example: + let colorVariants = ["bright" "dark" "black"] + in checkListOfEnum "color variants" [ "standard" "light" "dark" ] colorVariants; + => + error: color variants: bright, black unexpected; valid ones: standard, light, dark - Type: String -> List ComparableVal -> List ComparableVal -> a -> a - */ - checkListOfEnum = msg: valid: given: + Type: String -> List ComparableVal -> List ComparableVal -> a -> a + */ + checkListOfEnum = + msg: valid: given: let unexpected = lib.subtractLists valid given; in @@ -422,60 +467,70 @@ rec { } unexpected; valid ones: ${ builtins.concatStringsSep ", " (builtins.map builtins.toString valid) }" - ; + ; info = msg: builtins.trace "INFO: ${msg}"; - showWarnings = warnings: res: lib.foldr (w: x: warn w x) res warnings; + showWarnings = + warnings: res: + lib.foldr (w: x: warn w x) res warnings + ; - ## Function annotations + ## Function annotations - /* Add metadata about expected function arguments to a function. - The metadata should match the format given by - builtins.functionArgs, i.e. a set from expected argument to a bool - representing whether that argument has a default or not. - setFunctionArgs : (a → b) → Map String Bool → (a → b) + /* Add metadata about expected function arguments to a function. + The metadata should match the format given by + builtins.functionArgs, i.e. a set from expected argument to a bool + representing whether that argument has a default or not. + setFunctionArgs : (a → b) → Map String Bool → (a → b) - This function is necessary because you can't dynamically create a - function of the { a, b ? foo, ... }: format, but some facilities - like callPackage expect to be able to query expected arguments. - */ + This function is necessary because you can't dynamically create a + function of the { a, b ? foo, ... }: format, but some facilities + like callPackage expect to be able to query expected arguments. + */ setFunctionArgs = f: args: { # TODO: Should we add call-time "type" checking like built in? __functor = self: f; __functionArgs = args; - }; + } + ; - /* Extract the expected function arguments from a function. - This works both with nix-native { a, b ? foo, ... }: style - functions and functions with args set with 'setFunctionArgs'. It - has the same return type and semantics as builtins.functionArgs. - setFunctionArgs : (a → b) → Map String Bool. - */ - functionArgs = f: + /* Extract the expected function arguments from a function. + This works both with nix-native { a, b ? foo, ... }: style + functions and functions with args set with 'setFunctionArgs'. It + has the same return type and semantics as builtins.functionArgs. + setFunctionArgs : (a → b) → Map String Bool. + */ + functionArgs = + f: if f ? __functor then f.__functionArgs or (lib.functionArgs (f.__functor f)) else - builtins.functionArgs f; + builtins.functionArgs f + ; - /* Check whether something is a function or something - annotated with function args. - */ - isFunction = f: - builtins.isFunction f || (f ? __functor && isFunction (f.__functor f)); + /* Check whether something is a function or something + annotated with function args. + */ + isFunction = + f: + builtins.isFunction f || (f ? __functor && isFunction (f.__functor f)) + ; - /* Convert the given positive integer to a string of its hexadecimal - representation. For example: + /* Convert the given positive integer to a string of its hexadecimal + representation. For example: - toHexString 0 => "0" + toHexString 0 => "0" - toHexString 16 => "10" + toHexString 16 => "10" - toHexString 250 => "FA" - */ - toHexString = i: + toHexString 250 => "FA" + */ + toHexString = + i: let - toHexDigit = d: + toHexDigit = + d: if d < 10 then toString d else @@ -486,23 +541,26 @@ rec { "13" = "D"; "14" = "E"; "15" = "F"; - }.${toString d}; + }.${toString d} + ; in lib.concatMapStrings toHexDigit (toBaseDigits 16 i) - ; + ; - /* `toBaseDigits base i` converts the positive integer i to a list of its - digits in the given base. For example: + /* `toBaseDigits base i` converts the positive integer i to a list of its + digits in the given base. For example: - toBaseDigits 10 123 => [ 1 2 3 ] + toBaseDigits 10 123 => [ 1 2 3 ] - toBaseDigits 2 6 => [ 1 1 0 ] + toBaseDigits 2 6 => [ 1 1 0 ] - toBaseDigits 16 250 => [ 15 10 ] - */ - toBaseDigits = base: i: + toBaseDigits 16 250 => [ 15 10 ] + */ + toBaseDigits = + base: i: let - go = i: + go = + i: if i < base then [ i ] else @@ -511,8 +569,8 @@ rec { q = (i - r) / base; in [ r ] ++ go q - ; + ; in assert (base >= 2); assert (i >= 0); lib.reverseList (go i) - ; + ; } diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index cb4a2184..e7844203 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -29,13 +29,16 @@ in rec { # Convert a value to a sensible default string representation. # The builtin `toString` function has some strange defaults, # suitable for bash scripts but not much else. - mkValueStringDefault = { }: + mkValueStringDefault = + { }: v: with builtins; let - err = t: v: + err = + t: v: abort ("generators.mkValueStringDefault: " - + "${t} not supported: ${toPretty { } v}"); + + "${t} not supported: ${toPretty { } v}") + ; in if isInt v then toString v # convert derivations to store paths @@ -67,67 +70,74 @@ in rec { else if isFloat v then libStr.floatToString v else - err "this value is" (toString v); + err "this value is" (toString v) + ; - # Generate a line of key k and value v, separated by - # character sep. If sep appears in k, it is escaped. - # Helper for synaxes with different separators. - # - # mkValueString specifies how values should be formatted. - # - # mkKeyValueDefault {} ":" "f:oo" "bar" - # > "f\:oo:bar" - mkKeyValueDefault = { + # Generate a line of key k and value v, separated by + # character sep. If sep appears in k, it is escaped. + # Helper for synaxes with different separators. + # + # mkValueString specifies how values should be formatted. + # + # mkKeyValueDefault {} ":" "f:oo" "bar" + # > "f\:oo:bar" + mkKeyValueDefault = + { mkValueString ? mkValueStringDefault { } }: sep: k: v: - "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; + "${libStr.escape [ sep ] k}${sep}${mkValueString v}" + ; - ## -- FILE FORMAT GENERATORS -- + ## -- FILE FORMAT GENERATORS -- - # Generate a key-value-style config file from an attrset. - # - # mkKeyValue is the same as in toINI. - toKeyValue = { + # Generate a key-value-style config file from an attrset. + # + # mkKeyValue is the same as in toINI. + toKeyValue = + { mkKeyValue ? mkKeyValueDefault { } "=", listsAsDuplicateKeys ? false }: let mkLine = k: v: mkKeyValue k v + "\n"; - mkLines = if listsAsDuplicateKeys then - k: v: - map (mkLine k) (if lib.isList v then - v + mkLines = + if listsAsDuplicateKeys then + k: v: + map (mkLine k) (if lib.isList v then + v + else + [ v ]) else - [ v ]) - else - k: v: [ (mkLine k v) ]; + k: v: [ (mkLine k v) ] + ; in attrs: libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) - ; + ; - # Generate an INI-style config file from an - # attrset of sections to an attrset of key-value pairs. - # - # generators.toINI {} { - # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; - # baz = { "also, integers" = 42; }; - # } - # - #> [baz] - #> also, integers=42 - #> - #> [foo] - #> ciao=bar - #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 - # - # The mk* configuration attributes can generically change - # the way sections and key-value strings are generated. - # - # For more examples see the test cases in ./tests/misc.nix. - toINI = { + # Generate an INI-style config file from an + # attrset of sections to an attrset of key-value pairs. + # + # generators.toINI {} { + # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; + # baz = { "also, integers" = 42; }; + # } + # + #> [baz] + #> also, integers=42 + #> + #> [foo] + #> ciao=bar + #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 + # + # The mk* configuration attributes can generically change + # the way sections and key-value strings are generated. + # + # For more examples see the test cases in ./tests/misc.nix. + toINI = + { # apply transformations (e.g. escapes) to section names mkSectionName ? (name: libStr.escape [ @@ -142,48 +152,53 @@ in rec { attrsOfAttrs: let # map function to string for each key val - mapAttrsToStringsSep = sep: mapFn: attrs: - libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs); - mkSection = sectName: sectValues: + mapAttrsToStringsSep = + sep: mapFn: attrs: + libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs) + ; + mkSection = + sectName: sectValues: '' [${mkSectionName sectName}] - '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; - # map input to ini sections + '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues + ; + # map input to ini sections in mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ; + ; - # Generate an INI-style config file from an attrset - # specifying the global section (no header), and an - # attrset of sections to an attrset of key-value pairs. - # - # generators.toINIWithGlobalSection {} { - # globalSection = { - # someGlobalKey = "hi"; - # }; - # sections = { - # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; - # baz = { "also, integers" = 42; }; - # } - # - #> someGlobalKey=hi - #> - #> [baz] - #> also, integers=42 - #> - #> [foo] - #> ciao=bar - #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 - # - # The mk* configuration attributes can generically change - # the way sections and key-value strings are generated. - # - # For more examples see the test cases in ./tests/misc.nix. - # - # If you don’t need a global section, you can also use - # `generators.toINI` directly, which only takes - # the part in `sections`. - toINIWithGlobalSection = { + # Generate an INI-style config file from an attrset + # specifying the global section (no header), and an + # attrset of sections to an attrset of key-value pairs. + # + # generators.toINIWithGlobalSection {} { + # globalSection = { + # someGlobalKey = "hi"; + # }; + # sections = { + # foo = { hi = "${pkgs.hello}"; ciao = "bar"; }; + # baz = { "also, integers" = 42; }; + # } + # + #> someGlobalKey=hi + #> + #> [baz] + #> also, integers=42 + #> + #> [foo] + #> ciao=bar + #> hi=/nix/store/y93qql1p5ggfnaqjjqhxcw0vqw95rlz0-hello-2.10 + # + # The mk* configuration attributes can generically change + # the way sections and key-value strings are generated. + # + # For more examples see the test cases in ./tests/misc.nix. + # + # If you don’t need a global section, you can also use + # `generators.toINI` directly, which only takes + # the part in `sections`. + toINIWithGlobalSection = + { # apply transformations (e.g. escapes) to section names mkSectionName ? (name: libStr.escape [ @@ -205,29 +220,32 @@ in rec { (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n") + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } - sections); + sections) + ; - # Generate a git-config file from an attrset. - # - # It has two major differences from the regular INI format: - # - # 1. values are indented with tabs - # 2. sections can have sub-sections - # - # generators.toGitINI { - # url."ssh://git@github.com/".insteadOf = "https://github.com"; - # user.name = "edolstra"; - # } - # - #> [url "ssh://git@github.com/"] - #> insteadOf = https://github.com/ - #> - #> [user] - #> name = edolstra - toGitINI = attrs: + # Generate a git-config file from an attrset. + # + # It has two major differences from the regular INI format: + # + # 1. values are indented with tabs + # 2. sections can have sub-sections + # + # generators.toGitINI { + # url."ssh://git@github.com/".insteadOf = "https://github.com"; + # user.name = "edolstra"; + # } + # + #> [url "ssh://git@github.com/"] + #> insteadOf = https://github.com/ + #> + #> [user] + #> name = edolstra + toGitINI = + attrs: with builtins; let - mkSectionName = name: + mkSectionName = + name: let containsQuote = libStr.hasInfix ''"'' name; sections = libStr.splitString "." name; @@ -237,50 +255,60 @@ in rec { in if containsQuote || subsections == [ ] then name else - ''${section} "${subsection}"''; + ''${section} "${subsection}"'' + ; - # generation for multiple ini values - mkKeyValue = k: v: + # generation for multiple ini values + mkKeyValue = + k: v: let mkKeyValue = mkKeyValueDefault { } " = " k; in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)) - ; + ; - # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI - gitFlattenAttrs = let - recurse = path: value: - if isAttrs value && !lib.isDerivation value then - lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) - value - else if length path > 1 then - { - ${concatStringsSep "." (lib.reverseList (tail path))}.${ - head path - } = value; - } - else - { ${head path} = value; }; - in - attrs: lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) - ; + # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI + gitFlattenAttrs = + let + recurse = + path: value: + if isAttrs value && !lib.isDerivation value then + lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) + value + else if length path > 1 then + { + ${concatStringsSep "." (lib.reverseList (tail path))}.${ + head path + } = value; + } + else + { ${head path} = value; } + ; + in + attrs: + lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) + ; toINI_ = toINI { inherit mkKeyValue mkSectionName; }; in toINI_ (gitFlattenAttrs attrs) - ; + ; - # Generates JSON from an arbitrary (non-function) value. - # For more information see the documentation of the builtin. - toJSON = { }: builtins.toJSON; + # Generates JSON from an arbitrary (non-function) value. + # For more information see the documentation of the builtin. + toJSON = + { }: + builtins.toJSON + ; - # YAML has been a strict superset of JSON since 1.2, so we - # use toJSON. Before it only had a few differences referring - # to implicit typing rules, so it should work with older - # parsers as well. + # YAML has been a strict superset of JSON since 1.2, so we + # use toJSON. Before it only had a few differences referring + # to implicit typing rules, so it should work with older + # parsers as well. toYAML = toJSON; - withRecursion = { + withRecursion = + { # If this option is not null, the given value will stop evaluating at a certain depth depthLimit # If this option is true, an error will be thrown, if a certain given depth is exceeded @@ -295,12 +323,15 @@ in rec { "__toString" "__pretty" ]; - stepIntoAttr = evalNext: name: + stepIntoAttr = + evalNext: name: if builtins.elem name specialAttrs then id else - evalNext; - transform = depth: + evalNext + ; + transform = + depth: if depthLimit != null && depth > depthLimit then if throwOnDepthLimit then throw "Exceeded maximum eval-depth limit of ${ @@ -309,7 +340,8 @@ in rec { else const "" else - id; + id + ; mapAny = with builtins; depth: v: let @@ -322,14 +354,15 @@ in rec { transform (depth + 1) v; in mapAny 0 - ; + ; - # Pretty print a value, akin to `builtins.trace`. - # Should probably be a builtin as well. - # The pretty-printed string should be suitable for rendering default values - # in the NixOS manual. In particular, it should be as close to a valid Nix expression - # as possible. - toPretty = { + # Pretty print a value, akin to `builtins.trace`. + # Should probably be a builtin as well. + # The pretty-printed string should be suitable for rendering default values + # in the NixOS manual. In particular, it should be as close to a valid Nix expression + # as possible. + toPretty = + { /* If this option is true, attrsets like { __pretty = fn; val = …; } will use fn to convert val to a pretty printed representation. (This means fn is type Val -> String.) @@ -341,22 +374,27 @@ in rec { indent ? "" }: let - go = indent: v: + go = + indent: v: with builtins; let isPath = v: typeOf v == "path"; - introSpace = if multiline then - '' + introSpace = + if multiline then + '' - ${indent} '' - else - " "; - outroSpace = if multiline then - '' + ${indent} '' + else + " " + ; + outroSpace = + if multiline then + '' - ${indent}'' - else - " "; + ${indent}'' + else + " " + ; in if isInt v then toString v # toString loses precision on floats, so we use toJSON instead. This isn't perfect @@ -381,19 +419,20 @@ in rec { ]; singlelineResult = ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; - multilineResult = let - escapedLines = map escapeMultiline lines; - # The last line gets a special treatment: if it's empty, '' is on its own line at the "outer" - # indentation level. Otherwise, '' is appended to the last line. - lastLine = lib.last escapedLines; - in - "''" + introSpace - + concatStringsSep introSpace (lib.init escapedLines) - + (if lastLine == "" then - outroSpace - else - introSpace + lastLine) + "''" - ; + multilineResult = + let + escapedLines = map escapeMultiline lines; + # The last line gets a special treatment: if it's empty, '' is on its own line at the "outer" + # indentation level. Otherwise, '' is appended to the last line. + lastLine = lib.last escapedLines; + in + "''" + introSpace + + concatStringsSep introSpace (lib.init escapedLines) + + (if lastLine == "" then + outroSpace + else + introSpace + lastLine) + "''" + ; in if multiline && length lines > 1 then multilineResult else @@ -445,17 +484,20 @@ in rec { (go (indent + " ") value) };") v) + outroSpace + "}" else - abort "generators.toPretty: should never happen (v = ${v})"; + abort "generators.toPretty: should never happen (v = ${v})" + ; in go indent - ; + ; - # PLIST handling - toPlist = { }: + # PLIST handling + toPlist = + { }: v: let isFloat = builtins.isFloat or (x: false); - expr = ind: x: + expr = + ind: x: with builtins; if x == null then "" @@ -472,15 +514,18 @@ in rec { else if isFloat x then float ind x else - abort "generators.toPlist: should never happen (v = ${v})"; + abort "generators.toPlist: should never happen (v = ${v})" + ; literal = ind: x: ind + x; - bool = ind: x: + bool = + ind: x: literal ind (if x then "" else - ""); + "") + ; int = ind: x: literal ind "${toString x}"; str = ind: x: literal ind "${x}"; key = ind: x: literal ind "${x}"; @@ -490,43 +535,50 @@ in rec { item = ind: libStr.concatMapStringsSep "\n" (indent ind); - list = ind: x: + list = + ind: x: libStr.concatStringsSep "\n" [ (literal ind "") (item ind x) (literal ind "") - ]; + ] + ; - attrs = ind: x: + attrs = + ind: x: libStr.concatStringsSep "\n" [ (literal ind "") (attr ind x) (literal ind "") - ]; + ] + ; - attr = let - attrFilter = name: value: name != "_module" && value != null; - in - ind: x: - libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList - (name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ]) x)) - ; + attr = + let + attrFilter = name: value: name != "_module" && value != null; + in + ind: x: + libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList + (name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ]) x)) + ; in '' ${expr "" v} - '' ; + '' + ; - # Translate a simple Nix expression to Dhall notation. - # Note that integers are translated to Integer and never - # the Natural type. - toDhall = { }@args: + # Translate a simple Nix expression to Dhall notation. + # Note that integers are translated to Integer and never + # the Natural type. + toDhall = + { }@args: v: with builtins; let @@ -555,5 +607,6 @@ in rec { else if v == null then abort "generators.toDhall: cannot convert a null to Dhall" else - builtins.toJSON v; + builtins.toJSON v + ; } diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index aec88cdc..f64b3013 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -39,17 +39,19 @@ in { boot.kernelPackages = mkOption { default = pkgs.linuxPackages; type = types.unspecified // { merge = mergeEqualOption; }; - apply = kernelPackages: + apply = + kernelPackages: kernelPackages.extend (self: super: { kernel = super.kernel.override (originalArgs: { inherit randstructSeed; - kernelPatches = (originalArgs.kernelPatches or [ ]) - ++ kernelPatches; + kernelPatches = + (originalArgs.kernelPatches or [ ]) ++ kernelPatches; features = lib.recursiveUpdate super.kernel.features features; }); - }); - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. + }) + ; + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. defaultText = literalExpression "pkgs.linuxPackages"; example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; description = '' @@ -185,7 +187,7 @@ in { built outside of the kernel. Combine these into a single tree of symlinks because modprobe only supports one directory. ''; - # Convert the list of path to only one path. + # Convert the list of path to only one path. apply = pkgs.aggregateModules; }; @@ -209,7 +211,7 @@ in { }; - ###### implementation + ###### implementation config = mkMerge [ (mkIf config.boot.initrd.enable { @@ -276,8 +278,8 @@ in { system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; - # Implement consoleLogLevel both in early boot and using sysctl - # (so you don't need to reboot to have changes take effect). + # Implement consoleLogLevel both in early boot and using sysctl + # (so you don't need to reboot to have changes take effect). boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ optionals config.boot.vesa [ "vga=0x317" @@ -292,11 +294,11 @@ in { "atkbd" ]; - # The Linux kernel >= 2.6.27 provides firmware. + # The Linux kernel >= 2.6.27 provides firmware. hardware.firmware = [ kernel ]; - # Create /etc/modules-load.d/nixos.conf, which is read by - # systemd-modules-load.service to load required kernel modules. + # Create /etc/modules-load.d/nixos.conf, which is read by + # systemd-modules-load.service to load required kernel modules. environment.etc = { "modules-load.d/nixos.conf".source = kernelModulesConf; }; @@ -313,41 +315,51 @@ in { }; lib.kernelConfig = { - isYes = option: { - assertion = config: config.isYes option; - message = "CONFIG_${option} is not yes!"; - configLine = "CONFIG_${option}=y"; - }; - - isNo = option: { - assertion = config: config.isNo option; - message = "CONFIG_${option} is not no!"; - configLine = "CONFIG_${option}=n"; - }; - - isModule = option: { - assertion = config: config.isModule option; - message = "CONFIG_${option} is not built as a module!"; - configLine = "CONFIG_${option}=m"; - }; - - ### Usually you will just want to use these two - # True if yes or module - isEnabled = option: { - assertion = config: config.isEnabled option; - message = "CONFIG_${option} is not enabled!"; - configLine = "CONFIG_${option}=y"; - }; - - # True if no or omitted - isDisabled = option: { - assertion = config: config.isDisabled option; - message = "CONFIG_${option} is not disabled!"; - configLine = "CONFIG_${option}=n"; - }; + isYes = + option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + } + ; + + isNo = + option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + } + ; + + isModule = + option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + } + ; + + ### Usually you will just want to use these two + # True if yes or module + isEnabled = + option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + } + ; + + # True if no or omitted + isDisabled = + option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + } + ; }; - # The config options that all modules can depend upon + # The config options that all modules can depend upon system.requiredKernelConfig = with config.lib.kernelConfig; [ # !!! Should this really be needed? @@ -355,18 +367,19 @@ in { (isYes "BINFMT_ELF") ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); - # nixpkgs kernels are assumed to have all required features - assertions = if config.boot.kernelPackages.kernel ? features then - [ ] - else - let - cfg = config.boot.kernelPackages.kernel.config; - in - map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig - ; + # nixpkgs kernels are assumed to have all required features + assertions = + if config.boot.kernelPackages.kernel ? features then + [ ] + else + let + cfg = config.boot.kernelPackages.kernel.config; + in + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig + ; }) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index aec88cdc..f64b3013 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -39,17 +39,19 @@ in { boot.kernelPackages = mkOption { default = pkgs.linuxPackages; type = types.unspecified // { merge = mergeEqualOption; }; - apply = kernelPackages: + apply = + kernelPackages: kernelPackages.extend (self: super: { kernel = super.kernel.override (originalArgs: { inherit randstructSeed; - kernelPatches = (originalArgs.kernelPatches or [ ]) - ++ kernelPatches; + kernelPatches = + (originalArgs.kernelPatches or [ ]) ++ kernelPatches; features = lib.recursiveUpdate super.kernel.features features; }); - }); - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. + }) + ; + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. defaultText = literalExpression "pkgs.linuxPackages"; example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; description = '' @@ -185,7 +187,7 @@ in { built outside of the kernel. Combine these into a single tree of symlinks because modprobe only supports one directory. ''; - # Convert the list of path to only one path. + # Convert the list of path to only one path. apply = pkgs.aggregateModules; }; @@ -209,7 +211,7 @@ in { }; - ###### implementation + ###### implementation config = mkMerge [ (mkIf config.boot.initrd.enable { @@ -276,8 +278,8 @@ in { system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; - # Implement consoleLogLevel both in early boot and using sysctl - # (so you don't need to reboot to have changes take effect). + # Implement consoleLogLevel both in early boot and using sysctl + # (so you don't need to reboot to have changes take effect). boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ optionals config.boot.vesa [ "vga=0x317" @@ -292,11 +294,11 @@ in { "atkbd" ]; - # The Linux kernel >= 2.6.27 provides firmware. + # The Linux kernel >= 2.6.27 provides firmware. hardware.firmware = [ kernel ]; - # Create /etc/modules-load.d/nixos.conf, which is read by - # systemd-modules-load.service to load required kernel modules. + # Create /etc/modules-load.d/nixos.conf, which is read by + # systemd-modules-load.service to load required kernel modules. environment.etc = { "modules-load.d/nixos.conf".source = kernelModulesConf; }; @@ -313,41 +315,51 @@ in { }; lib.kernelConfig = { - isYes = option: { - assertion = config: config.isYes option; - message = "CONFIG_${option} is not yes!"; - configLine = "CONFIG_${option}=y"; - }; - - isNo = option: { - assertion = config: config.isNo option; - message = "CONFIG_${option} is not no!"; - configLine = "CONFIG_${option}=n"; - }; - - isModule = option: { - assertion = config: config.isModule option; - message = "CONFIG_${option} is not built as a module!"; - configLine = "CONFIG_${option}=m"; - }; - - ### Usually you will just want to use these two - # True if yes or module - isEnabled = option: { - assertion = config: config.isEnabled option; - message = "CONFIG_${option} is not enabled!"; - configLine = "CONFIG_${option}=y"; - }; - - # True if no or omitted - isDisabled = option: { - assertion = config: config.isDisabled option; - message = "CONFIG_${option} is not disabled!"; - configLine = "CONFIG_${option}=n"; - }; + isYes = + option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + } + ; + + isNo = + option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + } + ; + + isModule = + option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + } + ; + + ### Usually you will just want to use these two + # True if yes or module + isEnabled = + option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + } + ; + + # True if no or omitted + isDisabled = + option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + } + ; }; - # The config options that all modules can depend upon + # The config options that all modules can depend upon system.requiredKernelConfig = with config.lib.kernelConfig; [ # !!! Should this really be needed? @@ -355,18 +367,19 @@ in { (isYes "BINFMT_ELF") ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); - # nixpkgs kernels are assumed to have all required features - assertions = if config.boot.kernelPackages.kernel ? features then - [ ] - else - let - cfg = config.boot.kernelPackages.kernel.config; - in - map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig - ; + # nixpkgs kernels are assumed to have all required features + assertions = + if config.boot.kernelPackages.kernel ? features then + [ ] + else + let + cfg = config.boot.kernelPackages.kernel.config; + in + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig + ; }) diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index b99a70e7..2ce030b5 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -7,7 +7,7 @@ rec { b = { a = 1 # d - ; + ; }; c = { @@ -17,7 +17,7 @@ rec { d = { a = # c 1 # d - ; + ; }; e = { a # b @@ -26,7 +26,7 @@ rec { f = { a # b = 1 # d - ; + ; }; h = { a # b @@ -37,28 +37,36 @@ rec { a # b = # c 1 # d - ; + ; }; j = a: { b = 1; }; - k = a: { - b = 1; - c = 2; - }; - l = a: # b + k = + a: { + b = 1; + c = 2; + } + ; + l = + a: # b { b = 1; - }; - m = a: # b + } + ; + m = + a: # b { b = 1; c = 2; - }; + } + ; n = pkgs: { }; - o = { + o = + { pkgs, ... }: - { }; + { } + ; a # b @@ -66,7 +74,7 @@ rec { # c 1 # d - ; + ; p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a; diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index 8fc183fd..c5f94f3b 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -1,63 +1,74 @@ let - a = let - b = 2; - c = 3; - in - d - ; - a = let - c = 1; - in - f - ; + a = + let + b = 2; + c = 3; + in + d + ; + a = + let + c = 1; + in + f + ; - a = let - c = 1; - # e - in - f - ; - a = let - c = 1; # d - in - f - ; + a = + let + c = 1; + # e + in + f + ; + a = + let + c = 1; # d + in + f + ; - a = let - c = 1; # d - # e - in - f - ; - a = let # b - c = 1; - in - f - ; - a = let # b - c = 1; - # e - in - f - ; - a = let # b - c = 1; # d - in - f - ; - a = let # b - c = 1; # d - # e - in - f - ; + a = + let + c = 1; # d + # e + in + f + ; + a = + let # b + c = 1; + in + f + ; + a = + let # b + c = 1; + # e + in + f + ; + a = + let # b + c = 1; # d + in + f + ; + a = + let # b + c = 1; # d + # e + in + f + ; - a = let - in [ - 1 - 2 - ] ; + a = + let + in [ + 1 + 2 + ] + ; in a diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index f1b408a9..e6895770 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -76,13 +76,13 @@ rec = # foo "contrast"; - # foo + # foo version # foo = # foo "0.0.5"; - # foo + # foo src # foo = @@ -96,39 +96,39 @@ rec = # foo "gitlab.gnome.org"; - # foo + # foo group # foo = # foo "World"; - # foo + # foo owner # foo = # foo "design"; - # foo + # foo repo # foo = # foo "contrast"; - # foo + # foo rev # foo = # foo version; - # foo + # foo sha256 # foo = # foo "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; - # foo + # foo }; - # foo + # foo cargoDeps # foo = @@ -147,15 +147,15 @@ rec = # foo "${pname}-${version}"; - # foo + # foo hash # foo = # foo "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; - # foo + # foo }; - # foo + # foo nativeBuildInputs # foo = @@ -188,7 +188,7 @@ rec # foo ]; - # foo + # foo buildInputs # foo = @@ -206,7 +206,7 @@ rec pango # foo ]; - # foo + # foo postPatch # foo = @@ -217,7 +217,7 @@ rec substituteInPlace build-aux/meson_post_install.py \ --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" ''; - # foo + # foo meta # foo = @@ -232,20 +232,21 @@ rec # foo = # foo - "Checks whether the contrast between two colors meet the WCAG requirements"; - # foo + "Checks whether the contrast between two colors meet the WCAG requirements" + ; + # foo homepage # foo = # foo "https://gitlab.gnome.org/World/design/contrast"; - # foo + # foo license # foo = # foo licenses.gpl3Plus; - # foo + # foo maintainers # foo = @@ -259,13 +260,13 @@ rec jtojnar # foo ]; - # foo + # foo platforms # foo = # foo platforms.unix; - # foo + # foo }; - # foo + # foo } diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index 0f66f531..fac5cee4 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -60,7 +60,8 @@ stdenv.mkDerivation rec { ''; meta = with lib; { description = - "Checks whether the contrast between two colors meet the WCAG requirements"; + "Checks whether the contrast between two colors meet the WCAG requirements" + ; homepage = "https://gitlab.gnome.org/World/design/contrast"; license = licenses.gpl3Plus; maintainers = with maintainers; [ jtojnar ]; diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 10c74252..90d57edc 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -118,7 +118,8 @@ rec # Foo { # Foo description # Foo = # Foo - "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo + "Checks whether the contrast between two colors meet the WCAG requirements" + ; # Foo homepage # Foo = # Foo "https://gitlab.gnome.org/World/design/contrast"; # Foo diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index f580e883..10b8a24b 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -190,10 +190,11 @@ in { }); - }); + }) + ; - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. defaultText diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 8eb76a24..0f658ee4 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -26,8 +26,9 @@ 1; } { - a = with b; 1; - # comment + a = with b; + 1; + # comment } (with a; with b; with c; { a = 1; }) (with a; From 2e2797a36cf3b3f22b23adc99e77f1910d3e40de Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 7 May 2023 11:30:29 +0200 Subject: [PATCH 019/125] Tests: replace diff/idioms_pkgs_3 The file was identical to diff/idioms_nixos_1 and therefore redundant. Moreover, we need to also keep a look on the *really* big packages in there, and Mozilla is a prime example. --- test/diff/idioms_pkgs_3/in.nix | 871 ++++++++++++++++++------------ test/diff/idioms_pkgs_3/out.nix | 920 +++++++++++++++++++------------- 2 files changed, 1095 insertions(+), 696 deletions(-) diff --git a/test/diff/idioms_pkgs_3/in.nix b/test/diff/idioms_pkgs_3/in.nix index d147155d..e692e473 100644 --- a/test/diff/idioms_pkgs_3/in.nix +++ b/test/diff/idioms_pkgs_3/in.nix @@ -1,350 +1,545 @@ -{ config, lib, pkgs, ... }: - -with lib; +{ pname +, version +, meta +, updateScript ? null +, binaryName ? "firefox" +, application ? "browser" +, applicationName ? "Mozilla Firefox" +, branding ? null +, src +, unpackPhase ? null +, extraPatches ? [] +, extraPostPatch ? "" +, extraNativeBuildInputs ? [] +, extraConfigureFlags ? [] +, extraBuildInputs ? [] +, extraMakeFlags ? [] +, extraPassthru ? {} +, tests ? [] +}: + + +{ lib +, pkgs +, stdenv +, fetchpatch +, patchelf + +# build time +, autoconf +, cargo +, dump_syms +, makeWrapper +, nodejs +, perl +, pkg-config +, pkgsCross # wasm32 rlbox +, python3 +, runCommand +, rustc +, rust-cbindgen +, rustPlatform +, unzip +, which +, wrapGAppsHook + +# runtime +, bzip2 +, dbus +, dbus-glib +, file +, fontconfig +, freetype +, glib +, gnum4 +, gtk3 +, icu +, libGL +, libGLU +, libevent +, libffi +, libjpeg +, libpng +, libstartup_notification +, libvpx +, libwebp +, nasm +, nspr +, nss_esr +, nss_latest +, pango +, xorg +, zip +, zlib +, pkgsBuildBuild + +# optionals + +## debugging + +, debugBuild ? false + +# On 32bit platforms, we disable adding "-g" for easier linking. +, enableDebugSymbols ? !stdenv.is32bit + +## optional libraries + +, alsaSupport ? stdenv.isLinux, alsa-lib +, ffmpegSupport ? true +, gssSupport ? true, libkrb5 +, jackSupport ? stdenv.isLinux, libjack2 +, jemallocSupport ? true, jemalloc +, ltoSupport ? (stdenv.isLinux && stdenv.is64bit), overrideCC, buildPackages +, pgoSupport ? (stdenv.isLinux && stdenv.hostPlatform == stdenv.buildPlatform), xvfb-run +, pipewireSupport ? waylandSupport && webrtcSupport +, pulseaudioSupport ? stdenv.isLinux, libpulseaudio +, sndioSupport ? stdenv.isLinux, sndio +, waylandSupport ? true, libxkbcommon, libdrm + +## privacy-related options + +, privacySupport ? false + +# WARNING: NEVER set any of the options below to `true` by default. +# Set to `!privacySupport` or `false`. + +, crashreporterSupport ? !privacySupport, curl +, geolocationSupport ? !privacySupport +, googleAPISupport ? geolocationSupport +, mlsAPISupport ? geolocationSupport +, webrtcSupport ? !privacySupport + +# digital rights managemewnt + +# This flag controls whether Firefox will show the nagbar, that allows +# users at runtime the choice to enable Widevine CDM support when a site +# requests it. +# Controlling the nagbar and widevine CDM at runtime is possible by setting +# `browser.eme.ui.enabled` and `media.gmp-widevinecdm.enabled` accordingly +, drmSupport ? true + +# As stated by Sylvestre Ledru (@sylvestre) on Nov 22, 2017 at +# https://github.com/NixOS/nixpkgs/issues/31843#issuecomment-346372756 we +# have permission to use the official firefox branding. +# +# For purposes of documentation the statement of @sylvestre: +# > As the person who did part of the work described in the LWN article +# > and release manager working for Mozilla, I can confirm the statement +# > that I made in +# > https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=815006 +# > +# > @garbas shared with me the list of patches applied for the Nix package. +# > As they are just for portability and tiny modifications, they don't +# > alter the experience of the product. In parallel, Rok also shared the +# > build options. They seem good (even if I cannot judge the quality of the +# > packaging of the underlying dependencies like sqlite, png, etc). +# > Therefor, as long as you keep the patch queue sane and you don't alter +# > the experience of Firefox users, you won't have any issues using the +# > official branding. +, enableOfficialBranding ? true +}: + +assert stdenv.cc.libc or null != null; +assert pipewireSupport -> !waylandSupport || !webrtcSupport -> throw "${pname}: pipewireSupport requires both wayland and webrtc support."; let + inherit (lib) enableFeature; - inherit (config.boot) kernelPatches; - inherit (config.boot.kernel) features randstructSeed; - inherit (config.boot.kernelPackages) kernel; - - kernelModulesConf = pkgs.writeText "nixos.conf" - '' - ${concatStringsSep "\n" config.boot.kernelModules} - ''; - -in - -{ - - ###### interface - - options = { - - boot.kernel.features = mkOption { - default = {}; - example = literalExpression "{ debug = true; }"; - internal = true; - description = '' - This option allows to enable or disable certain kernel features. - It's not API, because it's about kernel feature sets, that - make sense for specific use cases. Mostly along with programs, - which would have separate nixos options. - `grep features pkgs/os-specific/linux/kernel/common-config.nix` - ''; - }; - - boot.kernelPackages = mkOption { - default = pkgs.linuxPackages; - type = types.unspecified // { merge = mergeEqualOption; }; - apply = kernelPackages: kernelPackages.extend (self: super: { - kernel = super.kernel.override (originalArgs: { - inherit randstructSeed; - kernelPatches = (originalArgs.kernelPatches or []) ++ kernelPatches; - features = lib.recursiveUpdate super.kernel.features features; - }); - }); - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. - defaultText = literalExpression "pkgs.linuxPackages"; - example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; - description = '' - This option allows you to override the Linux kernel used by - NixOS. Since things like external kernel module packages are - tied to the kernel you're using, it also overrides those. - This option is a function that takes Nixpkgs as an argument - (as a convenience), and returns an attribute set containing at - the very least an attribute kernel. - Additional attributes may be needed depending on your - configuration. For instance, if you use the NVIDIA X driver, - then it also needs to contain an attribute - nvidia_x11. - ''; - }; - - boot.kernelPatches = mkOption { - type = types.listOf types.attrs; - default = []; - example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; - description = "A list of additional patches to apply to the kernel."; - }; - - boot.kernel.randstructSeed = mkOption { - type = types.str; - default = ""; - example = "my secret seed"; - description = '' - Provides a custom seed for the RANDSTRUCT security - option of the Linux kernel. Note that RANDSTRUCT is - only enabled in NixOS hardened kernels. Using a custom seed requires - building the kernel and dependent packages locally, since this - customization happens at build time. - ''; - }; - - boot.kernelParams = mkOption { - type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { - name = "kernelParam"; - description = "string, with spaces inside double quotes"; - }); - default = [ ]; - description = "Parameters added to the kernel command line."; - }; - - boot.consoleLogLevel = mkOption { - type = types.int; - default = 4; - description = '' - The kernel console loglevel. All Kernel Messages with a log level smaller - than this setting will be printed to the console. - ''; - }; + # Target the LLVM version that rustc is built with for LTO. + llvmPackages0 = rustc.llvmPackages; + llvmPackagesBuildBuild0 = pkgsBuildBuild.rustc.llvmPackages; - boot.vesa = mkOption { - type = types.bool; - default = false; - description = '' - (Deprecated) This option, if set, activates the VESA 800x600 video - mode on boot and disables kernel modesetting. It is equivalent to - specifying [ "vga=0x317" "nomodeset" ] in the - option. This option is - deprecated as of 2020: Xorg now works better with modesetting, and - you might want a different VESA vga setting, anyway. - ''; - }; - - boot.extraModulePackages = mkOption { - type = types.listOf types.package; - default = []; - example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; - description = "A list of additional packages supplying kernel modules."; - }; - - boot.kernelModules = mkOption { - type = types.listOf types.str; - default = []; - description = '' - The set of kernel modules to be loaded in the second stage of - the boot process. Note that modules that are needed to - mount the root file system should be added to - or - . - ''; - }; - - boot.initrd.availableKernelModules = mkOption { - type = types.listOf types.str; - default = []; - example = [ "sata_nv" "ext3" ]; - description = '' - The set of kernel modules in the initial ramdisk used during the - boot process. This set must include all modules necessary for - mounting the root device. That is, it should include modules - for the physical device (e.g., SCSI drivers) and for the file - system (e.g., ext3). The set specified here is automatically - closed under the module dependency relation, i.e., all - dependencies of the modules list here are included - automatically. The modules listed here are available in the - initrd, but are only loaded on demand (e.g., the ext3 module is - loaded automatically when an ext3 filesystem is mounted, and - modules for PCI devices are loaded when they match the PCI ID - of a device in your system). To force a module to be loaded, - include it in . - ''; - }; - - boot.initrd.kernelModules = mkOption { - type = types.listOf types.str; - default = []; - description = "List of modules that are always loaded by the initrd."; - }; + # Force the use of lld and other llvm tools for LTO + llvmPackages = llvmPackages0.override { + bootBintoolsNoLibc = null; + bootBintools = null; + }; + llvmPackagesBuildBuild = llvmPackagesBuildBuild0.override { + bootBintoolsNoLibc = null; + bootBintools = null; + }; - boot.initrd.includeDefaultModules = mkOption { - type = types.bool; - default = true; - description = '' - This option, if set, adds a collection of default kernel modules - to and - . - ''; + # LTO requires LLVM bintools including ld.lld and llvm-ar. + buildStdenv = overrideCC llvmPackages.stdenv (llvmPackages.stdenv.cc.override { + bintools = if ltoSupport then buildPackages.rustc.llvmPackages.bintools else stdenv.cc.bintools; + }); + + # Compile the wasm32 sysroot to build the RLBox Sandbox + # https://hacks.mozilla.org/2021/12/webassembly-and-back-again-fine-grained-sandboxing-in-firefox-95/ + # We only link c++ libs here, our compiler wrapper can find wasi libc and crt itself. + wasiSysRoot = runCommand "wasi-sysroot" {} '' + mkdir -p $out/lib/wasm32-wasi + for lib in ${pkgsCross.wasi32.llvmPackages.libcxx}/lib/* ${pkgsCross.wasi32.llvmPackages.libcxxabi}/lib/*; do + ln -s $lib $out/lib/wasm32-wasi + done + ''; + + distributionIni = pkgs.writeText "distribution.ini" (lib.generators.toINI {} { + # Some light branding indicating this build uses our distro preferences + Global = { + id = "nixos"; + version = "1.0"; + about = "${applicationName} for NixOS"; }; - - system.modulesTree = mkOption { - type = types.listOf types.path; - internal = true; - default = []; - description = '' - Tree of kernel modules. This includes the kernel, plus modules - built outside of the kernel. Combine these into a single tree of - symlinks because modprobe only supports one directory. - ''; - # Convert the list of path to only one path. - apply = pkgs.aggregateModules; + Preferences = { + # These values are exposed through telemetry + "app.distributor" = "nixos"; + "app.distributor.channel" = "nixpkgs"; + "app.partner.nixos" = "nixos"; }; + }); - system.requiredKernelConfig = mkOption { - default = []; - example = literalExpression '' - with config.lib.kernelConfig; [ - (isYes "MODULES") - (isEnabled "FB_CON_DECOR") - (isEnabled "BLK_DEV_INITRD") - ] - ''; - internal = true; - type = types.listOf types.attrs; - description = '' - This option allows modules to specify the kernel config options that - must be set (or unset) for the module to work. Please use the - lib.kernelConfig functions to build list elements. - ''; + defaultPrefs = { + "geo.provider.network.url" = { + value = "https://location.services.mozilla.com/v1/geolocate?key=%MOZILLA_API_KEY%"; + reason = "Use MLS by default for geolocation, since our Google API Keys are not working"; }; - }; + defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" (lib.concatStringsSep "\n" (lib.mapAttrsToList (key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '') defaultPrefs)); + +in - ###### implementation - - config = mkMerge - [ (mkIf config.boot.initrd.enable { - boot.initrd.availableKernelModules = - optionals config.boot.initrd.includeDefaultModules ([ - # Note: most of these (especially the SATA/PATA modules) - # shouldn't be included by default since nixos-generate-config - # detects them, but I'm keeping them for now for backwards - # compatibility. - - # Some SATA/PATA stuff. - "ahci" - "sata_nv" - "sata_via" - "sata_sis" - "sata_uli" - "ata_piix" - "pata_marvell" - - # Standard SCSI stuff. - "sd_mod" - "sr_mod" - - # SD cards and internal eMMC drives. - "mmc_block" - - # Support USB keyboards, in case the boot fails and we only have - # a USB keyboard, or for LUKS passphrase prompt. - "uhci_hcd" - "ehci_hcd" - "ehci_pci" - "ohci_hcd" - "ohci_pci" - "xhci_hcd" - "xhci_pci" - "usbhid" - "hid_generic" "hid_lenovo" "hid_apple" "hid_roccat" - "hid_logitech_hidpp" "hid_logitech_dj" "hid_microsoft" - - ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ - # Misc. x86 keyboard stuff. - "pcips2" "atkbd" "i8042" - - # x86 RTC needed by the stage 2 init script. - "rtc_cmos" - ]); - - boot.initrd.kernelModules = - optionals config.boot.initrd.includeDefaultModules [ - # For LVM. - "dm_mod" - ]; - }) - - (mkIf (!config.boot.isContainer) { - system.build = { inherit kernel; }; - - system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; - - # Implement consoleLogLevel both in early boot and using sysctl - # (so you don't need to reboot to have changes take effect). - boot.kernelParams = - [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ - optionals config.boot.vesa [ "vga=0x317" "nomodeset" ]; - - boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; - - boot.kernelModules = [ "loop" "atkbd" ]; - - # The Linux kernel >= 2.6.27 provides firmware. - hardware.firmware = [ kernel ]; - - # Create /etc/modules-load.d/nixos.conf, which is read by - # systemd-modules-load.service to load required kernel modules. - environment.etc = - { "modules-load.d/nixos.conf".source = kernelModulesConf; - }; - - systemd.services.systemd-modules-load = - { wantedBy = [ "multi-user.target" ]; - restartTriggers = [ kernelModulesConf ]; - serviceConfig = - { # Ignore failed module loads. Typically some of the - # modules in ‘boot.kernelModules’ are "nice to have but - # not required" (e.g. acpi-cpufreq), so we don't want to - # barf on those. - SuccessExitStatus = "0 1"; - }; - }; - - lib.kernelConfig = { - isYes = option: { - assertion = config: config.isYes option; - message = "CONFIG_${option} is not yes!"; - configLine = "CONFIG_${option}=y"; - }; - - isNo = option: { - assertion = config: config.isNo option; - message = "CONFIG_${option} is not no!"; - configLine = "CONFIG_${option}=n"; - }; - - isModule = option: { - assertion = config: config.isModule option; - message = "CONFIG_${option} is not built as a module!"; - configLine = "CONFIG_${option}=m"; - }; - - ### Usually you will just want to use these two - # True if yes or module - isEnabled = option: { - assertion = config: config.isEnabled option; - message = "CONFIG_${option} is not enabled!"; - configLine = "CONFIG_${option}=y"; - }; - - # True if no or omitted - isDisabled = option: { - assertion = config: config.isDisabled option; - message = "CONFIG_${option} is not disabled!"; - configLine = "CONFIG_${option}=n"; - }; - }; - - # The config options that all modules can depend upon - system.requiredKernelConfig = with config.lib.kernelConfig; - [ - # !!! Should this really be needed? - (isYes "MODULES") - (isYes "BINFMT_ELF") - ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); - - # nixpkgs kernels are assumed to have all required features - assertions = if config.boot.kernelPackages.kernel ? features then [] else - let cfg = config.boot.kernelPackages.kernel.config; in map (attrs: - { assertion = attrs.assertion cfg; inherit (attrs) message; } - ) config.system.requiredKernelConfig; - - }) - - ]; - -} +buildStdenv.mkDerivation ({ + pname = "${pname}-unwrapped"; + inherit version; + + inherit src unpackPhase meta; + + outputs = [ + "out" + ] + ++ lib.optionals crashreporterSupport [ "symbols" ]; + + # Add another configure-build-profiling run before the final configure phase if we build with pgo + preConfigurePhases = lib.optionals pgoSupport [ + "configurePhase" + "buildPhase" + "profilingPhase" + ]; + + patches = lib.optionals (lib.versionOlder version "102.6.0") [ + (fetchpatch { + # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 + name = "rust-cbindgen-0.24.2-compat.patch"; + url = "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; + hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; + }) + ] + ++ lib.optional (lib.versionOlder version "111") ./env_var_for_system_dir-ff86.patch + ++ lib.optional (lib.versionAtLeast version "111") ./env_var_for_system_dir-ff111.patch + ++ lib.optional (lib.versionAtLeast version "96") ./no-buildconfig-ffx96.patch + ++ extraPatches; + + postPatch = '' + rm -rf obj-x86_64-pc-linux-gnu + patchShebangs mach build + '' + + extraPostPatch; + + # Ignore trivial whitespace changes in patches, this fixes compatibility of + # ./env_var_for_system_dir.patch with Firefox >=65 without having to track + # two patches. + patchFlags = [ "-p1" "-l" ]; + + # if not explicitly set, wrong cc from buildStdenv would be used + HOST_CC = "${llvmPackagesBuildBuild.stdenv.cc}/bin/cc"; + HOST_CXX = "${llvmPackagesBuildBuild.stdenv.cc}/bin/c++"; + + nativeBuildInputs = [ + autoconf + cargo + gnum4 + llvmPackagesBuildBuild.bintools + makeWrapper + nodejs + perl + pkg-config + python3 + rust-cbindgen + rustPlatform.bindgenHook + rustc + unzip + which + wrapGAppsHook + ] + ++ lib.optionals crashreporterSupport [ dump_syms patchelf ] + ++ lib.optionals pgoSupport [ xvfb-run ] + ++ extraNativeBuildInputs; + + setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. + + preConfigure = '' + # remove distributed configuration files + rm -f configure js/src/configure .mozconfig* + + # Runs autoconf through ./mach configure in configurePhase + configureScript="$(realpath ./mach) configure" + + # Set predictable directories for build and state + export MOZ_OBJDIR=$(pwd)/mozobj + export MOZBUILD_STATE_PATH=$(pwd)/mozbuild + + # Don't try to send libnotify notifications during build + export MOZ_NOSPAM=1 + + # Set consistent remoting name to ensure wmclass matches with desktop file + export MOZ_APP_REMOTINGNAME="${binaryName}" + + # AS=as in the environment causes build failure + # https://bugzilla.mozilla.org/show_bug.cgi?id=1497286 + unset AS + + # Use our own python + export MACH_BUILD_PYTHON_NATIVE_PACKAGE_SOURCE=system + + # RBox WASM Sandboxing + export WASM_CC=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}cc + export WASM_CXX=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}c++ + '' + lib.optionalString pgoSupport '' + if [ -e "$TMPDIR/merged.profdata" ]; then + echo "Configuring with profiling data" + for i in "''${!configureFlagsArray[@]}"; do + if [[ ''${configureFlagsArray[i]} = "--enable-profile-generate=cross" ]]; then + unset 'configureFlagsArray[i]' + fi + done + configureFlagsArray+=( + "--enable-profile-use=cross" + "--with-pgo-profile-path="$TMPDIR/merged.profdata"" + "--with-pgo-jarlog="$TMPDIR/jarlog"" + ) + else + echo "Configuring to generate profiling data" + configureFlagsArray+=( + "--enable-profile-generate=cross" + ) + fi + '' + lib.optionalString googleAPISupport '' + # Google API key used by Chromium and Firefox. + # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, + # please get your own set of keys at https://www.chromium.org/developers/how-tos/api-keys/. + echo "AIzaSyDGi15Zwl11UNe6Y-5XW_upsfyw31qwZPI" > $TMPDIR/google-api-key + # 60.5+ & 66+ did split the google API key arguments: https://bugzilla.mozilla.org/show_bug.cgi?id=1531176 + configureFlagsArray+=("--with-google-location-service-api-keyfile=$TMPDIR/google-api-key") + configureFlagsArray+=("--with-google-safebrowsing-api-keyfile=$TMPDIR/google-api-key") + '' + lib.optionalString mlsAPISupport '' + # Mozilla Location services API key + # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, + # please get your own set of keys at https://location.services.mozilla.com/api. + echo "dfd7836c-d458-4917-98bb-421c82d3c8a0" > $TMPDIR/mls-api-key + configureFlagsArray+=("--with-mozilla-api-keyfile=$TMPDIR/mls-api-key") + '' + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' + export MOZILLA_OFFICIAL=1 + ''; + + # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags + configurePlatforms = [ ]; + + configureFlags = [ + "--disable-tests" + "--disable-updater" + "--enable-application=${application}" + "--enable-default-toolkit=cairo-gtk3${lib.optionalString waylandSupport "-wayland"}" + "--enable-system-pixman" + "--with-distribution-id=org.nixos" + "--with-libclang-path=${llvmPackagesBuildBuild.libclang.lib}/lib" + "--with-system-ffi" + "--with-system-icu" + "--with-system-jpeg" + "--with-system-libevent" + "--with-system-libvpx" + "--with-system-nspr" + "--with-system-nss" + "--with-system-png" # needs APNG support + "--with-system-webp" + "--with-system-zlib" + "--with-wasi-sysroot=${wasiSysRoot}" + # for firefox, host is buildPlatform, target is hostPlatform + "--host=${buildStdenv.buildPlatform.config}" + "--target=${buildStdenv.hostPlatform.config}" + ] + # LTO is done using clang and lld on Linux. + ++ lib.optionals ltoSupport [ + "--enable-lto=cross" # Cross-Language LTO + "--enable-linker=lld" + ] + # elf-hack is broken when using clang+lld: + # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 + ++ lib.optional (ltoSupport && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64)) "--disable-elf-hack" + ++ lib.optional (!drmSupport) "--disable-eme" + ++ [ + (enableFeature alsaSupport "alsa") + (enableFeature crashreporterSupport "crashreporter") + (enableFeature ffmpegSupport "ffmpeg") + (enableFeature geolocationSupport "necko-wifi") + (enableFeature gssSupport "negotiateauth") + (enableFeature jackSupport "jack") + (enableFeature jemallocSupport "jemalloc") + (enableFeature pulseaudioSupport "pulseaudio") + (enableFeature sndioSupport "sndio") + (enableFeature webrtcSupport "webrtc") + (enableFeature debugBuild "debug") + (if debugBuild then "--enable-profiling" else "--enable-optimize") + # --enable-release adds -ffunction-sections & LTO that require a big amount + # of RAM, and the 32-bit memory space cannot handle that linking + (enableFeature (!debugBuild && !stdenv.is32bit) "release") + (enableFeature enableDebugSymbols "debug-symbols") + ] + ++ lib.optionals enableDebugSymbols [ "--disable-strip" "--disable-install-strip" ] + ++ lib.optional enableOfficialBranding "--enable-official-branding" + ++ lib.optional (branding != null) "--with-branding=${branding}" + ++ extraConfigureFlags; + + buildInputs = [ + bzip2 + dbus + dbus-glib + file + fontconfig + freetype + glib + gtk3 + icu + libffi + libGL + libGLU + libevent + libjpeg + libpng + libstartup_notification + libvpx + libwebp + nasm + nspr + pango + perl + xorg.libX11 + xorg.libXcursor + xorg.libXdamage + xorg.libXext + xorg.libXft + xorg.libXi + xorg.libXrender + xorg.libXt + xorg.libXtst + xorg.pixman + xorg.xorgproto + zip + zlib + ] + ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] + ++ lib.optional alsaSupport alsa-lib + ++ lib.optional jackSupport libjack2 + ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed + ++ lib.optional sndioSupport sndio + ++ lib.optional gssSupport libkrb5 + ++ lib.optionals waylandSupport [ libxkbcommon libdrm ] + ++ lib.optional jemallocSupport jemalloc + ++ extraBuildInputs; + + profilingPhase = lib.optionalString pgoSupport '' + # Package up Firefox for profiling + ./mach package + + # Run profiling + ( + export HOME=$TMPDIR + export LLVM_PROFDATA=llvm-profdata + export JARLOG_FILE="$TMPDIR/jarlog" + + xvfb-run -w 10 -s "-screen 0 1920x1080x24" \ + ./mach python ./build/pgo/profileserver.py + ) + + # Copy profiling data to a place we can easily reference + cp ./merged.profdata $TMPDIR/merged.profdata + + # Clean build dir + ./mach clobber + ''; + + preBuild = '' + cd mozobj + ''; + + postBuild = '' + cd .. + ''; + + makeFlags = extraMakeFlags; + separateDebugInfo = enableDebugSymbols; + enableParallelBuilding = true; + + # tests were disabled in configureFlags + doCheck = false; + + # Generate build symbols once after the final build + # https://firefox-source-docs.mozilla.org/crash-reporting/uploading_symbol.html + preInstall = lib.optionalString crashreporterSupport '' + ./mach buildsymbols + mkdir -p $symbols/ + cp mozobj/dist/*.crashreporter-symbols.zip $symbols/ + '' + '' + cd mozobj + ''; + + postInstall = '' + # Install distribution customizations + install -Dvm644 ${distributionIni} $out/lib/${binaryName}/distribution/distribution.ini + install -Dvm644 ${defaultPrefsFile} $out/lib/${binaryName}/browser/defaults/preferences/nixos-default-prefs.js + + '' + lib.optionalString buildStdenv.isLinux '' + # Remove SDK cruft. FIXME: move to a separate output? + rm -rf $out/share/idl $out/include $out/lib/${binaryName}-devel-* + + # Needed to find Mozilla runtime + gappsWrapperArgs+=(--argv0 "$out/bin/.${binaryName}-wrapped") + ''; + + postFixup = lib.optionalString crashreporterSupport '' + patchelf --add-rpath "${lib.makeLibraryPath [ curl ]}" $out/lib/${binaryName}/crashreporter + ''; + + doInstallCheck = true; + installCheckPhase = '' + # Some basic testing + "$out/bin/${binaryName}" --version + ''; + + passthru = { + inherit updateScript; + inherit version; + inherit alsaSupport; + inherit binaryName; + inherit jackSupport; + inherit pipewireSupport; + inherit sndioSupport; + inherit nspr; + inherit ffmpegSupport; + inherit gssSupport; + inherit tests; + inherit gtk3; + inherit wasiSysRoot; + } // extraPassthru; + + hardeningDisable = [ "format" ]; # -Werror=format-security + + # the build system verifies checksums of the bundled rust sources + # ./third_party/rust is be patched by our libtool fixup code in stdenv + # unfortunately we can't just set this to `false` when we do not want it. + # See https://github.com/NixOS/nixpkgs/issues/77289 for more details + # Ideally we would figure out how to tell the build system to not + # care about changed hashes as we are already doing that when we + # fetch the sources. Any further modifications of the source tree + # is on purpose by some of our tool (or by accident and a bug?). + dontFixLibtool = true; + + # on aarch64 this is also required + dontUpdateAutotoolsGnuConfigScripts = true; + + requiredSystemFeatures = [ "big-parallel" ]; +}) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index f64b3013..fea7c990 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -1,388 +1,592 @@ { - config, + pname, + version, + meta, + updateScript ? null, + binaryName ? "firefox", + application ? "browser", + applicationName ? "Mozilla Firefox", + branding ? null, + src, + unpackPhase ? null, + extraPatches ? [ ], + extraPostPatch ? "", + extraNativeBuildInputs ? [ ], + extraConfigureFlags ? [ ], + extraBuildInputs ? [ ], + extraMakeFlags ? [ ], + extraPassthru ? { }, + tests ? [ ] +}: + +{ lib, pkgs, - ... + stdenv, + fetchpatch, + patchelf + + # build time + , + autoconf, + cargo, + dump_syms, + makeWrapper, + nodejs, + perl, + pkg-config, + pkgsCross # wasm32 rlbox + , + python3, + runCommand, + rustc, + rust-cbindgen, + rustPlatform, + unzip, + which, + wrapGAppsHook + + # runtime + , + bzip2, + dbus, + dbus-glib, + file, + fontconfig, + freetype, + glib, + gnum4, + gtk3, + icu, + libGL, + libGLU, + libevent, + libffi, + libjpeg, + libpng, + libstartup_notification, + libvpx, + libwebp, + nasm, + nspr, + nss_esr, + nss_latest, + pango, + xorg, + zip, + zlib, + pkgsBuildBuild + + # optionals + + ## debugging + + , + debugBuild ? false + + # On 32bit platforms, we disable adding "-g" for easier linking. + , + enableDebugSymbols ? !stdenv.is32bit + + ## optional libraries + + , + alsaSupport ? stdenv.isLinux, + alsa-lib, + ffmpegSupport ? true, + gssSupport ? true, + libkrb5, + jackSupport ? stdenv.isLinux, + libjack2, + jemallocSupport ? true, + jemalloc, + ltoSupport ? (stdenv.isLinux && stdenv.is64bit), + overrideCC, + buildPackages, + pgoSupport ? (stdenv.isLinux && stdenv.hostPlatform == stdenv.buildPlatform), + xvfb-run, + pipewireSupport ? waylandSupport && webrtcSupport, + pulseaudioSupport ? stdenv.isLinux, + libpulseaudio, + sndioSupport ? stdenv.isLinux, + sndio, + waylandSupport ? true, + libxkbcommon, + libdrm + + ## privacy-related options + + , + privacySupport ? false + + # WARNING: NEVER set any of the options below to `true` by default. + # Set to `!privacySupport` or `false`. + + , + crashreporterSupport ? !privacySupport, + curl, + geolocationSupport ? !privacySupport, + googleAPISupport ? geolocationSupport, + mlsAPISupport ? geolocationSupport, + webrtcSupport ? !privacySupport + + # digital rights managemewnt + + # This flag controls whether Firefox will show the nagbar, that allows + # users at runtime the choice to enable Widevine CDM support when a site + # requests it. + # Controlling the nagbar and widevine CDM at runtime is possible by setting + # `browser.eme.ui.enabled` and `media.gmp-widevinecdm.enabled` accordingly + , + drmSupport ? true + + # As stated by Sylvestre Ledru (@sylvestre) on Nov 22, 2017 at + # https://github.com/NixOS/nixpkgs/issues/31843#issuecomment-346372756 we + # have permission to use the official firefox branding. + # + # For purposes of documentation the statement of @sylvestre: + # > As the person who did part of the work described in the LWN article + # > and release manager working for Mozilla, I can confirm the statement + # > that I made in + # > https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=815006 + # > + # > @garbas shared with me the list of patches applied for the Nix package. + # > As they are just for portability and tiny modifications, they don't + # > alter the experience of the product. In parallel, Rok also shared the + # > build options. They seem good (even if I cannot judge the quality of the + # > packaging of the underlying dependencies like sqlite, png, etc). + # > Therefor, as long as you keep the patch queue sane and you don't alter + # > the experience of Firefox users, you won't have any issues using the + # > official branding. + , + enableOfficialBranding ? true }: -with lib; +assert stdenv.cc.libc or null != null; +assert pipewireSupport -> !waylandSupport || !webrtcSupport -> throw + "${pname}: pipewireSupport requires both wayland and webrtc support."; let + inherit (lib) + enableFeature + ; + + # Target the LLVM version that rustc is built with for LTO. + llvmPackages0 = rustc.llvmPackages; + llvmPackagesBuildBuild0 = pkgsBuildBuild.rustc.llvmPackages; + + # Force the use of lld and other llvm tools for LTO + llvmPackages = llvmPackages0.override { + bootBintoolsNoLibc = null; + bootBintools = null; + }; + llvmPackagesBuildBuild = llvmPackagesBuildBuild0.override { + bootBintoolsNoLibc = null; + bootBintools = null; + }; - inherit (config.boot) kernelPatches; - inherit (config.boot.kernel) features randstructSeed; - inherit (config.boot.kernelPackages) kernel; - - kernelModulesConf = pkgs.writeText "nixos.conf" '' - ${concatStringsSep "\n" config.boot.kernelModules} + # LTO requires LLVM bintools including ld.lld and llvm-ar. + buildStdenv = overrideCC llvmPackages.stdenv + (llvmPackages.stdenv.cc.override { + bintools = + if ltoSupport then + buildPackages.rustc.llvmPackages.bintools + else + stdenv.cc.bintools + ; + }); + + # Compile the wasm32 sysroot to build the RLBox Sandbox + # https://hacks.mozilla.org/2021/12/webassembly-and-back-again-fine-grained-sandboxing-in-firefox-95/ + # We only link c++ libs here, our compiler wrapper can find wasi libc and crt itself. + wasiSysRoot = runCommand "wasi-sysroot" { } '' + mkdir -p $out/lib/wasm32-wasi + for lib in ${pkgsCross.wasi32.llvmPackages.libcxx}/lib/* ${pkgsCross.wasi32.llvmPackages.libcxxabi}/lib/*; do + ln -s $lib $out/lib/wasm32-wasi + done ''; -in { - - ###### interface - - options = { - - boot.kernel.features = mkOption { - default = { }; - example = literalExpression "{ debug = true; }"; - internal = true; - description = '' - This option allows to enable or disable certain kernel features. - It's not API, because it's about kernel feature sets, that - make sense for specific use cases. Mostly along with programs, - which would have separate nixos options. - `grep features pkgs/os-specific/linux/kernel/common-config.nix` - ''; - }; + distributionIni = pkgs.writeText "distribution.ini" + (lib.generators.toINI { } { + # Some light branding indicating this build uses our distro preferences + Global = { + id = "nixos"; + version = "1.0"; + about = "${applicationName} for NixOS"; + }; + Preferences = { + # These values are exposed through telemetry + "app.distributor" = "nixos"; + "app.distributor.channel" = "nixpkgs"; + "app.partner.nixos" = "nixos"; + }; + }); - boot.kernelPackages = mkOption { - default = pkgs.linuxPackages; - type = types.unspecified // { merge = mergeEqualOption; }; - apply = - kernelPackages: - kernelPackages.extend (self: super: { - kernel = super.kernel.override (originalArgs: { - inherit randstructSeed; - kernelPatches = - (originalArgs.kernelPatches or [ ]) ++ kernelPatches; - features = lib.recursiveUpdate super.kernel.features features; - }); - }) + defaultPrefs = { + "geo.provider.network.url" = { + value = + "https://location.services.mozilla.com/v1/geolocate?key=%MOZILLA_API_KEY%" + ; + reason = + "Use MLS by default for geolocation, since our Google API Keys are not working" ; - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. - defaultText = literalExpression "pkgs.linuxPackages"; - example = literalExpression "pkgs.linuxKernel.packages.linux_5_10"; - description = '' - This option allows you to override the Linux kernel used by - NixOS. Since things like external kernel module packages are - tied to the kernel you're using, it also overrides those. - This option is a function that takes Nixpkgs as an argument - (as a convenience), and returns an attribute set containing at - the very least an attribute kernel. - Additional attributes may be needed depending on your - configuration. For instance, if you use the NVIDIA X driver, - then it also needs to contain an attribute - nvidia_x11. - ''; - }; - - boot.kernelPatches = mkOption { - type = types.listOf types.attrs; - default = [ ]; - example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; - description = "A list of additional patches to apply to the kernel."; - }; - - boot.kernel.randstructSeed = mkOption { - type = types.str; - default = ""; - example = "my secret seed"; - description = '' - Provides a custom seed for the RANDSTRUCT security - option of the Linux kernel. Note that RANDSTRUCT is - only enabled in NixOS hardened kernels. Using a custom seed requires - building the kernel and dependent packages locally, since this - customization happens at build time. - ''; - }; - - boot.kernelParams = mkOption { - type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { - name = "kernelParam"; - description = "string, with spaces inside double quotes"; - }); - default = [ ]; - description = "Parameters added to the kernel command line."; }; + }; - boot.consoleLogLevel = mkOption { - type = types.int; - default = 4; - description = '' - The kernel console loglevel. All Kernel Messages with a log level smaller - than this setting will be printed to the console. - ''; - }; + defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" + (lib.concatStringsSep "\n" (lib.mapAttrsToList (key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '') defaultPrefs)); - boot.vesa = mkOption { - type = types.bool; - default = false; - description = '' - (Deprecated) This option, if set, activates the VESA 800x600 video - mode on boot and disables kernel modesetting. It is equivalent to - specifying [ "vga=0x317" "nomodeset" ] in the - option. This option is - deprecated as of 2020: Xorg now works better with modesetting, and - you might want a different VESA vga setting, anyway. - ''; - }; +in +buildStdenv.mkDerivation ({ + pname = "${pname}-unwrapped"; + inherit version; - boot.extraModulePackages = mkOption { - type = types.listOf types.package; - default = [ ]; - example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; - description = "A list of additional packages supplying kernel modules."; - }; + inherit src unpackPhase meta; - boot.kernelModules = mkOption { - type = types.listOf types.str; - default = [ ]; - description = '' - The set of kernel modules to be loaded in the second stage of - the boot process. Note that modules that are needed to - mount the root file system should be added to - or - . - ''; - }; + outputs = [ "out" ] ++ lib.optionals crashreporterSupport [ "symbols" ]; - boot.initrd.availableKernelModules = mkOption { - type = types.listOf types.str; - default = [ ]; - example = [ - "sata_nv" - "ext3" - ]; - description = '' - The set of kernel modules in the initial ramdisk used during the - boot process. This set must include all modules necessary for - mounting the root device. That is, it should include modules - for the physical device (e.g., SCSI drivers) and for the file - system (e.g., ext3). The set specified here is automatically - closed under the module dependency relation, i.e., all - dependencies of the modules list here are included - automatically. The modules listed here are available in the - initrd, but are only loaded on demand (e.g., the ext3 module is - loaded automatically when an ext3 filesystem is mounted, and - modules for PCI devices are loaded when they match the PCI ID - of a device in your system). To force a module to be loaded, - include it in . - ''; - }; + # Add another configure-build-profiling run before the final configure phase if we build with pgo + preConfigurePhases = lib.optionals pgoSupport [ + "configurePhase" + "buildPhase" + "profilingPhase" + ]; - boot.initrd.kernelModules = mkOption { - type = types.listOf types.str; - default = [ ]; - description = "List of modules that are always loaded by the initrd."; - }; + patches = lib.optionals (lib.versionOlder version "102.6.0") [ (fetchpatch { + # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 + name = "rust-cbindgen-0.24.2-compat.patch"; + url = + "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch" + ; + hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; + }) ] ++ lib.optional (lib.versionOlder version "111") + ./env_var_for_system_dir-ff86.patch + ++ lib.optional (lib.versionAtLeast version "111") + ./env_var_for_system_dir-ff111.patch + ++ lib.optional (lib.versionAtLeast version "96") + ./no-buildconfig-ffx96.patch ++ extraPatches; + + postPatch = '' + rm -rf obj-x86_64-pc-linux-gnu + patchShebangs mach build + '' + extraPostPatch; + + # Ignore trivial whitespace changes in patches, this fixes compatibility of + # ./env_var_for_system_dir.patch with Firefox >=65 without having to track + # two patches. + patchFlags = [ + "-p1" + "-l" + ]; - boot.initrd.includeDefaultModules = mkOption { - type = types.bool; - default = true; - description = '' - This option, if set, adds a collection of default kernel modules - to and - . - ''; - }; + # if not explicitly set, wrong cc from buildStdenv would be used + HOST_CC = "${llvmPackagesBuildBuild.stdenv.cc}/bin/cc"; + HOST_CXX = "${llvmPackagesBuildBuild.stdenv.cc}/bin/c++"; + + nativeBuildInputs = [ + autoconf + cargo + gnum4 + llvmPackagesBuildBuild.bintools + makeWrapper + nodejs + perl + pkg-config + python3 + rust-cbindgen + rustPlatform.bindgenHook + rustc + unzip + which + wrapGAppsHook + ] ++ lib.optionals crashreporterSupport [ + dump_syms + patchelf + ] ++ lib.optionals pgoSupport [ xvfb-run ] ++ extraNativeBuildInputs; + + setOutputFlags = + false; # `./mach configure` doesn't understand `--*dir=` flags. + + preConfigure = '' + # remove distributed configuration files + rm -f configure js/src/configure .mozconfig* + + # Runs autoconf through ./mach configure in configurePhase + configureScript="$(realpath ./mach) configure" + + # Set predictable directories for build and state + export MOZ_OBJDIR=$(pwd)/mozobj + export MOZBUILD_STATE_PATH=$(pwd)/mozbuild + + # Don't try to send libnotify notifications during build + export MOZ_NOSPAM=1 + + # Set consistent remoting name to ensure wmclass matches with desktop file + export MOZ_APP_REMOTINGNAME="${binaryName}" + + # AS=as in the environment causes build failure + # https://bugzilla.mozilla.org/show_bug.cgi?id=1497286 + unset AS + + # Use our own python + export MACH_BUILD_PYTHON_NATIVE_PACKAGE_SOURCE=system + + # RBox WASM Sandboxing + export WASM_CC=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}cc + export WASM_CXX=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}c++ + '' + lib.optionalString pgoSupport '' + if [ -e "$TMPDIR/merged.profdata" ]; then + echo "Configuring with profiling data" + for i in "''${!configureFlagsArray[@]}"; do + if [[ ''${configureFlagsArray[i]} = "--enable-profile-generate=cross" ]]; then + unset 'configureFlagsArray[i]' + fi + done + configureFlagsArray+=( + "--enable-profile-use=cross" + "--with-pgo-profile-path="$TMPDIR/merged.profdata"" + "--with-pgo-jarlog="$TMPDIR/jarlog"" + ) + else + echo "Configuring to generate profiling data" + configureFlagsArray+=( + "--enable-profile-generate=cross" + ) + fi + '' + lib.optionalString googleAPISupport '' + # Google API key used by Chromium and Firefox. + # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, + # please get your own set of keys at https://www.chromium.org/developers/how-tos/api-keys/. + echo "AIzaSyDGi15Zwl11UNe6Y-5XW_upsfyw31qwZPI" > $TMPDIR/google-api-key + # 60.5+ & 66+ did split the google API key arguments: https://bugzilla.mozilla.org/show_bug.cgi?id=1531176 + configureFlagsArray+=("--with-google-location-service-api-keyfile=$TMPDIR/google-api-key") + configureFlagsArray+=("--with-google-safebrowsing-api-keyfile=$TMPDIR/google-api-key") + '' + lib.optionalString mlsAPISupport '' + # Mozilla Location services API key + # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, + # please get your own set of keys at https://location.services.mozilla.com/api. + echo "dfd7836c-d458-4917-98bb-421c82d3c8a0" > $TMPDIR/mls-api-key + configureFlagsArray+=("--with-mozilla-api-keyfile=$TMPDIR/mls-api-key") + '' + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' + export MOZILLA_OFFICIAL=1 + ''; - system.modulesTree = mkOption { - type = types.listOf types.path; - internal = true; - default = [ ]; - description = '' - Tree of kernel modules. This includes the kernel, plus modules - built outside of the kernel. Combine these into a single tree of - symlinks because modprobe only supports one directory. - ''; - # Convert the list of path to only one path. - apply = pkgs.aggregateModules; - }; + # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags + configurePlatforms = [ ]; + + configureFlags = [ + "--disable-tests" + "--disable-updater" + "--enable-application=${application}" + "--enable-default-toolkit=cairo-gtk3${ + lib.optionalString waylandSupport "-wayland" + }" + "--enable-system-pixman" + "--with-distribution-id=org.nixos" + "--with-libclang-path=${llvmPackagesBuildBuild.libclang.lib}/lib" + "--with-system-ffi" + "--with-system-icu" + "--with-system-jpeg" + "--with-system-libevent" + "--with-system-libvpx" + "--with-system-nspr" + "--with-system-nss" + "--with-system-png" # needs APNG support + "--with-system-webp" + "--with-system-zlib" + "--with-wasi-sysroot=${wasiSysRoot}" + # for firefox, host is buildPlatform, target is hostPlatform + "--host=${buildStdenv.buildPlatform.config}" + "--target=${buildStdenv.hostPlatform.config}" + ] + # LTO is done using clang and lld on Linux. + ++ lib.optionals ltoSupport [ + "--enable-lto=cross" # Cross-Language LTO + "--enable-linker=lld" + ] + # elf-hack is broken when using clang+lld: + # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 + ++ lib.optional (ltoSupport + && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64)) + "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ + (enableFeature alsaSupport "alsa") + (enableFeature crashreporterSupport "crashreporter") + (enableFeature ffmpegSupport "ffmpeg") + (enableFeature geolocationSupport "necko-wifi") + (enableFeature gssSupport "negotiateauth") + (enableFeature jackSupport "jack") + (enableFeature jemallocSupport "jemalloc") + (enableFeature pulseaudioSupport "pulseaudio") + (enableFeature sndioSupport "sndio") + (enableFeature webrtcSupport "webrtc") + (enableFeature debugBuild "debug") + (if debugBuild then + "--enable-profiling" + else + "--enable-optimize") + # --enable-release adds -ffunction-sections & LTO that require a big amount + # of RAM, and the 32-bit memory space cannot handle that linking + (enableFeature (!debugBuild && !stdenv.is32bit) "release") + (enableFeature enableDebugSymbols "debug-symbols") + ] ++ lib.optionals enableDebugSymbols [ + "--disable-strip" + "--disable-install-strip" + ] ++ lib.optional enableOfficialBranding "--enable-official-branding" + ++ lib.optional (branding != null) "--with-branding=${branding}" + ++ extraConfigureFlags; + + buildInputs = [ + bzip2 + dbus + dbus-glib + file + fontconfig + freetype + glib + gtk3 + icu + libffi + libGL + libGLU + libevent + libjpeg + libpng + libstartup_notification + libvpx + libwebp + nasm + nspr + pango + perl + xorg.libX11 + xorg.libXcursor + xorg.libXdamage + xorg.libXext + xorg.libXft + xorg.libXi + xorg.libXrender + xorg.libXt + xorg.libXtst + xorg.pixman + xorg.xorgproto + zip + zlib + ] ++ [ (if (lib.versionAtLeast version "103") then + nss_latest + else + nss_esr) ] ++ lib.optional alsaSupport alsa-lib + ++ lib.optional jackSupport libjack2 + ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed + ++ lib.optional sndioSupport sndio ++ lib.optional gssSupport libkrb5 + ++ lib.optionals waylandSupport [ + libxkbcommon + libdrm + ] ++ lib.optional jemallocSupport jemalloc ++ extraBuildInputs; + + profilingPhase = lib.optionalString pgoSupport '' + # Package up Firefox for profiling + ./mach package + + # Run profiling + ( + export HOME=$TMPDIR + export LLVM_PROFDATA=llvm-profdata + export JARLOG_FILE="$TMPDIR/jarlog" + + xvfb-run -w 10 -s "-screen 0 1920x1080x24" \ + ./mach python ./build/pgo/profileserver.py + ) + + # Copy profiling data to a place we can easily reference + cp ./merged.profdata $TMPDIR/merged.profdata + + # Clean build dir + ./mach clobber + ''; - system.requiredKernelConfig = mkOption { - default = [ ]; - example = literalExpression '' - with config.lib.kernelConfig; [ - (isYes "MODULES") - (isEnabled "FB_CON_DECOR") - (isEnabled "BLK_DEV_INITRD") - ] - ''; - internal = true; - type = types.listOf types.attrs; - description = '' - This option allows modules to specify the kernel config options that - must be set (or unset) for the module to work. Please use the - lib.kernelConfig functions to build list elements. - ''; - }; + preBuild = '' + cd mozobj + ''; - }; + postBuild = '' + cd .. + ''; - ###### implementation - - config = mkMerge [ - (mkIf config.boot.initrd.enable { - boot.initrd.availableKernelModules = - optionals config.boot.initrd.includeDefaultModules ([ - # Note: most of these (especially the SATA/PATA modules) - # shouldn't be included by default since nixos-generate-config - # detects them, but I'm keeping them for now for backwards - # compatibility. - - # Some SATA/PATA stuff. - "ahci" - "sata_nv" - "sata_via" - "sata_sis" - "sata_uli" - "ata_piix" - "pata_marvell" - - # Standard SCSI stuff. - "sd_mod" - "sr_mod" - - # SD cards and internal eMMC drives. - "mmc_block" - - # Support USB keyboards, in case the boot fails and we only have - # a USB keyboard, or for LUKS passphrase prompt. - "uhci_hcd" - "ehci_hcd" - "ehci_pci" - "ohci_hcd" - "ohci_pci" - "xhci_hcd" - "xhci_pci" - "usbhid" - "hid_generic" - "hid_lenovo" - "hid_apple" - "hid_roccat" - "hid_logitech_hidpp" - "hid_logitech_dj" - "hid_microsoft" - - ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ - # Misc. x86 keyboard stuff. - "pcips2" - "atkbd" - "i8042" - - # x86 RTC needed by the stage 2 init script. - "rtc_cmos" - ]); - - boot.initrd.kernelModules = - optionals config.boot.initrd.includeDefaultModules [ - # For LVM. - "dm_mod" - ]; - }) - - (mkIf (!config.boot.isContainer) { - system.build = { inherit kernel; }; - - system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; - - # Implement consoleLogLevel both in early boot and using sysctl - # (so you don't need to reboot to have changes take effect). - boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] - ++ optionals config.boot.vesa [ - "vga=0x317" - "nomodeset" - ]; - - boot.kernel.sysctl."kernel.printk" = - mkDefault config.boot.consoleLogLevel; - - boot.kernelModules = [ - "loop" - "atkbd" - ]; - - # The Linux kernel >= 2.6.27 provides firmware. - hardware.firmware = [ kernel ]; - - # Create /etc/modules-load.d/nixos.conf, which is read by - # systemd-modules-load.service to load required kernel modules. - environment.etc = { - "modules-load.d/nixos.conf".source = kernelModulesConf; - }; + makeFlags = extraMakeFlags; + separateDebugInfo = enableDebugSymbols; + enableParallelBuilding = true; + + # tests were disabled in configureFlags + doCheck = false; + + # Generate build symbols once after the final build + # https://firefox-source-docs.mozilla.org/crash-reporting/uploading_symbol.html + preInstall = lib.optionalString crashreporterSupport '' + ./mach buildsymbols + mkdir -p $symbols/ + cp mozobj/dist/*.crashreporter-symbols.zip $symbols/ + '' + '' + cd mozobj + ''; - systemd.services.systemd-modules-load = { - wantedBy = [ "multi-user.target" ]; - restartTriggers = [ kernelModulesConf ]; - serviceConfig = { # Ignore failed module loads. Typically some of the - # modules in ‘boot.kernelModules’ are "nice to have but - # not required" (e.g. acpi-cpufreq), so we don't want to - # barf on those. - SuccessExitStatus = "0 1"; - }; - }; + postInstall = '' + # Install distribution customizations + install -Dvm644 ${distributionIni} $out/lib/${binaryName}/distribution/distribution.ini + install -Dvm644 ${defaultPrefsFile} $out/lib/${binaryName}/browser/defaults/preferences/nixos-default-prefs.js - lib.kernelConfig = { - isYes = - option: { - assertion = config: config.isYes option; - message = "CONFIG_${option} is not yes!"; - configLine = "CONFIG_${option}=y"; - } - ; - - isNo = - option: { - assertion = config: config.isNo option; - message = "CONFIG_${option} is not no!"; - configLine = "CONFIG_${option}=n"; - } - ; - - isModule = - option: { - assertion = config: config.isModule option; - message = "CONFIG_${option} is not built as a module!"; - configLine = "CONFIG_${option}=m"; - } - ; - - ### Usually you will just want to use these two - # True if yes or module - isEnabled = - option: { - assertion = config: config.isEnabled option; - message = "CONFIG_${option} is not enabled!"; - configLine = "CONFIG_${option}=y"; - } - ; - - # True if no or omitted - isDisabled = - option: { - assertion = config: config.isDisabled option; - message = "CONFIG_${option} is not disabled!"; - configLine = "CONFIG_${option}=n"; - } - ; - }; + '' + lib.optionalString buildStdenv.isLinux '' + # Remove SDK cruft. FIXME: move to a separate output? + rm -rf $out/share/idl $out/include $out/lib/${binaryName}-devel-* - # The config options that all modules can depend upon - system.requiredKernelConfig = with config.lib.kernelConfig; - [ - # !!! Should this really be needed? - (isYes "MODULES") - (isYes "BINFMT_ELF") - ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); - - # nixpkgs kernels are assumed to have all required features - assertions = - if config.boot.kernelPackages.kernel ? features then - [ ] - else - let - cfg = config.boot.kernelPackages.kernel.config; - in - map (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) config.system.requiredKernelConfig - ; + # Needed to find Mozilla runtime + gappsWrapperArgs+=(--argv0 "$out/bin/.${binaryName}-wrapped") + ''; - }) + postFixup = lib.optionalString crashreporterSupport '' + patchelf --add-rpath "${ + lib.makeLibraryPath [ curl ] + }" $out/lib/${binaryName}/crashreporter + ''; - ]; + doInstallCheck = true; + installCheckPhase = '' + # Some basic testing + "$out/bin/${binaryName}" --version + ''; -} + passthru = { + inherit updateScript; + inherit version; + inherit alsaSupport; + inherit binaryName; + inherit jackSupport; + inherit pipewireSupport; + inherit sndioSupport; + inherit nspr; + inherit ffmpegSupport; + inherit gssSupport; + inherit tests; + inherit gtk3; + inherit wasiSysRoot; + } // extraPassthru; + + hardeningDisable = [ "format" ]; # -Werror=format-security + + # the build system verifies checksums of the bundled rust sources + # ./third_party/rust is be patched by our libtool fixup code in stdenv + # unfortunately we can't just set this to `false` when we do not want it. + # See https://github.com/NixOS/nixpkgs/issues/77289 for more details + # Ideally we would figure out how to tell the build system to not + # care about changed hashes as we are already doing that when we + # fetch the sources. Any further modifications of the source tree + # is on purpose by some of our tool (or by accident and a bug?). + dontFixLibtool = true; + + # on aarch64 this is also required + dontUpdateAutotoolsGnuConfigScripts = true; + + requiredSystemFeatures = [ "big-parallel" ]; +}) From dafec156f0333fceec0775baf703ab92ddd4e402 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 7 May 2023 11:52:58 +0200 Subject: [PATCH 020/125] fixup! Rework bindings --- src/Nixfmt/Pretty.hs | 26 ++++++++++++++------------ test/diff/idioms_pkgs_3/out.nix | 9 +++------ test/diff/monsters_1/out.nix | 3 +-- test/diff/monsters_3/out.nix | 3 +-- test/diff/monsters_4/out.nix | 3 +-- 5 files changed, 20 insertions(+), 24 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 3a3d7b52..439d1887 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -84,19 +84,21 @@ instance Pretty Binder where -- `foo = bar` pretty (Assignment selectors assign expr semicolon) = base $ group $ hcat selectors <> hardspace - <> nest 2 (pretty assign <> absorbInner expr) + <> nest 2 (pretty assign <> inner) where - -- Function declaration / If statement / Let binding - -- If it is multi-line, force it into a new line with indentation, semicolon on separate line - absorbInner expr@(Abstraction _ _ _) = line <> pretty expr <> line' <> pretty semicolon - absorbInner expr@(If _ _ _ _ _ _) = line <> pretty expr <> line' <> pretty semicolon - absorbInner expr@(Let _ _ _ _) = line <> pretty expr <> line' <> pretty semicolon - -- Absorbable term (list/attrset) - -- force-absorb the term and then the semicolon - absorbInner expr@(Term t) | isAbsorbable t = hardspace <> group expr <> softline' <> pretty semicolon - -- `foo = bar`, otherwise - -- Try to absorb and keep the semicolon attached, spread otherwise - absorbInner expr = softline <> group (pretty expr <> softline' <> pretty semicolon) + inner = + case expr of + -- Function declaration / If statement / Let binding + -- If it is multi-line, force it into a new line with indentation, semicolon on separate line + (Abstraction _ _ _) -> line <> pretty expr <> line' <> pretty semicolon + (If _ _ _ _ _ _) -> line <> pretty expr <> line' <> pretty semicolon + (Let _ _ _ _) -> line <> pretty expr <> line' <> pretty semicolon + -- Term + -- Absorb and keep the semicolon attached if possible + (Term t) -> (if isAbsorbable t then hardspace else softline) <> group expr <> pretty semicolon + -- Everything else + -- Try to absorb and keep the semicolon attached, spread otherwise + _ -> softline <> group (pretty expr <> softline' <> pretty semicolon) -- | Pretty print a term without wrapping it in a group. diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index fea7c990..d48009d0 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -225,11 +225,9 @@ let defaultPrefs = { "geo.provider.network.url" = { value = - "https://location.services.mozilla.com/v1/geolocate?key=%MOZILLA_API_KEY%" - ; + "https://location.services.mozilla.com/v1/geolocate?key=%MOZILLA_API_KEY%"; reason = - "Use MLS by default for geolocation, since our Google API Keys are not working" - ; + "Use MLS by default for geolocation, since our Google API Keys are not working"; }; }; @@ -259,8 +257,7 @@ buildStdenv.mkDerivation ({ # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 name = "rust-cbindgen-0.24.2-compat.patch"; url = - "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch" - ; + "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; }) ] ++ lib.optional (lib.versionOlder version "111") ./env_var_for_system_dir-ff86.patch diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index e6895770..beea1434 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -232,8 +232,7 @@ rec # foo = # foo - "Checks whether the contrast between two colors meet the WCAG requirements" - ; + "Checks whether the contrast between two colors meet the WCAG requirements"; # foo homepage # foo diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index fac5cee4..0f66f531 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -60,8 +60,7 @@ stdenv.mkDerivation rec { ''; meta = with lib; { description = - "Checks whether the contrast between two colors meet the WCAG requirements" - ; + "Checks whether the contrast between two colors meet the WCAG requirements"; homepage = "https://gitlab.gnome.org/World/design/contrast"; license = licenses.gpl3Plus; maintainers = with maintainers; [ jtojnar ]; diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 90d57edc..10c74252 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -118,8 +118,7 @@ rec # Foo { # Foo description # Foo = # Foo - "Checks whether the contrast between two colors meet the WCAG requirements" - ; # Foo + "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo homepage # Foo = # Foo "https://gitlab.gnome.org/World/design/contrast"; # Foo From de7bd6d38d72d340f67293c2f727ff716a254a7b Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 7 May 2023 12:19:20 +0200 Subject: [PATCH 021/125] Expand singleton lists with a multiline item Except when that item is another list or attribute set --- src/Nixfmt/Pretty.hs | 9 ++++++++- test/diff/idioms_pkgs_3/out.nix | 27 +++++++++++++++------------ test/diff/lists/in.nix | 15 +++++++++++++++ test/diff/lists/out.nix | 21 +++++++++++++++++++++ 4 files changed, 59 insertions(+), 13 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 439d1887..9b4c8e65 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -113,10 +113,17 @@ prettyTerm (List (Ann paropen Nothing []) [] parclose) = pretty paropen <> hardspace <> pretty parclose -- Singleton list +-- Expand unless absorbable term or single line prettyTerm (List (Ann paropen Nothing []) [item] parclose) - = pretty paropen <> hardspace <> pretty item <> hardspace <> pretty parclose + = pretty paropen + <> (if isAbsorbable item then + (hardspace <> pretty item <> hardspace) + else + (nest 2 (line <> pretty item <> line)) + ) <> pretty parclose -- General list +-- Always expand prettyTerm (List (Ann paropen trailing leading) items parclose) = base $ pretty paropen <> pretty trailing <> hardline <> nest 2 (pretty leading <> sepBy hardline (map group items)) <> hardline diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index d48009d0..255c0a11 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -253,13 +253,15 @@ buildStdenv.mkDerivation ({ "profilingPhase" ]; - patches = lib.optionals (lib.versionOlder version "102.6.0") [ (fetchpatch { - # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 - name = "rust-cbindgen-0.24.2-compat.patch"; - url = - "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; - hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; - }) ] ++ lib.optional (lib.versionOlder version "111") + patches = lib.optionals (lib.versionOlder version "102.6.0") [ + (fetchpatch { + # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 + name = "rust-cbindgen-0.24.2-compat.patch"; + url = + "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; + hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; + }) + ] ++ lib.optional (lib.versionOlder version "111") ./env_var_for_system_dir-ff86.patch ++ lib.optional (lib.versionAtLeast version "111") ./env_var_for_system_dir-ff111.patch @@ -471,11 +473,12 @@ buildStdenv.mkDerivation ({ xorg.xorgproto zip zlib - ] ++ [ (if (lib.versionAtLeast version "103") then - nss_latest - else - nss_esr) ] ++ lib.optional alsaSupport alsa-lib - ++ lib.optional jackSupport libjack2 + ] ++ [ + (if (lib.versionAtLeast version "103") then + nss_latest + else + nss_esr) + ] ++ lib.optional alsaSupport alsa-lib ++ lib.optional jackSupport libjack2 ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed ++ lib.optional sndioSupport sndio ++ lib.optional gssSupport libkrb5 ++ lib.optionals waylandSupport [ diff --git a/test/diff/lists/in.nix b/test/diff/lists/in.nix index bf96dfb4..6798858e 100644 --- a/test/diff/lists/in.nix +++ b/test/diff/lists/in.nix @@ -1,4 +1,14 @@ [ + [ { + # multiline + foo = "bar"; + foo2 = "barbar"; + } ] + [ (if foo then + bar #multiline too + else + baz + )] [ 1 ] [ 1 @@ -43,4 +53,9 @@ ] + + [ [ multi line ] ] + [ [ [ singleton ] ] ] + [ [ [ { } ] ] ] + [ [ [ { } multiline ] ] ] ] diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 83a2a53f..7ddc70a1 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -1,4 +1,15 @@ [ + [ { + # multiline + foo = "bar"; + foo2 = "barbar"; + } ] + [ + (if foo then + bar # multiline too + else + baz) + ] [ 1 ] [ 1 ] @@ -57,4 +68,14 @@ ] + [ [ + multi + line + ] ] + [ [ [ singleton ] ] ] + [ [ [ { } ] ] ] + [ [ [ + { } + multiline + ] ] ] ] From d1ba3cd5fb5ead1c316ee4665359aa936ed0d8a1 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 7 May 2023 23:23:50 +0200 Subject: [PATCH 022/125] Test: add idioms_nixos_2 This is nixos/modules/services/web-apps/nextcloud.nix, so that we have a big NixOS module in our suite --- test/diff/idioms_nixos_2/in.nix | 1144 +++++++++++++++++++++++++ test/diff/idioms_nixos_2/out.nix | 1334 ++++++++++++++++++++++++++++++ 2 files changed, 2478 insertions(+) create mode 100644 test/diff/idioms_nixos_2/in.nix create mode 100644 test/diff/idioms_nixos_2/out.nix diff --git a/test/diff/idioms_nixos_2/in.nix b/test/diff/idioms_nixos_2/in.nix new file mode 100644 index 00000000..76a01727 --- /dev/null +++ b/test/diff/idioms_nixos_2/in.nix @@ -0,0 +1,1144 @@ +{ config, lib, pkgs, ... }: + +with lib; + +let + cfg = config.services.nextcloud; + fpm = config.services.phpfpm.pools.nextcloud; + + jsonFormat = pkgs.formats.json {}; + + inherit (cfg) datadir; + + phpPackage = cfg.phpPackage.buildEnv { + extensions = { enabled, all }: + (with all; + # disable default openssl extension + (lib.filter (e: e.pname != "php-openssl") enabled) + # use OpenSSL 1.1 for RC4 Nextcloud encryption if user + # has acknowledged the brokenness of the ciphers (RC4). + # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. + ++ (if cfg.enableBrokenCiphersForSSE then [ cfg.phpPackage.extensions.openssl-legacy ] else [ cfg.phpPackage.extensions.openssl ]) + ++ optional cfg.enableImagemagick imagick + # Optionally enabled depending on caching settings + ++ optional cfg.caching.apcu apcu + ++ optional cfg.caching.redis redis + ++ optional cfg.caching.memcached memcached + ) + ++ cfg.phpExtraExtensions all; # Enabled by user + extraConfig = toKeyValue phpOptions; + }; + + toKeyValue = generators.toKeyValue { + mkKeyValue = generators.mkKeyValueDefault {} " = "; + }; + + phpOptions = { + upload_max_filesize = cfg.maxUploadSize; + post_max_size = cfg.maxUploadSize; + memory_limit = cfg.maxUploadSize; + } // cfg.phpOptions + // optionalAttrs cfg.caching.apcu { + "apc.enable_cli" = "1"; + }; + + occ = pkgs.writeScriptBin "nextcloud-occ" '' + #! ${pkgs.runtimeShell} + cd ${cfg.package} + sudo=exec + if [[ "$USER" != nextcloud ]]; then + sudo='exec /run/wrappers/bin/sudo -u nextcloud --preserve-env=NEXTCLOUD_CONFIG_DIR --preserve-env=OC_PASS' + fi + export NEXTCLOUD_CONFIG_DIR="${datadir}/config" + $sudo \ + ${phpPackage}/bin/php \ + occ "$@" + ''; + + inherit (config.system) stateVersion; + +in { + + imports = [ + (mkRemovedOptionModule [ "services" "nextcloud" "config" "adminpass" ] '' + Please use `services.nextcloud.config.adminpassFile' instead! + '') + (mkRemovedOptionModule [ "services" "nextcloud" "config" "dbpass" ] '' + Please use `services.nextcloud.config.dbpassFile' instead! + '') + (mkRemovedOptionModule [ "services" "nextcloud" "nginx" "enable" ] '' + The nextcloud module supports `nginx` as reverse-proxy by default and doesn't + support other reverse-proxies officially. + + However it's possible to use an alternative reverse-proxy by + + * disabling nginx + * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value + + Further details about this can be found in the `Nextcloud`-section of the NixOS-manual + (which can be opened e.g. by running `nixos-help`). + '') + (mkRemovedOptionModule [ "services" "nextcloud" "disableImagemagick" ] '' + Use services.nextcloud.enableImagemagick instead. + '') + ]; + + options.services.nextcloud = { + enable = mkEnableOption (lib.mdDoc "nextcloud"); + + enableBrokenCiphersForSSE = mkOption { + type = types.bool; + default = versionOlder stateVersion "22.11"; + defaultText = literalExpression "versionOlder system.stateVersion \"22.11\""; + description = lib.mdDoc '' + This option enables using the OpenSSL PHP extension linked against OpenSSL 1.1 + rather than latest OpenSSL (≥ 3), this is not recommended unless you need + it for server-side encryption (SSE). SSE uses the legacy RC4 cipher which is + considered broken for several years now. See also [RFC7465](https://datatracker.ietf.org/doc/html/rfc7465). + + This cipher has been disabled in OpenSSL ≥ 3 and requires + a specific legacy profile to re-enable it. + + If you deploy Nextcloud using OpenSSL ≥ 3 for PHP and have + server-side encryption configured, you will not be able to access + your files anymore. Enabling this option can restore access to your files. + Upon testing we didn't encounter any data corruption when turning + this on and off again, but this cannot be guaranteed for + each Nextcloud installation. + + It is `true` by default for systems with a [](#opt-system.stateVersion) below + `22.11` to make sure that existing installations won't break on update. On newer + NixOS systems you have to explicitly enable it on your own. + + Please note that this only provides additional value when using + external storage such as S3 since it's not an end-to-end encryption. + If this is not the case, + it is advised to [disable server-side encryption](https://docs.nextcloud.com/server/latest/admin_manual/configuration_files/encryption_configuration.html#disabling-encryption) and set this to `false`. + + In the future, Nextcloud may move to AES-256-GCM, by then, + this option will be removed. + ''; + }; + hostName = mkOption { + type = types.str; + description = lib.mdDoc "FQDN for the nextcloud instance."; + }; + home = mkOption { + type = types.str; + default = "/var/lib/nextcloud"; + description = lib.mdDoc "Storage path of nextcloud."; + }; + datadir = mkOption { + type = types.str; + default = config.services.nextcloud.home; + defaultText = literalExpression "config.services.nextcloud.home"; + description = lib.mdDoc '' + Data storage path of nextcloud. Will be [](#opt-services.nextcloud.home) by default. + This folder will be populated with a config.php and data folder which contains the state of the instance (excl the database)."; + ''; + example = "/mnt/nextcloud-file"; + }; + extraApps = mkOption { + type = types.attrsOf types.package; + default = { }; + description = lib.mdDoc '' + Extra apps to install. Should be an attrSet of appid to packages generated by fetchNextcloudApp. + The appid must be identical to the "id" value in the apps appinfo/info.xml. + Using this will disable the appstore to prevent Nextcloud from updating these apps (see [](#opt-services.nextcloud.appstoreEnable)). + ''; + example = literalExpression '' + { + maps = pkgs.fetchNextcloudApp { + name = "maps"; + sha256 = "007y80idqg6b6zk6kjxg4vgw0z8fsxs9lajnv49vv1zjy6jx2i1i"; + url = "https://github.com/nextcloud/maps/releases/download/v0.1.9/maps-0.1.9.tar.gz"; + version = "0.1.9"; + }; + phonetrack = pkgs.fetchNextcloudApp { + name = "phonetrack"; + sha256 = "0qf366vbahyl27p9mshfma1as4nvql6w75zy2zk5xwwbp343vsbc"; + url = "https://gitlab.com/eneiluj/phonetrack-oc/-/wikis/uploads/931aaaf8dca24bf31a7e169a83c17235/phonetrack-0.6.9.tar.gz"; + version = "0.6.9"; + }; + } + ''; + }; + extraAppsEnable = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc '' + Automatically enable the apps in [](#opt-services.nextcloud.extraApps) every time nextcloud starts. + If set to false, apps need to be enabled in the Nextcloud user interface or with nextcloud-occ app:enable. + ''; + }; + appstoreEnable = mkOption { + type = types.nullOr types.bool; + default = null; + example = true; + description = lib.mdDoc '' + Allow the installation of apps and app updates from the store. + Enabled by default unless there are packages in [](#opt-services.nextcloud.extraApps). + Set to true to force enable the store even if [](#opt-services.nextcloud.extraApps) is used. + Set to false to disable the installation of apps from the global appstore. App management is always enabled regardless of this setting. + ''; + }; + logLevel = mkOption { + type = types.ints.between 0 4; + default = 2; + description = lib.mdDoc "Log level value between 0 (DEBUG) and 4 (FATAL)."; + }; + logType = mkOption { + type = types.enum [ "errorlog" "file" "syslog" "systemd" ]; + default = "syslog"; + description = lib.mdDoc '' + Logging backend to use. + systemd requires the php-systemd package to be added to services.nextcloud.phpExtraExtensions. + See the [nextcloud documentation](https://docs.nextcloud.com/server/latest/admin_manual/configuration_server/logging_configuration.html) for details. + ''; + }; + https = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc "Use https for generated links."; + }; + package = mkOption { + type = types.package; + description = lib.mdDoc "Which package to use for the Nextcloud instance."; + relatedPackages = [ "nextcloud24" "nextcloud25" "nextcloud26" ]; + }; + phpPackage = mkOption { + type = types.package; + relatedPackages = [ "php80" "php81" ]; + defaultText = "pkgs.php"; + description = lib.mdDoc '' + PHP package to use for Nextcloud. + ''; + }; + + maxUploadSize = mkOption { + default = "512M"; + type = types.str; + description = lib.mdDoc '' + Defines the upload limit for files. This changes the relevant options + in php.ini and nginx if enabled. + ''; + }; + + skeletonDirectory = mkOption { + default = ""; + type = types.str; + description = lib.mdDoc '' + The directory where the skeleton files are located. These files will be + copied to the data directory of new users. Leave empty to not copy any + skeleton files. + ''; + }; + + webfinger = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Enable this option if you plan on using the webfinger plugin. + The appropriate nginx rewrite rules will be added to your configuration. + ''; + }; + + phpExtraExtensions = mkOption { + type = with types; functionTo (listOf package); + default = all: []; + defaultText = literalExpression "all: []"; + description = lib.mdDoc '' + Additional PHP extensions to use for nextcloud. + By default, only extensions necessary for a vanilla nextcloud installation are enabled, + but you may choose from the list of available extensions and add further ones. + This is sometimes necessary to be able to install a certain nextcloud app that has additional requirements. + ''; + example = literalExpression '' + all: [ all.pdlib all.bz2 ] + ''; + }; + + phpOptions = mkOption { + type = types.attrsOf types.str; + default = { + short_open_tag = "Off"; + expose_php = "Off"; + error_reporting = "E_ALL & ~E_DEPRECATED & ~E_STRICT"; + display_errors = "stderr"; + "opcache.enable_cli" = "1"; + "opcache.interned_strings_buffer" = "8"; + "opcache.max_accelerated_files" = "10000"; + "opcache.memory_consumption" = "128"; + "opcache.revalidate_freq" = "1"; + "opcache.fast_shutdown" = "1"; + "openssl.cafile" = "/etc/ssl/certs/ca-certificates.crt"; + catch_workers_output = "yes"; + }; + description = lib.mdDoc '' + Options for PHP's php.ini file for nextcloud. + ''; + }; + + poolSettings = mkOption { + type = with types; attrsOf (oneOf [ str int bool ]); + default = { + "pm" = "dynamic"; + "pm.max_children" = "32"; + "pm.start_servers" = "2"; + "pm.min_spare_servers" = "2"; + "pm.max_spare_servers" = "4"; + "pm.max_requests" = "500"; + }; + description = lib.mdDoc '' + Options for nextcloud's PHP pool. See the documentation on `php-fpm.conf` for details on configuration directives. + ''; + }; + + poolConfig = mkOption { + type = types.nullOr types.lines; + default = null; + description = lib.mdDoc '' + Options for nextcloud's PHP pool. See the documentation on `php-fpm.conf` for details on configuration directives. + ''; + }; + + fastcgiTimeout = mkOption { + type = types.int; + default = 120; + description = lib.mdDoc '' + FastCGI timeout for database connection in seconds. + ''; + }; + + database = { + + createLocally = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Create the database and database user locally. Only available for + mysql database. + Note that this option will use the latest version of MariaDB which + is not officially supported by Nextcloud. As for now a workaround + is used to also support MariaDB version >= 10.6. + ''; + }; + + }; + + + config = { + dbtype = mkOption { + type = types.enum [ "sqlite" "pgsql" "mysql" ]; + default = "sqlite"; + description = lib.mdDoc "Database type."; + }; + dbname = mkOption { + type = types.nullOr types.str; + default = "nextcloud"; + description = lib.mdDoc "Database name."; + }; + dbuser = mkOption { + type = types.nullOr types.str; + default = "nextcloud"; + description = lib.mdDoc "Database user."; + }; + dbpassFile = mkOption { + type = types.nullOr types.str; + default = null; + description = lib.mdDoc '' + The full path to a file that contains the database password. + ''; + }; + dbhost = mkOption { + type = types.nullOr types.str; + default = "localhost"; + description = lib.mdDoc '' + Database host. + + Note: for using Unix authentication with PostgreSQL, this should be + set to `/run/postgresql`. + ''; + }; + dbport = mkOption { + type = with types; nullOr (either int str); + default = null; + description = lib.mdDoc "Database port."; + }; + dbtableprefix = mkOption { + type = types.nullOr types.str; + default = null; + description = lib.mdDoc "Table prefix in Nextcloud database."; + }; + adminuser = mkOption { + type = types.str; + default = "root"; + description = lib.mdDoc "Admin username."; + }; + adminpassFile = mkOption { + type = types.str; + description = lib.mdDoc '' + The full path to a file that contains the admin's password. Must be + readable by user `nextcloud`. + ''; + }; + + extraTrustedDomains = mkOption { + type = types.listOf types.str; + default = []; + description = lib.mdDoc '' + Trusted domains, from which the nextcloud installation will be + accessible. You don't need to add + `services.nextcloud.hostname` here. + ''; + }; + + trustedProxies = mkOption { + type = types.listOf types.str; + default = []; + description = lib.mdDoc '' + Trusted proxies, to provide if the nextcloud installation is being + proxied to secure against e.g. spoofing. + ''; + }; + + overwriteProtocol = mkOption { + type = types.nullOr (types.enum [ "http" "https" ]); + default = null; + example = "https"; + + description = lib.mdDoc '' + Force Nextcloud to always use HTTPS i.e. for link generation. Nextcloud + uses the currently used protocol by default, but when behind a reverse-proxy, + it may use `http` for everything although Nextcloud + may be served via HTTPS. + ''; + }; + + defaultPhoneRegion = mkOption { + default = null; + type = types.nullOr types.str; + example = "DE"; + description = lib.mdDoc '' + ::: {.warning} + This option exists since Nextcloud 21! If older versions are used, + this will throw an eval-error! + ::: + + [ISO 3611-1](https://www.iso.org/iso-3166-country-codes.html) + country codes for automatic phone-number detection without a country code. + + With e.g. `DE` set, the `+49` can be omitted for + phone-numbers. + ''; + }; + + objectstore = { + s3 = { + enable = mkEnableOption (lib.mdDoc '' + S3 object storage as primary storage. + + This mounts a bucket on an Amazon S3 object storage or compatible + implementation into the virtual filesystem. + + Further details about this feature can be found in the + [upstream documentation](https://docs.nextcloud.com/server/22/admin_manual/configuration_files/primary_storage.html). + ''); + bucket = mkOption { + type = types.str; + example = "nextcloud"; + description = lib.mdDoc '' + The name of the S3 bucket. + ''; + }; + autocreate = mkOption { + type = types.bool; + description = lib.mdDoc '' + Create the objectstore if it does not exist. + ''; + }; + key = mkOption { + type = types.str; + example = "EJ39ITYZEUH5BGWDRUFY"; + description = lib.mdDoc '' + The access key for the S3 bucket. + ''; + }; + secretFile = mkOption { + type = types.str; + example = "/var/nextcloud-objectstore-s3-secret"; + description = lib.mdDoc '' + The full path to a file that contains the access secret. Must be + readable by user `nextcloud`. + ''; + }; + hostname = mkOption { + type = types.nullOr types.str; + default = null; + example = "example.com"; + description = lib.mdDoc '' + Required for some non-Amazon implementations. + ''; + }; + port = mkOption { + type = types.nullOr types.port; + default = null; + description = lib.mdDoc '' + Required for some non-Amazon implementations. + ''; + }; + useSsl = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc '' + Use SSL for objectstore access. + ''; + }; + region = mkOption { + type = types.nullOr types.str; + default = null; + example = "REGION"; + description = lib.mdDoc '' + Required for some non-Amazon implementations. + ''; + }; + usePathStyle = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Required for some non-Amazon S3 implementations. + + Ordinarily, requests will be made with + `http://bucket.hostname.domain/`, but with path style + enabled requests are made with + `http://hostname.domain/bucket` instead. + ''; + }; + sseCKeyFile = mkOption { + type = types.nullOr types.path; + default = null; + example = "/var/nextcloud-objectstore-s3-sse-c-key"; + description = lib.mdDoc '' + If provided this is the full path to a file that contains the key + to enable [server-side encryption with customer-provided keys][1] + (SSE-C). + + The file must contain a random 32-byte key encoded as a base64 + string, e.g. generated with the command + + ``` + openssl rand 32 | base64 + ``` + + Must be readable by user `nextcloud`. + + [1]: https://docs.aws.amazon.com/AmazonS3/latest/userguide/ServerSideEncryptionCustomerKeys.html + ''; + }; + }; + }; + }; + + enableImagemagick = mkEnableOption (lib.mdDoc '' + the ImageMagick module for PHP. + This is used by the theming app and for generating previews of certain images (e.g. SVG and HEIF). + You may want to disable it for increased security. In that case, previews will still be available + for some images (e.g. JPEG and PNG). + See . + '') // { + default = true; + }; + + caching = { + apcu = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc '' + Whether to load the APCu module into PHP. + ''; + }; + redis = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Whether to load the Redis module into PHP. + You still need to enable Redis in your config.php. + See https://docs.nextcloud.com/server/14/admin_manual/configuration_server/caching_configuration.html + ''; + }; + memcached = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Whether to load the Memcached module into PHP. + You still need to enable Memcached in your config.php. + See https://docs.nextcloud.com/server/14/admin_manual/configuration_server/caching_configuration.html + ''; + }; + }; + autoUpdateApps = { + enable = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Run regular auto update of all apps installed from the nextcloud app store. + ''; + }; + startAt = mkOption { + type = with types; either str (listOf str); + default = "05:00:00"; + example = "Sun 14:00:00"; + description = lib.mdDoc '' + When to run the update. See `systemd.services..startAt`. + ''; + }; + }; + occ = mkOption { + type = types.package; + default = occ; + defaultText = literalMD "generated script"; + internal = true; + description = lib.mdDoc '' + The nextcloud-occ program preconfigured to target this Nextcloud instance. + ''; + }; + globalProfiles = mkEnableOption (lib.mdDoc "global profiles") // { + description = lib.mdDoc '' + Makes user-profiles globally available under `nextcloud.tld/u/user.name`. + Even though it's enabled by default in Nextcloud, it must be explicitly enabled + here because it has the side-effect that personal information is even accessible to + unauthenticated users by default. + + By default, the following properties are set to “Show to everyone” + if this flag is enabled: + - About + - Full name + - Headline + - Organisation + - Profile picture + - Role + - Twitter + - Website + + Only has an effect in Nextcloud 23 and later. + ''; + }; + + extraOptions = mkOption { + type = jsonFormat.type; + default = {}; + description = lib.mdDoc '' + Extra options which should be appended to nextcloud's config.php file. + ''; + example = literalExpression '' { + redis = { + host = "/run/redis/redis.sock"; + port = 0; + dbindex = 0; + password = "secret"; + timeout = 1.5; + }; + } ''; + }; + + secretFile = mkOption { + type = types.nullOr types.str; + default = null; + description = lib.mdDoc '' + Secret options which will be appended to nextcloud's config.php file (written as JSON, in the same + form as the [](#opt-services.nextcloud.extraOptions) option), for example + `{"redis":{"password":"secret"}}`. + ''; + }; + + nginx = { + recommendedHttpHeaders = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc "Enable additional recommended HTTP response headers"; + }; + hstsMaxAge = mkOption { + type = types.ints.positive; + default = 15552000; + description = lib.mdDoc '' + Value for the `max-age` directive of the HTTP + `Strict-Transport-Security` header. + + See section 6.1.1 of IETF RFC 6797 for detailed information on this + directive and header. + ''; + }; + }; + }; + + config = mkIf cfg.enable (mkMerge [ + { warnings = let + latest = 26; + upgradeWarning = major: nixos: + '' + A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. + + After nextcloud${toString major} is installed successfully, you can safely upgrade + to ${toString (major + 1)}. The latest version available is nextcloud${toString latest}. + + Please note that Nextcloud doesn't support upgrades across multiple major versions + (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). + + The package can be upgraded by explicitly declaring the service-option + `services.nextcloud.package`. + ''; + + in (optional (cfg.poolConfig != null) '' + Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. + Please migrate your configuration to config.services.nextcloud.poolSettings. + '') + ++ (optional (versionOlder cfg.package.version "23") (upgradeWarning 22 "22.05")) + ++ (optional (versionOlder cfg.package.version "24") (upgradeWarning 23 "22.05")) + ++ (optional (versionOlder cfg.package.version "25") (upgradeWarning 24 "22.11")) + ++ (optional (versionOlder cfg.package.version "26") (upgradeWarning 25 "23.05")) + ++ (optional cfg.enableBrokenCiphersForSSE '' + You're using PHP's openssl extension built against OpenSSL 1.1 for Nextcloud. + This is only necessary if you're using Nextcloud's server-side encryption. + Please keep in mind that it's using the broken RC4 cipher. + + If you don't use that feature, you can switch to OpenSSL 3 and get + rid of this warning by declaring + + services.nextcloud.enableBrokenCiphersForSSE = false; + + If you need to use server-side encryption you can ignore this warning. + Otherwise you'd have to disable server-side encryption first in order + to be able to safely disable this option and get rid of this warning. + See on how to achieve this. + + For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 + ''); + + services.nextcloud.package = with pkgs; + mkDefault ( + if pkgs ? nextcloud + then throw '' + The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default + nextcloud defined in an overlay, please set `services.nextcloud.package` to + `pkgs.nextcloud`. + '' + else if versionOlder stateVersion "22.11" then nextcloud24 + else if versionOlder stateVersion "23.05" then nextcloud25 + else nextcloud26 + ); + + services.nextcloud.phpPackage = + if versionOlder cfg.package.version "26" then pkgs.php81 + else pkgs.php82; + } + + { assertions = [ + { assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; + message = ''services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true.''; + } + ]; } + + { systemd.timers.nextcloud-cron = { + wantedBy = [ "timers.target" ]; + after = [ "nextcloud-setup.service" ]; + timerConfig.OnBootSec = "5m"; + timerConfig.OnUnitActiveSec = "5m"; + timerConfig.Unit = "nextcloud-cron.service"; + }; + + systemd.tmpfiles.rules = ["d ${cfg.home} 0750 nextcloud nextcloud"]; + + systemd.services = { + # When upgrading the Nextcloud package, Nextcloud can report errors such as + # "The files of the app [all apps in /var/lib/nextcloud/apps] were not replaced correctly" + # Restarting phpfpm on Nextcloud package update fixes these issues (but this is a workaround). + phpfpm-nextcloud.restartTriggers = [ cfg.package ]; + + nextcloud-setup = let + c = cfg.config; + writePhpArray = a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]"; + requiresReadSecretFunction = c.dbpassFile != null || c.objectstore.s3.enable; + objectstoreConfig = let s3 = c.objectstore.s3; in optionalString s3.enable '' + 'objectstore' => [ + 'class' => '\\OC\\Files\\ObjectStore\\S3', + 'arguments' => [ + 'bucket' => '${s3.bucket}', + 'autocreate' => ${boolToString s3.autocreate}, + 'key' => '${s3.key}', + 'secret' => nix_read_secret('${s3.secretFile}'), + ${optionalString (s3.hostname != null) "'hostname' => '${s3.hostname}',"} + ${optionalString (s3.port != null) "'port' => ${toString s3.port},"} + 'use_ssl' => ${boolToString s3.useSsl}, + ${optionalString (s3.region != null) "'region' => '${s3.region}',"} + 'use_path_style' => ${boolToString s3.usePathStyle}, + ${optionalString (s3.sseCKeyFile != null) "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}'),"} + ], + ] + ''; + + showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != {}; + renderedAppStoreSetting = + let + x = cfg.appstoreEnable; + in + if x == null then "false" + else boolToString x; + + nextcloudGreaterOrEqualThan = req: versionAtLeast cfg.package.version req; + + overrideConfig = pkgs.writeText "nextcloud-config.php" '' + [ + ${optionalString (cfg.extraApps != { }) "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ],"} + [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], + [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], + ], + ${optionalString (showAppStoreSetting) "'appstoreenabled' => ${renderedAppStoreSetting},"} + 'datadirectory' => '${datadir}/data', + 'skeletondirectory' => '${cfg.skeletonDirectory}', + ${optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu',"} + 'log_type' => '${cfg.logType}', + 'loglevel' => '${builtins.toString cfg.logLevel}', + ${optionalString (c.overwriteProtocol != null) "'overwriteprotocol' => '${c.overwriteProtocol}',"} + ${optionalString (c.dbname != null) "'dbname' => '${c.dbname}',"} + ${optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}',"} + ${optionalString (c.dbport != null) "'dbport' => '${toString c.dbport}',"} + ${optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}',"} + ${optionalString (c.dbtableprefix != null) "'dbtableprefix' => '${toString c.dbtableprefix}',"} + ${optionalString (c.dbpassFile != null) '' + 'dbpassword' => nix_read_secret( + "${c.dbpassFile}" + ), + '' + } + 'dbtype' => '${c.dbtype}', + 'trusted_domains' => ${writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains)}, + 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, + ${optionalString (c.defaultPhoneRegion != null) "'default_phone_region' => '${c.defaultPhoneRegion}',"} + ${optionalString (nextcloudGreaterOrEqualThan "23") "'profile.enabled' => ${boolToString cfg.globalProfiles},"} + ${objectstoreConfig} + ]; + + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( + "${jsonFormat.generate "nextcloud-extraOptions.json" cfg.extraOptions}", + "impossible: this should never happen (decoding generated extraOptions file %s failed)" + )); + + ${optionalString (cfg.secretFile != null) '' + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( + "${cfg.secretFile}", + "Cannot start Nextcloud, secrets file %s set by NixOS doesn't exist!" + )); + ''} + ''; + occInstallCmd = let + mkExport = { arg, value }: "export ${arg}=${value}"; + dbpass = { + arg = "DBPASS"; + value = if c.dbpassFile != null + then ''"$(<"${toString c.dbpassFile}")"'' + else ''""''; + }; + adminpass = { + arg = "ADMINPASS"; + value = ''"$(<"${toString c.adminpassFile}")"''; + }; + installFlags = concatStringsSep " \\\n " + (mapAttrsToList (k: v: "${k} ${toString v}") { + "--database" = ''"${c.dbtype}"''; + # The following attributes are optional depending on the type of + # database. Those that evaluate to null on the left hand side + # will be omitted. + ${if c.dbname != null then "--database-name" else null} = ''"${c.dbname}"''; + ${if c.dbhost != null then "--database-host" else null} = ''"${c.dbhost}"''; + ${if c.dbport != null then "--database-port" else null} = ''"${toString c.dbport}"''; + ${if c.dbuser != null then "--database-user" else null} = ''"${c.dbuser}"''; + "--database-pass" = "\"\$${dbpass.arg}\""; + "--admin-user" = ''"${c.adminuser}"''; + "--admin-pass" = "\"\$${adminpass.arg}\""; + "--data-dir" = ''"${datadir}/data"''; + }); + in '' + ${mkExport dbpass} + ${mkExport adminpass} + ${occ}/bin/nextcloud-occ maintenance:install \ + ${installFlags} + ''; + occSetTrustedDomainsCmd = concatStringsSep "\n" (imap0 + (i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains)); + + in { + wantedBy = [ "multi-user.target" ]; + before = [ "phpfpm-nextcloud.service" ]; + path = [ occ ]; + script = '' + ${optionalString (c.dbpassFile != null) '' + if [ ! -r "${c.dbpassFile}" ]; then + echo "dbpassFile ${c.dbpassFile} is not readable by nextcloud:nextcloud! Aborting..." + exit 1 + fi + if [ -z "$(<${c.dbpassFile})" ]; then + echo "dbpassFile ${c.dbpassFile} is empty!" + exit 1 + fi + ''} + if [ ! -r "${c.adminpassFile}" ]; then + echo "adminpassFile ${c.adminpassFile} is not readable by nextcloud:nextcloud! Aborting..." + exit 1 + fi + if [ -z "$(<${c.adminpassFile})" ]; then + echo "adminpassFile ${c.adminpassFile} is empty!" + exit 1 + fi + + ln -sf ${cfg.package}/apps ${cfg.home}/ + + # Install extra apps + ln -sfT \ + ${pkgs.linkFarm "nix-apps" + (mapAttrsToList (name: path: { inherit name path; }) cfg.extraApps)} \ + ${cfg.home}/nix-apps + + # create nextcloud directories. + # if the directories exist already with wrong permissions, we fix that + for dir in ${datadir}/config ${datadir}/data ${cfg.home}/store-apps ${cfg.home}/nix-apps; do + if [ ! -e $dir ]; then + install -o nextcloud -g nextcloud -d $dir + elif [ $(stat -c "%G" $dir) != "nextcloud" ]; then + chgrp -R nextcloud $dir + fi + done + + ln -sf ${overrideConfig} ${datadir}/config/override.config.php + + # Do not install if already installed + if [[ ! -e ${datadir}/config/config.php ]]; then + ${occInstallCmd} + fi + + ${occ}/bin/nextcloud-occ upgrade + + ${occ}/bin/nextcloud-occ config:system:delete trusted_domains + + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' + # Try to enable apps + ${occ}/bin/nextcloud-occ app:enable ${concatStringsSep " " (attrNames cfg.extraApps)} + ''} + + ${occSetTrustedDomainsCmd} + ''; + serviceConfig.Type = "oneshot"; + serviceConfig.User = "nextcloud"; + # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent + # an automatic creation of the database user. + environment.NC_setup_create_db_user = lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; + }; + nextcloud-cron = { + after = [ "nextcloud-setup.service" ]; + environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + serviceConfig.Type = "oneshot"; + serviceConfig.User = "nextcloud"; + serviceConfig.ExecStart = "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; + }; + nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { + after = [ "nextcloud-setup.service" ]; + serviceConfig.Type = "oneshot"; + serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; + serviceConfig.User = "nextcloud"; + startAt = cfg.autoUpdateApps.startAt; + }; + }; + + services.phpfpm = { + pools.nextcloud = { + user = "nextcloud"; + group = "nextcloud"; + phpPackage = phpPackage; + phpEnv = { + NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + PATH = "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; + }; + settings = mapAttrs (name: mkDefault) { + "listen.owner" = config.services.nginx.user; + "listen.group" = config.services.nginx.group; + } // cfg.poolSettings; + extraConfig = cfg.poolConfig; + }; + }; + + users.users.nextcloud = { + home = "${cfg.home}"; + group = "nextcloud"; + isSystemUser = true; + }; + users.groups.nextcloud.members = [ "nextcloud" config.services.nginx.user ]; + + environment.systemPackages = [ occ ]; + + services.mysql = lib.mkIf cfg.database.createLocally { + enable = true; + package = lib.mkDefault pkgs.mariadb; + ensureDatabases = [ cfg.config.dbname ]; + ensureUsers = [{ + name = cfg.config.dbuser; + ensurePermissions = { "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; }; + }]; + initialScript = pkgs.writeText "mysql-init" '' + CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${builtins.readFile( cfg.config.dbpassFile )}'; + CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; + GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, + CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' + IDENTIFIED BY '${builtins.readFile( cfg.config.dbpassFile )}'; + FLUSH privileges; + ''; + }; + + services.nginx.enable = mkDefault true; + + services.nginx.virtualHosts.${cfg.hostName} = { + root = cfg.package; + locations = { + "= /robots.txt" = { + priority = 100; + extraConfig = '' + allow all; + access_log off; + ''; + }; + "= /" = { + priority = 100; + extraConfig = '' + if ( $http_user_agent ~ ^DavClnt ) { + return 302 /remote.php/webdav/$is_args$args; + } + ''; + }; + "/" = { + priority = 900; + extraConfig = "rewrite ^ /index.php;"; + }; + "~ ^/store-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "~ ^/nix-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "^~ /.well-known" = { + priority = 210; + extraConfig = '' + absolute_redirect off; + location = /.well-known/carddav { + return 301 /remote.php/dav; + } + location = /.well-known/caldav { + return 301 /remote.php/dav; + } + location ~ ^/\.well-known/(?!acme-challenge|pki-validation) { + return 301 /index.php$request_uri; + } + try_files $uri $uri/ =404; + ''; + }; + "~ ^/(?:build|tests|config|lib|3rdparty|templates|data)(?:$|/)".extraConfig = '' + return 404; + ''; + "~ ^/(?:\\.(?!well-known)|autotest|occ|issue|indie|db_|console)".extraConfig = '' + return 404; + ''; + "~ ^\\/(?:index|remote|public|cron|core\\/ajax\\/update|status|ocs\\/v[12]|updater\\/.+|oc[ms]-provider\\/.+|.+\\/richdocumentscode\\/proxy)\\.php(?:$|\\/)" = { + priority = 500; + extraConfig = '' + include ${config.services.nginx.package}/conf/fastcgi.conf; + fastcgi_split_path_info ^(.+?\.php)(\\/.*)$; + set $path_info $fastcgi_path_info; + try_files $fastcgi_script_name =404; + fastcgi_param PATH_INFO $path_info; + fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; + fastcgi_param HTTPS ${if cfg.https then "on" else "off"}; + fastcgi_param modHeadersAvailable true; + fastcgi_param front_controller_active true; + fastcgi_pass unix:${fpm.socket}; + fastcgi_intercept_errors on; + fastcgi_request_buffering off; + fastcgi_read_timeout ${builtins.toString cfg.fastcgiTimeout}s; + ''; + }; + "~ \\.(?:css|js|woff2?|svg|gif|map)$".extraConfig = '' + try_files $uri /index.php$request_uri; + expires 6M; + access_log off; + ''; + "~ ^\\/(?:updater|ocs-provider|ocm-provider)(?:$|\\/)".extraConfig = '' + try_files $uri/ =404; + index index.php; + ''; + "~ \\.(?:png|html|ttf|ico|jpg|jpeg|bcmap|mp4|webm)$".extraConfig = '' + try_files $uri /index.php$request_uri; + access_log off; + ''; + }; + extraConfig = '' + index index.php index.html /index.php$request_uri; + ${optionalString (cfg.nginx.recommendedHttpHeaders) '' + add_header X-Content-Type-Options nosniff; + add_header X-XSS-Protection "1; mode=block"; + add_header X-Robots-Tag "noindex, nofollow"; + add_header X-Download-Options noopen; + add_header X-Permitted-Cross-Domain-Policies none; + add_header X-Frame-Options sameorigin; + add_header Referrer-Policy no-referrer; + ''} + ${optionalString (cfg.https) '' + add_header Strict-Transport-Security "max-age=${toString cfg.nginx.hstsMaxAge}; includeSubDomains" always; + ''} + client_max_body_size ${cfg.maxUploadSize}; + fastcgi_buffers 64 4K; + fastcgi_hide_header X-Powered-By; + gzip on; + gzip_vary on; + gzip_comp_level 4; + gzip_min_length 256; + gzip_proxied expired no-cache no-store private no_last_modified no_etag auth; + gzip_types application/atom+xml application/javascript application/json application/ld+json application/manifest+json application/rss+xml application/vnd.geo+json application/vnd.ms-fontobject application/x-font-ttf application/x-web-app-manifest+json application/xhtml+xml application/xml font/opentype image/bmp image/svg+xml image/x-icon text/cache-manifest text/css text/plain text/vcard text/vnd.rim.location.xloc text/vtt text/x-component text/x-cross-domain-policy; + + ${optionalString cfg.webfinger '' + rewrite ^/.well-known/host-meta /public.php?service=host-meta last; + rewrite ^/.well-known/host-meta.json /public.php?service=host-meta-json last; + ''} + ''; + }; + } + ]); + + meta.doc = ./nextcloud.md; +} diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix new file mode 100644 index 00000000..ddedc74b --- /dev/null +++ b/test/diff/idioms_nixos_2/out.nix @@ -0,0 +1,1334 @@ +{ + config, + lib, + pkgs, + ... +}: + +with lib; + +let + cfg = config.services.nextcloud; + fpm = config.services.phpfpm.pools.nextcloud; + + jsonFormat = pkgs.formats.json { }; + + inherit (cfg) datadir; + + phpPackage = cfg.phpPackage.buildEnv { + extensions = + { + enabled, + all, + }: + (with all; + # disable default openssl extension + (lib.filter (e: e.pname != "php-openssl") enabled) + # use OpenSSL 1.1 for RC4 Nextcloud encryption if user + # has acknowledged the brokenness of the ciphers (RC4). + # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. + ++ (if cfg.enableBrokenCiphersForSSE then + [ cfg.phpPackage.extensions.openssl-legacy ] + else + [ cfg.phpPackage.extensions.openssl ]) + ++ optional cfg.enableImagemagick imagick + # Optionally enabled depending on caching settings + ++ optional cfg.caching.apcu apcu ++ optional cfg.caching.redis redis + ++ optional cfg.caching.memcached memcached) + ++ cfg.phpExtraExtensions all + ; # Enabled by user + extraConfig = toKeyValue phpOptions; + }; + + toKeyValue = generators.toKeyValue { + mkKeyValue = generators.mkKeyValueDefault { } " = "; + }; + + phpOptions = { + upload_max_filesize = cfg.maxUploadSize; + post_max_size = cfg.maxUploadSize; + memory_limit = cfg.maxUploadSize; + } // cfg.phpOptions + // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; }; + + occ = pkgs.writeScriptBin "nextcloud-occ" '' + #! ${pkgs.runtimeShell} + cd ${cfg.package} + sudo=exec + if [[ "$USER" != nextcloud ]]; then + sudo='exec /run/wrappers/bin/sudo -u nextcloud --preserve-env=NEXTCLOUD_CONFIG_DIR --preserve-env=OC_PASS' + fi + export NEXTCLOUD_CONFIG_DIR="${datadir}/config" + $sudo \ + ${phpPackage}/bin/php \ + occ "$@" + ''; + + inherit (config.system) stateVersion; + +in { + + imports = [ + (mkRemovedOptionModule [ + "services" + "nextcloud" + "config" + "adminpass" + ] '' + Please use `services.nextcloud.config.adminpassFile' instead! + '') + (mkRemovedOptionModule [ + "services" + "nextcloud" + "config" + "dbpass" + ] '' + Please use `services.nextcloud.config.dbpassFile' instead! + '') + (mkRemovedOptionModule [ + "services" + "nextcloud" + "nginx" + "enable" + ] '' + The nextcloud module supports `nginx` as reverse-proxy by default and doesn't + support other reverse-proxies officially. + + However it's possible to use an alternative reverse-proxy by + + * disabling nginx + * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value + + Further details about this can be found in the `Nextcloud`-section of the NixOS-manual + (which can be opened e.g. by running `nixos-help`). + '') + (mkRemovedOptionModule [ + "services" + "nextcloud" + "disableImagemagick" + ] '' + Use services.nextcloud.enableImagemagick instead. + '') + ]; + + options.services.nextcloud = { + enable = mkEnableOption (lib.mdDoc "nextcloud"); + + enableBrokenCiphersForSSE = mkOption { + type = types.bool; + default = versionOlder stateVersion "22.11"; + defaultText = + literalExpression ''versionOlder system.stateVersion "22.11"''; + description = lib.mdDoc '' + This option enables using the OpenSSL PHP extension linked against OpenSSL 1.1 + rather than latest OpenSSL (≥ 3), this is not recommended unless you need + it for server-side encryption (SSE). SSE uses the legacy RC4 cipher which is + considered broken for several years now. See also [RFC7465](https://datatracker.ietf.org/doc/html/rfc7465). + + This cipher has been disabled in OpenSSL ≥ 3 and requires + a specific legacy profile to re-enable it. + + If you deploy Nextcloud using OpenSSL ≥ 3 for PHP and have + server-side encryption configured, you will not be able to access + your files anymore. Enabling this option can restore access to your files. + Upon testing we didn't encounter any data corruption when turning + this on and off again, but this cannot be guaranteed for + each Nextcloud installation. + + It is `true` by default for systems with a [](#opt-system.stateVersion) below + `22.11` to make sure that existing installations won't break on update. On newer + NixOS systems you have to explicitly enable it on your own. + + Please note that this only provides additional value when using + external storage such as S3 since it's not an end-to-end encryption. + If this is not the case, + it is advised to [disable server-side encryption](https://docs.nextcloud.com/server/latest/admin_manual/configuration_files/encryption_configuration.html#disabling-encryption) and set this to `false`. + + In the future, Nextcloud may move to AES-256-GCM, by then, + this option will be removed. + ''; + }; + hostName = mkOption { + type = types.str; + description = lib.mdDoc "FQDN for the nextcloud instance."; + }; + home = mkOption { + type = types.str; + default = "/var/lib/nextcloud"; + description = lib.mdDoc "Storage path of nextcloud."; + }; + datadir = mkOption { + type = types.str; + default = config.services.nextcloud.home; + defaultText = literalExpression "config.services.nextcloud.home"; + description = lib.mdDoc '' + Data storage path of nextcloud. Will be [](#opt-services.nextcloud.home) by default. + This folder will be populated with a config.php and data folder which contains the state of the instance (excl the database)."; + ''; + example = "/mnt/nextcloud-file"; + }; + extraApps = mkOption { + type = types.attrsOf types.package; + default = { }; + description = lib.mdDoc '' + Extra apps to install. Should be an attrSet of appid to packages generated by fetchNextcloudApp. + The appid must be identical to the "id" value in the apps appinfo/info.xml. + Using this will disable the appstore to prevent Nextcloud from updating these apps (see [](#opt-services.nextcloud.appstoreEnable)). + ''; + example = literalExpression '' + { + maps = pkgs.fetchNextcloudApp { + name = "maps"; + sha256 = "007y80idqg6b6zk6kjxg4vgw0z8fsxs9lajnv49vv1zjy6jx2i1i"; + url = "https://github.com/nextcloud/maps/releases/download/v0.1.9/maps-0.1.9.tar.gz"; + version = "0.1.9"; + }; + phonetrack = pkgs.fetchNextcloudApp { + name = "phonetrack"; + sha256 = "0qf366vbahyl27p9mshfma1as4nvql6w75zy2zk5xwwbp343vsbc"; + url = "https://gitlab.com/eneiluj/phonetrack-oc/-/wikis/uploads/931aaaf8dca24bf31a7e169a83c17235/phonetrack-0.6.9.tar.gz"; + version = "0.6.9"; + }; + } + ''; + }; + extraAppsEnable = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc '' + Automatically enable the apps in [](#opt-services.nextcloud.extraApps) every time nextcloud starts. + If set to false, apps need to be enabled in the Nextcloud user interface or with nextcloud-occ app:enable. + ''; + }; + appstoreEnable = mkOption { + type = types.nullOr types.bool; + default = null; + example = true; + description = lib.mdDoc '' + Allow the installation of apps and app updates from the store. + Enabled by default unless there are packages in [](#opt-services.nextcloud.extraApps). + Set to true to force enable the store even if [](#opt-services.nextcloud.extraApps) is used. + Set to false to disable the installation of apps from the global appstore. App management is always enabled regardless of this setting. + ''; + }; + logLevel = mkOption { + type = types.ints.between 0 4; + default = 2; + description = + lib.mdDoc "Log level value between 0 (DEBUG) and 4 (FATAL)."; + }; + logType = mkOption { + type = types.enum [ + "errorlog" + "file" + "syslog" + "systemd" + ]; + default = "syslog"; + description = lib.mdDoc '' + Logging backend to use. + systemd requires the php-systemd package to be added to services.nextcloud.phpExtraExtensions. + See the [nextcloud documentation](https://docs.nextcloud.com/server/latest/admin_manual/configuration_server/logging_configuration.html) for details. + ''; + }; + https = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc "Use https for generated links."; + }; + package = mkOption { + type = types.package; + description = + lib.mdDoc "Which package to use for the Nextcloud instance."; + relatedPackages = [ + "nextcloud24" + "nextcloud25" + "nextcloud26" + ]; + }; + phpPackage = mkOption { + type = types.package; + relatedPackages = [ + "php80" + "php81" + ]; + defaultText = "pkgs.php"; + description = lib.mdDoc '' + PHP package to use for Nextcloud. + ''; + }; + + maxUploadSize = mkOption { + default = "512M"; + type = types.str; + description = lib.mdDoc '' + Defines the upload limit for files. This changes the relevant options + in php.ini and nginx if enabled. + ''; + }; + + skeletonDirectory = mkOption { + default = ""; + type = types.str; + description = lib.mdDoc '' + The directory where the skeleton files are located. These files will be + copied to the data directory of new users. Leave empty to not copy any + skeleton files. + ''; + }; + + webfinger = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Enable this option if you plan on using the webfinger plugin. + The appropriate nginx rewrite rules will be added to your configuration. + ''; + }; + + phpExtraExtensions = mkOption { + type = with types; functionTo (listOf package); + default = all: [ ]; + defaultText = literalExpression "all: []"; + description = lib.mdDoc '' + Additional PHP extensions to use for nextcloud. + By default, only extensions necessary for a vanilla nextcloud installation are enabled, + but you may choose from the list of available extensions and add further ones. + This is sometimes necessary to be able to install a certain nextcloud app that has additional requirements. + ''; + example = literalExpression '' + all: [ all.pdlib all.bz2 ] + ''; + }; + + phpOptions = mkOption { + type = types.attrsOf types.str; + default = { + short_open_tag = "Off"; + expose_php = "Off"; + error_reporting = "E_ALL & ~E_DEPRECATED & ~E_STRICT"; + display_errors = "stderr"; + "opcache.enable_cli" = "1"; + "opcache.interned_strings_buffer" = "8"; + "opcache.max_accelerated_files" = "10000"; + "opcache.memory_consumption" = "128"; + "opcache.revalidate_freq" = "1"; + "opcache.fast_shutdown" = "1"; + "openssl.cafile" = "/etc/ssl/certs/ca-certificates.crt"; + catch_workers_output = "yes"; + }; + description = lib.mdDoc '' + Options for PHP's php.ini file for nextcloud. + ''; + }; + + poolSettings = mkOption { + type = with types; + attrsOf (oneOf [ + str + int + bool + ]); + default = { + "pm" = "dynamic"; + "pm.max_children" = "32"; + "pm.start_servers" = "2"; + "pm.min_spare_servers" = "2"; + "pm.max_spare_servers" = "4"; + "pm.max_requests" = "500"; + }; + description = lib.mdDoc '' + Options for nextcloud's PHP pool. See the documentation on `php-fpm.conf` for details on configuration directives. + ''; + }; + + poolConfig = mkOption { + type = types.nullOr types.lines; + default = null; + description = lib.mdDoc '' + Options for nextcloud's PHP pool. See the documentation on `php-fpm.conf` for details on configuration directives. + ''; + }; + + fastcgiTimeout = mkOption { + type = types.int; + default = 120; + description = lib.mdDoc '' + FastCGI timeout for database connection in seconds. + ''; + }; + + database = { + + createLocally = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Create the database and database user locally. Only available for + mysql database. + Note that this option will use the latest version of MariaDB which + is not officially supported by Nextcloud. As for now a workaround + is used to also support MariaDB version >= 10.6. + ''; + }; + + }; + + config = { + dbtype = mkOption { + type = types.enum [ + "sqlite" + "pgsql" + "mysql" + ]; + default = "sqlite"; + description = lib.mdDoc "Database type."; + }; + dbname = mkOption { + type = types.nullOr types.str; + default = "nextcloud"; + description = lib.mdDoc "Database name."; + }; + dbuser = mkOption { + type = types.nullOr types.str; + default = "nextcloud"; + description = lib.mdDoc "Database user."; + }; + dbpassFile = mkOption { + type = types.nullOr types.str; + default = null; + description = lib.mdDoc '' + The full path to a file that contains the database password. + ''; + }; + dbhost = mkOption { + type = types.nullOr types.str; + default = "localhost"; + description = lib.mdDoc '' + Database host. + + Note: for using Unix authentication with PostgreSQL, this should be + set to `/run/postgresql`. + ''; + }; + dbport = mkOption { + type = with types; nullOr (either int str); + default = null; + description = lib.mdDoc "Database port."; + }; + dbtableprefix = mkOption { + type = types.nullOr types.str; + default = null; + description = lib.mdDoc "Table prefix in Nextcloud database."; + }; + adminuser = mkOption { + type = types.str; + default = "root"; + description = lib.mdDoc "Admin username."; + }; + adminpassFile = mkOption { + type = types.str; + description = lib.mdDoc '' + The full path to a file that contains the admin's password. Must be + readable by user `nextcloud`. + ''; + }; + + extraTrustedDomains = mkOption { + type = types.listOf types.str; + default = [ ]; + description = lib.mdDoc '' + Trusted domains, from which the nextcloud installation will be + accessible. You don't need to add + `services.nextcloud.hostname` here. + ''; + }; + + trustedProxies = mkOption { + type = types.listOf types.str; + default = [ ]; + description = lib.mdDoc '' + Trusted proxies, to provide if the nextcloud installation is being + proxied to secure against e.g. spoofing. + ''; + }; + + overwriteProtocol = mkOption { + type = types.nullOr (types.enum [ + "http" + "https" + ]); + default = null; + example = "https"; + + description = lib.mdDoc '' + Force Nextcloud to always use HTTPS i.e. for link generation. Nextcloud + uses the currently used protocol by default, but when behind a reverse-proxy, + it may use `http` for everything although Nextcloud + may be served via HTTPS. + ''; + }; + + defaultPhoneRegion = mkOption { + default = null; + type = types.nullOr types.str; + example = "DE"; + description = lib.mdDoc '' + ::: {.warning} + This option exists since Nextcloud 21! If older versions are used, + this will throw an eval-error! + ::: + + [ISO 3611-1](https://www.iso.org/iso-3166-country-codes.html) + country codes for automatic phone-number detection without a country code. + + With e.g. `DE` set, the `+49` can be omitted for + phone-numbers. + ''; + }; + + objectstore = { + s3 = { + enable = mkEnableOption (lib.mdDoc '' + S3 object storage as primary storage. + + This mounts a bucket on an Amazon S3 object storage or compatible + implementation into the virtual filesystem. + + Further details about this feature can be found in the + [upstream documentation](https://docs.nextcloud.com/server/22/admin_manual/configuration_files/primary_storage.html). + ''); + bucket = mkOption { + type = types.str; + example = "nextcloud"; + description = lib.mdDoc '' + The name of the S3 bucket. + ''; + }; + autocreate = mkOption { + type = types.bool; + description = lib.mdDoc '' + Create the objectstore if it does not exist. + ''; + }; + key = mkOption { + type = types.str; + example = "EJ39ITYZEUH5BGWDRUFY"; + description = lib.mdDoc '' + The access key for the S3 bucket. + ''; + }; + secretFile = mkOption { + type = types.str; + example = "/var/nextcloud-objectstore-s3-secret"; + description = lib.mdDoc '' + The full path to a file that contains the access secret. Must be + readable by user `nextcloud`. + ''; + }; + hostname = mkOption { + type = types.nullOr types.str; + default = null; + example = "example.com"; + description = lib.mdDoc '' + Required for some non-Amazon implementations. + ''; + }; + port = mkOption { + type = types.nullOr types.port; + default = null; + description = lib.mdDoc '' + Required for some non-Amazon implementations. + ''; + }; + useSsl = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc '' + Use SSL for objectstore access. + ''; + }; + region = mkOption { + type = types.nullOr types.str; + default = null; + example = "REGION"; + description = lib.mdDoc '' + Required for some non-Amazon implementations. + ''; + }; + usePathStyle = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Required for some non-Amazon S3 implementations. + + Ordinarily, requests will be made with + `http://bucket.hostname.domain/`, but with path style + enabled requests are made with + `http://hostname.domain/bucket` instead. + ''; + }; + sseCKeyFile = mkOption { + type = types.nullOr types.path; + default = null; + example = "/var/nextcloud-objectstore-s3-sse-c-key"; + description = lib.mdDoc '' + If provided this is the full path to a file that contains the key + to enable [server-side encryption with customer-provided keys][1] + (SSE-C). + + The file must contain a random 32-byte key encoded as a base64 + string, e.g. generated with the command + + ``` + openssl rand 32 | base64 + ``` + + Must be readable by user `nextcloud`. + + [1]: https://docs.aws.amazon.com/AmazonS3/latest/userguide/ServerSideEncryptionCustomerKeys.html + ''; + }; + }; + }; + }; + + enableImagemagick = mkEnableOption (lib.mdDoc '' + the ImageMagick module for PHP. + This is used by the theming app and for generating previews of certain images (e.g. SVG and HEIF). + You may want to disable it for increased security. In that case, previews will still be available + for some images (e.g. JPEG and PNG). + See . + '') // { + default = true; + }; + + caching = { + apcu = mkOption { + type = types.bool; + default = true; + description = lib.mdDoc '' + Whether to load the APCu module into PHP. + ''; + }; + redis = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Whether to load the Redis module into PHP. + You still need to enable Redis in your config.php. + See https://docs.nextcloud.com/server/14/admin_manual/configuration_server/caching_configuration.html + ''; + }; + memcached = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Whether to load the Memcached module into PHP. + You still need to enable Memcached in your config.php. + See https://docs.nextcloud.com/server/14/admin_manual/configuration_server/caching_configuration.html + ''; + }; + }; + autoUpdateApps = { + enable = mkOption { + type = types.bool; + default = false; + description = lib.mdDoc '' + Run regular auto update of all apps installed from the nextcloud app store. + ''; + }; + startAt = mkOption { + type = with types; either str (listOf str); + default = "05:00:00"; + example = "Sun 14:00:00"; + description = lib.mdDoc '' + When to run the update. See `systemd.services..startAt`. + ''; + }; + }; + occ = mkOption { + type = types.package; + default = occ; + defaultText = literalMD "generated script"; + internal = true; + description = lib.mdDoc '' + The nextcloud-occ program preconfigured to target this Nextcloud instance. + ''; + }; + globalProfiles = mkEnableOption (lib.mdDoc "global profiles") // { + description = lib.mdDoc '' + Makes user-profiles globally available under `nextcloud.tld/u/user.name`. + Even though it's enabled by default in Nextcloud, it must be explicitly enabled + here because it has the side-effect that personal information is even accessible to + unauthenticated users by default. + + By default, the following properties are set to “Show to everyone” + if this flag is enabled: + - About + - Full name + - Headline + - Organisation + - Profile picture + - Role + - Twitter + - Website + + Only has an effect in Nextcloud 23 and later. + ''; + }; + + extraOptions = mkOption { + type = jsonFormat.type; + default = { }; + description = lib.mdDoc '' + Extra options which should be appended to nextcloud's config.php file. + ''; + example = literalExpression '' + { + redis = { + host = "/run/redis/redis.sock"; + port = 0; + dbindex = 0; + password = "secret"; + timeout = 1.5; + }; + } ''; + }; + + secretFile = mkOption { + type = types.nullOr types.str; + default = null; + description = lib.mdDoc '' + Secret options which will be appended to nextcloud's config.php file (written as JSON, in the same + form as the [](#opt-services.nextcloud.extraOptions) option), for example + `{"redis":{"password":"secret"}}`. + ''; + }; + + nginx = { + recommendedHttpHeaders = mkOption { + type = types.bool; + default = true; + description = + lib.mdDoc "Enable additional recommended HTTP response headers"; + }; + hstsMaxAge = mkOption { + type = types.ints.positive; + default = 15552000; + description = lib.mdDoc '' + Value for the `max-age` directive of the HTTP + `Strict-Transport-Security` header. + + See section 6.1.1 of IETF RFC 6797 for detailed information on this + directive and header. + ''; + }; + }; + }; + + config = mkIf cfg.enable (mkMerge [ + { + warnings = + let + latest = 26; + upgradeWarning = + major: nixos: '' + A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. + + After nextcloud${ + toString major + } is installed successfully, you can safely upgrade + to ${ + toString (major + 1) + }. The latest version available is nextcloud${toString latest}. + + Please note that Nextcloud doesn't support upgrades across multiple major versions + (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). + + The package can be upgraded by explicitly declaring the service-option + `services.nextcloud.package`. + '' + ; + + in + (optional (cfg.poolConfig != null) '' + Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. + Please migrate your configuration to config.services.nextcloud.poolSettings. + '') ++ (optional (versionOlder cfg.package.version "23") + (upgradeWarning 22 "22.05")) + ++ (optional (versionOlder cfg.package.version "24") + (upgradeWarning 23 "22.05")) + ++ (optional (versionOlder cfg.package.version "25") + (upgradeWarning 24 "22.11")) + ++ (optional (versionOlder cfg.package.version "26") + (upgradeWarning 25 "23.05")) + ++ (optional cfg.enableBrokenCiphersForSSE '' + You're using PHP's openssl extension built against OpenSSL 1.1 for Nextcloud. + This is only necessary if you're using Nextcloud's server-side encryption. + Please keep in mind that it's using the broken RC4 cipher. + + If you don't use that feature, you can switch to OpenSSL 3 and get + rid of this warning by declaring + + services.nextcloud.enableBrokenCiphersForSSE = false; + + If you need to use server-side encryption you can ignore this warning. + Otherwise you'd have to disable server-side encryption first in order + to be able to safely disable this option and get rid of this warning. + See on how to achieve this. + + For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 + '') + ; + + services.nextcloud.package = with pkgs; + mkDefault (if pkgs ? nextcloud then + throw '' + The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default + nextcloud defined in an overlay, please set `services.nextcloud.package` to + `pkgs.nextcloud`. + '' + else if versionOlder stateVersion "22.11" then + nextcloud24 + else if versionOlder stateVersion "23.05" then + nextcloud25 + else + nextcloud26); + + services.nextcloud.phpPackage = + if versionOlder cfg.package.version "26" then + pkgs.php81 + else + pkgs.php82 + ; + } + + { + assertions = [ { + assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; + message = + "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; + } ]; + } + + { + systemd.timers.nextcloud-cron = { + wantedBy = [ "timers.target" ]; + after = [ "nextcloud-setup.service" ]; + timerConfig.OnBootSec = "5m"; + timerConfig.OnUnitActiveSec = "5m"; + timerConfig.Unit = "nextcloud-cron.service"; + }; + + systemd.tmpfiles.rules = [ "d ${cfg.home} 0750 nextcloud nextcloud" ]; + + systemd.services = { + # When upgrading the Nextcloud package, Nextcloud can report errors such as + # "The files of the app [all apps in /var/lib/nextcloud/apps] were not replaced correctly" + # Restarting phpfpm on Nextcloud package update fixes these issues (but this is a workaround). + phpfpm-nextcloud.restartTriggers = [ cfg.package ]; + + nextcloud-setup = + let + c = cfg.config; + writePhpArray = + a: + "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]" + ; + requiresReadSecretFunction = + c.dbpassFile != null || c.objectstore.s3.enable; + objectstoreConfig = + let + s3 = c.objectstore.s3; + in + optionalString s3.enable '' + 'objectstore' => [ + 'class' => '\\OC\\Files\\ObjectStore\\S3', + 'arguments' => [ + 'bucket' => '${s3.bucket}', + 'autocreate' => ${boolToString s3.autocreate}, + 'key' => '${s3.key}', + 'secret' => nix_read_secret('${s3.secretFile}'), + ${ + optionalString (s3.hostname != null) + "'hostname' => '${s3.hostname}'," + } + ${ + optionalString (s3.port != null) + "'port' => ${toString s3.port}," + } + 'use_ssl' => ${boolToString s3.useSsl}, + ${ + optionalString (s3.region != null) + "'region' => '${s3.region}'," + } + 'use_path_style' => ${boolToString s3.usePathStyle}, + ${ + optionalString (s3.sseCKeyFile != null) + "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," + } + ], + ] + '' + ; + + showAppStoreSetting = + cfg.appstoreEnable != null || cfg.extraApps != { }; + renderedAppStoreSetting = + let + x = cfg.appstoreEnable; + in if x == null then + "false" + else + boolToString x + ; + + nextcloudGreaterOrEqualThan = + req: + versionAtLeast cfg.package.version req + ; + + overrideConfig = pkgs.writeText "nextcloud-config.php" '' + [ + ${ + optionalString (cfg.extraApps != { }) + "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," + } + [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], + [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], + ], + ${ + optionalString (showAppStoreSetting) + "'appstoreenabled' => ${renderedAppStoreSetting}," + } + 'datadirectory' => '${datadir}/data', + 'skeletondirectory' => '${cfg.skeletonDirectory}', + ${ + optionalString cfg.caching.apcu + "'memcache.local' => '\\OC\\Memcache\\APCu'," + } + 'log_type' => '${cfg.logType}', + 'loglevel' => '${builtins.toString cfg.logLevel}', + ${ + optionalString (c.overwriteProtocol != null) + "'overwriteprotocol' => '${c.overwriteProtocol}'," + } + ${ + optionalString (c.dbname != null) "'dbname' => '${c.dbname}'," + } + ${ + optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}'," + } + ${ + optionalString (c.dbport != null) + "'dbport' => '${toString c.dbport}'," + } + ${ + optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}'," + } + ${ + optionalString (c.dbtableprefix != null) + "'dbtableprefix' => '${toString c.dbtableprefix}'," + } + ${ + optionalString (c.dbpassFile != null) '' + 'dbpassword' => nix_read_secret( + "${c.dbpassFile}" + ), + '' + } + 'dbtype' => '${c.dbtype}', + 'trusted_domains' => ${ + writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) + }, + 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, + ${ + optionalString (c.defaultPhoneRegion != null) + "'default_phone_region' => '${c.defaultPhoneRegion}'," + } + ${ + optionalString (nextcloudGreaterOrEqualThan "23") + "'profile.enabled' => ${boolToString cfg.globalProfiles}," + } + ${objectstoreConfig} + ]; + + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( + "${ + jsonFormat.generate "nextcloud-extraOptions.json" + cfg.extraOptions + }", + "impossible: this should never happen (decoding generated extraOptions file %s failed)" + )); + + ${optionalString (cfg.secretFile != null) '' + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( + "${cfg.secretFile}", + "Cannot start Nextcloud, secrets file %s set by NixOS doesn't exist!" + )); + ''} + ''; + occInstallCmd = + let + mkExport = + { + arg, + value, + }: + "export ${arg}=${value}" + ; + dbpass = { + arg = "DBPASS"; + value = + if c.dbpassFile != null then + ''"$(<"${toString c.dbpassFile}")"'' + else + ''""'' + ; + }; + adminpass = { + arg = "ADMINPASS"; + value = ''"$(<"${toString c.adminpassFile}")"''; + }; + installFlags = concatStringsSep " \\\n " + (mapAttrsToList (k: v: "${k} ${toString v}") { + "--database" = ''"${c.dbtype}"''; + # The following attributes are optional depending on the type of + # database. Those that evaluate to null on the left hand side + # will be omitted. + ${ + if c.dbname != null then + "--database-name" + else + null + } = ''"${c.dbname}"''; + ${ + if c.dbhost != null then + "--database-host" + else + null + } = ''"${c.dbhost}"''; + ${ + if c.dbport != null then + "--database-port" + else + null + } = ''"${toString c.dbport}"''; + ${ + if c.dbuser != null then + "--database-user" + else + null + } = ''"${c.dbuser}"''; + "--database-pass" = ''"''$${dbpass.arg}"''; + "--admin-user" = ''"${c.adminuser}"''; + "--admin-pass" = ''"''$${adminpass.arg}"''; + "--data-dir" = ''"${datadir}/data"''; + }); + in '' + ${mkExport dbpass} + ${mkExport adminpass} + ${occ}/bin/nextcloud-occ maintenance:install \ + ${installFlags} + '' + ; + occSetTrustedDomainsCmd = concatStringsSep "\n" (imap0 (i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains)); + + in { + wantedBy = [ "multi-user.target" ]; + before = [ "phpfpm-nextcloud.service" ]; + path = [ occ ]; + script = '' + ${optionalString (c.dbpassFile != null) '' + if [ ! -r "${c.dbpassFile}" ]; then + echo "dbpassFile ${c.dbpassFile} is not readable by nextcloud:nextcloud! Aborting..." + exit 1 + fi + if [ -z "$(<${c.dbpassFile})" ]; then + echo "dbpassFile ${c.dbpassFile} is empty!" + exit 1 + fi + ''} + if [ ! -r "${c.adminpassFile}" ]; then + echo "adminpassFile ${c.adminpassFile} is not readable by nextcloud:nextcloud! Aborting..." + exit 1 + fi + if [ -z "$(<${c.adminpassFile})" ]; then + echo "adminpassFile ${c.adminpassFile} is empty!" + exit 1 + fi + + ln -sf ${cfg.package}/apps ${cfg.home}/ + + # Install extra apps + ln -sfT \ + ${ + pkgs.linkFarm "nix-apps" + (mapAttrsToList (name: path: { inherit name path; }) + cfg.extraApps) + } \ + ${cfg.home}/nix-apps + + # create nextcloud directories. + # if the directories exist already with wrong permissions, we fix that + for dir in ${datadir}/config ${datadir}/data ${cfg.home}/store-apps ${cfg.home}/nix-apps; do + if [ ! -e $dir ]; then + install -o nextcloud -g nextcloud -d $dir + elif [ $(stat -c "%G" $dir) != "nextcloud" ]; then + chgrp -R nextcloud $dir + fi + done + + ln -sf ${overrideConfig} ${datadir}/config/override.config.php + + # Do not install if already installed + if [[ ! -e ${datadir}/config/config.php ]]; then + ${occInstallCmd} + fi + + ${occ}/bin/nextcloud-occ upgrade + + ${occ}/bin/nextcloud-occ config:system:delete trusted_domains + + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' + # Try to enable apps + ${occ}/bin/nextcloud-occ app:enable ${ + concatStringsSep " " (attrNames cfg.extraApps) + } + ''} + + ${occSetTrustedDomainsCmd} + ''; + serviceConfig.Type = "oneshot"; + serviceConfig.User = "nextcloud"; + # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent + # an automatic creation of the database user. + environment.NC_setup_create_db_user = + lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; + } + ; + nextcloud-cron = { + after = [ "nextcloud-setup.service" ]; + environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + serviceConfig.Type = "oneshot"; + serviceConfig.User = "nextcloud"; + serviceConfig.ExecStart = + "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; + }; + nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { + after = [ "nextcloud-setup.service" ]; + serviceConfig.Type = "oneshot"; + serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; + serviceConfig.User = "nextcloud"; + startAt = cfg.autoUpdateApps.startAt; + }; + }; + + services.phpfpm = { + pools.nextcloud = { + user = "nextcloud"; + group = "nextcloud"; + phpPackage = phpPackage; + phpEnv = { + NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + PATH = + "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; + }; + settings = mapAttrs (name: mkDefault) { + "listen.owner" = config.services.nginx.user; + "listen.group" = config.services.nginx.group; + } // cfg.poolSettings; + extraConfig = cfg.poolConfig; + }; + }; + + users.users.nextcloud = { + home = "${cfg.home}"; + group = "nextcloud"; + isSystemUser = true; + }; + users.groups.nextcloud.members = [ + "nextcloud" + config.services.nginx.user + ]; + + environment.systemPackages = [ occ ]; + + services.mysql = lib.mkIf cfg.database.createLocally { + enable = true; + package = lib.mkDefault pkgs.mariadb; + ensureDatabases = [ cfg.config.dbname ]; + ensureUsers = [ { + name = cfg.config.dbuser; + ensurePermissions = { "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; }; + } ]; + initialScript = pkgs.writeText "mysql-init" '' + CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${ + builtins.readFile (cfg.config.dbpassFile) + }'; + CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; + GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, + CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' + IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; + FLUSH privileges; + ''; + }; + + services.nginx.enable = mkDefault true; + + services.nginx.virtualHosts.${cfg.hostName} = { + root = cfg.package; + locations = { + "= /robots.txt" = { + priority = 100; + extraConfig = '' + allow all; + access_log off; + ''; + }; + "= /" = { + priority = 100; + extraConfig = '' + if ( $http_user_agent ~ ^DavClnt ) { + return 302 /remote.php/webdav/$is_args$args; + } + ''; + }; + "/" = { + priority = 900; + extraConfig = "rewrite ^ /index.php;"; + }; + "~ ^/store-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "~ ^/nix-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "^~ /.well-known" = { + priority = 210; + extraConfig = '' + absolute_redirect off; + location = /.well-known/carddav { + return 301 /remote.php/dav; + } + location = /.well-known/caldav { + return 301 /remote.php/dav; + } + location ~ ^/\.well-known/(?!acme-challenge|pki-validation) { + return 301 /index.php$request_uri; + } + try_files $uri $uri/ =404; + ''; + }; + "~ ^/(?:build|tests|config|lib|3rdparty|templates|data)(?:$|/)".extraConfig = '' + return 404; + ''; + "~ ^/(?:\\.(?!well-known)|autotest|occ|issue|indie|db_|console)".extraConfig = '' + return 404; + ''; + "~ ^\\/(?:index|remote|public|cron|core\\/ajax\\/update|status|ocs\\/v[12]|updater\\/.+|oc[ms]-provider\\/.+|.+\\/richdocumentscode\\/proxy)\\.php(?:$|\\/)" = { + priority = 500; + extraConfig = '' + include ${config.services.nginx.package}/conf/fastcgi.conf; + fastcgi_split_path_info ^(.+?\.php)(\\/.*)$; + set $path_info $fastcgi_path_info; + try_files $fastcgi_script_name =404; + fastcgi_param PATH_INFO $path_info; + fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; + fastcgi_param HTTPS ${ + if cfg.https then + "on" + else + "off" + }; + fastcgi_param modHeadersAvailable true; + fastcgi_param front_controller_active true; + fastcgi_pass unix:${fpm.socket}; + fastcgi_intercept_errors on; + fastcgi_request_buffering off; + fastcgi_read_timeout ${builtins.toString cfg.fastcgiTimeout}s; + ''; + }; + "~ \\.(?:css|js|woff2?|svg|gif|map)$".extraConfig = '' + try_files $uri /index.php$request_uri; + expires 6M; + access_log off; + ''; + "~ ^\\/(?:updater|ocs-provider|ocm-provider)(?:$|\\/)".extraConfig = '' + try_files $uri/ =404; + index index.php; + ''; + "~ \\.(?:png|html|ttf|ico|jpg|jpeg|bcmap|mp4|webm)$".extraConfig = '' + try_files $uri /index.php$request_uri; + access_log off; + ''; + }; + extraConfig = '' + index index.php index.html /index.php$request_uri; + ${optionalString (cfg.nginx.recommendedHttpHeaders) '' + add_header X-Content-Type-Options nosniff; + add_header X-XSS-Protection "1; mode=block"; + add_header X-Robots-Tag "noindex, nofollow"; + add_header X-Download-Options noopen; + add_header X-Permitted-Cross-Domain-Policies none; + add_header X-Frame-Options sameorigin; + add_header Referrer-Policy no-referrer; + ''} + ${optionalString (cfg.https) '' + add_header Strict-Transport-Security "max-age=${ + toString cfg.nginx.hstsMaxAge + }; includeSubDomains" always; + ''} + client_max_body_size ${cfg.maxUploadSize}; + fastcgi_buffers 64 4K; + fastcgi_hide_header X-Powered-By; + gzip on; + gzip_vary on; + gzip_comp_level 4; + gzip_min_length 256; + gzip_proxied expired no-cache no-store private no_last_modified no_etag auth; + gzip_types application/atom+xml application/javascript application/json application/ld+json application/manifest+json application/rss+xml application/vnd.geo+json application/vnd.ms-fontobject application/x-font-ttf application/x-web-app-manifest+json application/xhtml+xml application/xml font/opentype image/bmp image/svg+xml image/x-icon text/cache-manifest text/css text/plain text/vcard text/vnd.rim.location.xloc text/vtt text/x-component text/x-cross-domain-policy; + + ${optionalString cfg.webfinger '' + rewrite ^/.well-known/host-meta /public.php?service=host-meta last; + rewrite ^/.well-known/host-meta.json /public.php?service=host-meta-json last; + ''} + ''; + }; + } + ]); + + meta.doc = ./nextcloud.md; +} From e6bed2a55312bb242e5853bb75a248598cbc18f0 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 17 May 2023 09:55:21 +0200 Subject: [PATCH 023/125] Don't absort `in` body anymore --- src/Nixfmt/Pretty.hs | 12 +----------- test/diff/idioms_lib_2/out.nix | 6 ++++-- test/diff/idioms_lib_3/out.nix | 30 ++++++++++++++++++++---------- test/diff/idioms_nixos_1/out.nix | 3 ++- test/diff/idioms_nixos_2/out.nix | 12 ++++++++---- test/diff/let_in/out.nix | 3 ++- test/diff/monsters_5/out.nix | 3 ++- 7 files changed, 39 insertions(+), 30 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 9b4c8e65..48d97a0f 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -208,16 +208,6 @@ absorb left right (Just level) x absorbSet :: Expression -> Doc absorbSet = absorb line mempty Nothing --- What is allowed to come on the same line as `in`? --- Absorbable terms like sets --- if, with, let -absorbIn :: Expression -> Doc -absorbIn (Term t) | isAbsorbable t = hardspace <> prettyTerm t <> hardspace -absorbIn x@(If _ _ _ _ _ _) = group x -absorbIn x@(With _ _ _ _) = group x -absorbIn x@(Let _ _ _ _) = group x -absorbIn x = line <> group x <> line - -- Only absorb "else if" absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) @@ -245,7 +235,7 @@ instance Pretty Expression where (Ann in_ inTrailing inLeading) expr) = base $ group letPart <> line <> inPart where letPart = pretty let_ <> pretty letTrailing <> hardline <> letBody - inPart = pretty in_ <> hardspace <> absorbIn expr + inPart = pretty in_ <> line <> group expr <> line letBody = nest 2 $ pretty letLeading <> sepBy hardline binders diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 7b42e87a..d891e38c 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -226,7 +226,8 @@ rec { versionSuffix = let suffixFile = ../.version-suffix; - in if pathExists suffixFile then + in + if pathExists suffixFile then lib.strings.fileContents suffixFile else "pre-git" @@ -243,7 +244,8 @@ rec { let revisionFile = "${toString ./..}/.git-revision"; gitRepo = "${toString ./..}/.git"; - in if lib.pathIsGitRepo gitRepo then + in + if lib.pathIsGitRepo gitRepo then lib.commitIdFromGitRepo gitRepo else if lib.pathExists revisionFile then lib.fileContents revisionFile diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index e7844203..1467102a 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -22,7 +22,8 @@ let inherit (lib) isFunction; -in rec { +in +rec { ## -- HELPER FUNCTIONS & DEFAULTS -- @@ -39,7 +40,8 @@ in rec { abort ("generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}") ; - in if isInt v then + in + if isInt v then toString v # convert derivations to store paths else if lib.isDerivation v then @@ -252,7 +254,8 @@ in rec { section = head sections; subsections = tail sections; subsection = concatStringsSep "." subsections; - in if containsQuote || subsections == [ ] then + in + if containsQuote || subsections == [ ] then name else ''${section} "${subsection}"'' @@ -346,12 +349,14 @@ in rec { depth: v: let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); - in if isAttrs v then + in + if isAttrs v then mapAttrs (stepIntoAttr evalNext) v else if isList v then map evalNext v else - transform (depth + 1) v; + transform (depth + 1) v + ; in mapAny 0 ; @@ -395,7 +400,8 @@ in rec { else " " ; - in if isInt v then + in + if isInt v then toString v # toString loses precision on floats, so we use toJSON instead. This isn't perfect # as the resulting string may not parse back as a float (e.g. 42, 1e-06), but for @@ -433,7 +439,8 @@ in rec { else introSpace + lastLine) + "''" ; - in if multiline && length lines > 1 then + in + if multiline && length lines > 1 then multilineResult else singlelineResult @@ -461,7 +468,8 @@ in rec { name + "?" else name) fna); - in if fna == { } then + in + if fna == { } then "" else "" @@ -566,7 +574,8 @@ in rec { ]) x)) ; - in '' + in + '' @@ -583,7 +592,8 @@ in rec { with builtins; let concatItems = lib.strings.concatStringsSep ", "; - in if isAttrs v then + in + if isAttrs v then "{ ${ concatItems (lib.attrsets.mapAttrsToList (key: value: "${key} = ${toDhall args value}") v) diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index f64b3013..04d4920c 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -17,7 +17,8 @@ let ${concatStringsSep "\n" config.boot.kernelModules} ''; -in { +in +{ ###### interface diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index ddedc74b..af05e497 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -66,7 +66,8 @@ let inherit (config.system) stateVersion; -in { +in +{ imports = [ (mkRemovedOptionModule [ @@ -878,7 +879,8 @@ in { renderedAppStoreSetting = let x = cfg.appstoreEnable; - in if x == null then + in + if x == null then "false" else boolToString x @@ -1052,7 +1054,8 @@ in { "--admin-pass" = ''"''$${adminpass.arg}"''; "--data-dir" = ''"${datadir}/data"''; }); - in '' + in + '' ${mkExport dbpass} ${mkExport adminpass} ${occ}/bin/nextcloud-occ maintenance:install \ @@ -1064,7 +1067,8 @@ in { ${toString i} --value="${toString v}" '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains)); - in { + in + { wantedBy = [ "multi-user.target" ]; before = [ "phpfpm-nextcloud.service" ]; path = [ occ ]; diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index c5f94f3b..638a97f2 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -64,7 +64,8 @@ let a = let - in [ + in + [ 1 2 ] diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 10b8a24b..24378b34 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -51,7 +51,8 @@ let ${concatStringsSep "\n" config.boot.kernelModules} ''; -in { +in +{ ###### interface From a226b6dccb0d16b88ee5b0b8810b1ff3e643895c Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 18 May 2023 20:06:17 +0200 Subject: [PATCH 024/125] Improve group handling for bindings and inherit There is now the choice whether to pull whitespace just before/at the start of a group in or out. This allows to fix an outstanding issue with inherit statements, and is also used in the bindings format --- src/Nixfmt/Predoc.hs | 46 +++- src/Nixfmt/Pretty.hs | 34 +-- test/diff/attr_set/in.nix | 37 +++ test/diff/attr_set/out.nix | 42 ++++ test/diff/idioms_lib_2/out.nix | 41 ++-- test/diff/idioms_lib_3/out.nix | 6 +- test/diff/idioms_nixos_1/out.nix | 10 +- test/diff/idioms_nixos_2/out.nix | 8 +- test/diff/idioms_pkgs_3/out.nix | 364 ++++++++++++++++-------------- test/diff/inherit_comment/out.nix | 5 +- test/diff/inherit_from/out.nix | 145 +++++++----- test/diff/monsters_5/out.nix | 3 +- 12 files changed, 455 insertions(+), 286 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 05d0f5ad..3d572f14 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -15,6 +15,7 @@ module Nixfmt.Predoc , hcat , base , group + , group' , nest , softline' , line' @@ -60,8 +61,14 @@ data Spacing data DocAnn -- | Node Group docs indicates either all or none of the Spaces and Breaks - -- in docs should be converted to line breaks. - = Group + -- in docs should be converted to line breaks. This does not affect softlines, + -- those will be expanded only as necessary and with a lower priority. + -- + -- The boolean argument determines how to handle whitespace directly before the + -- group or at the start of the group. By default (False), it gets pulled out + -- in front of the group, which is what you want in most cases. If set to True, + -- whitespace before the group will be pulled in instead. + = Group Bool -- | Node (Nest n) doc indicates all line starts in doc should be indented -- by n more spaces than the surrounding Base. | Nest Int @@ -100,8 +107,15 @@ text :: Text -> Doc text "" = [] text t = [Text t] +-- | Group document elements together (see Node Group documentation) +-- Any whitespace at the start of the group will get pulled out in front of it. group :: Pretty a => a -> Doc -group = pure . Node Group . pretty +group = pure . Node (Group False) . pretty + +-- | Group document elements together (see Node Group documentation) +-- Any whitespace directly before the group will be pulled into it. +group' :: Pretty a => a -> Doc +group' = pure . Node (Group True) . pretty -- | @nest n doc@ sets the indentation for lines in @doc@ to @n@ more than the -- indentation of the part before it. This is based on the actual indentation of @@ -200,8 +214,12 @@ mergeLines (x : xs) = x : mergeLines xs moveLinesIn :: Doc -> Doc moveLinesIn [] = [] +-- Move space before Nest in moveLinesIn (Spacing l : Node (Nest level) xs : ys) = - Node (Nest level) (Spacing l : moveLinesIn xs) : moveLinesIn ys + Node (Nest level) (moveLinesIn (Spacing l : xs)) : moveLinesIn ys +-- Move space before (Group True) in +moveLinesIn (Spacing l : Node (Group True) xs : ys) = + Node (Group False) (moveLinesIn (Spacing l : xs)) : moveLinesIn ys moveLinesIn (Node ann xs : ys) = Node ann (moveLinesIn xs) : moveLinesIn ys @@ -255,16 +273,17 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs go c (Text t : xs) = go (c - textWidth t) xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth - go c (Node Group ys : xs) = + go c (Node (Group _) ys : xs) = case fits (c - firstLineWidth xs) ys of Nothing -> go c (ys ++ xs) Just t -> go (c - textWidth t) xs go c (Node _ ys : xs) = go c (ys ++ xs) --- | +-- | A document element with target indentation data Chunk = Chunk Int DocE +-- | Create `n` newlines and `i` spaces indent :: Int -> Int -> Text indent n i = Text.replicate n "\n" <> Text.replicate i " " @@ -275,12 +294,17 @@ unChunk (Chunk _ doc) = doc -- cc Current Column -- ci Current Indentation -- ti Target Indentation +-- an indent only changes the target indentation at first. +-- Only for the tokens starting on the next line the current +-- indentation will match the target indentation. layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node Group doc] - where go _ _ [] = [] +layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] + where go :: Int -> Int -> [Chunk] -> [Text] + go _ _ [] = [] go cc ci (Chunk ti x : xs) = case x of Text t -> t : go (cc + textWidth t) ci xs + -- This code treats whitespace as "expanded" Spacing Break -> indent 1 ti : go ti ti xs Spacing Space -> indent 1 ti : go ti ti xs Spacing Hardspace -> " " : go (cc + 1) ci xs @@ -300,7 +324,11 @@ layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node Group doc] Node (Nest l) ys -> go cc ci $ map (Chunk (ti + l)) ys ++ xs Node Base ys -> go cc ci $ map (Chunk ci) ys ++ xs - Node Group ys -> + Node (Group _) ys -> + -- Does the group (plus whatever comes after it on that line) fit in one line? + -- This is where treating whitespace as "compact" happens case fits (tw - cc - firstLineWidth (map unChunk xs)) ys of + -- Dissolve the group by mapping its members to the target indentation + -- This also implies that whitespace in there will now be rendered "expanded" Nothing -> go cc ci $ map (Chunk ti) ys ++ xs Just t -> t : go (cc + textWidth t) ci xs diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 48d97a0f..af2dfcb6 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -17,7 +17,7 @@ import qualified Data.Text as Text (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile) import Nixfmt.Predoc - (Doc, Pretty, base, emptyline, group, hardline, hardspace, hcat, line, line', + (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', nest, newline, pretty, sepBy, softline, softline', text, textWidth) import Nixfmt.Types (Ann(..), Binder(..), Expression(..), File(..), Leaf, ParamAttr(..), @@ -78,8 +78,11 @@ instance Pretty Binder where -- `inherit (foo) bar` statement pretty (Inherit inherit source ids semicolon) - = base $ group (pretty inherit <> hardspace - <> nest 2 ((pretty source) <> line <> sepBy line ids <> line' <> pretty semicolon)) + = base $ group (pretty inherit <> hardspace <> nest 2 ( + (group' (line <> pretty source)) <> line + <> sepBy line ids + <> line' <> pretty semicolon + )) -- `foo = bar` pretty (Assignment selectors assign expr semicolon) @@ -88,17 +91,22 @@ instance Pretty Binder where where inner = case expr of - -- Function declaration / If statement / Let binding - -- If it is multi-line, force it into a new line with indentation, semicolon on separate line - (Abstraction _ _ _) -> line <> pretty expr <> line' <> pretty semicolon - (If _ _ _ _ _ _) -> line <> pretty expr <> line' <> pretty semicolon - (Let _ _ _ _) -> line <> pretty expr <> line' <> pretty semicolon - -- Term - -- Absorb and keep the semicolon attached if possible - (Term t) -> (if isAbsorbable t then hardspace else softline) <> group expr <> pretty semicolon - -- Everything else + -- Absorbable term. Always start on the same line, keep semicolon attatched + (Term t) | isAbsorbable t -> hardspace <> group expr <> pretty semicolon + -- Non-absorbable term + -- If it is multi-line, force it to start on a new line with indentation + (Term _) -> group' (line <> pretty expr) <> pretty semicolon + -- Function calls and with expressions -- Try to absorb and keep the semicolon attached, spread otherwise - _ -> softline <> group (pretty expr <> softline' <> pretty semicolon) + (Application _ _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) + (With _ _ _ _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) + -- Special case `//` operator to treat like an absorbable term + (Operation _ (Ann TUpdate _ _) _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) + -- 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) + -- Otherwise, start on new line, expand fully (including the semicolon) + _ -> group (line <> pretty expr <> line' <> pretty semicolon) -- | Pretty print a term without wrapping it in a group. diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index 2af0248d..59590f74 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -57,4 +57,41 @@ } + { + x = + { + foo = 1; + bar = 2; + # multiline + } + .${x} + ; + y = # more multiline + { + foo = 1; + bar = 2; + # multiline + } + .${x} + ; + z = functionCall { + # multi + #line + } [ + # several + items + ]; + a = [ + some flags # multiline + ] ++ [ short ] ++ [ + more stuff # multiline + ] ++ (if foo then [ bar ] else [baz ]) ++ [] ++ + (optionals condition [more items]); + b = with pkgs; [ + a + lot + of + packages + ]; + } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 8cb17e75..442dc489 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -78,4 +78,46 @@ # f } + { + x = + { + foo = 1; + bar = 2; + # multiline + }.${x}; + y = # more multiline + { + foo = 1; + bar = 2; + # multiline + }.${x}; + z = functionCall { + # multi + #line + } [ + # several + items + ]; + a = + [ + some + flags # multiline + ] ++ [ short ] ++ [ + more + stuff # multiline + ] ++ (if foo then + [ bar ] + else + [ baz ]) ++ [ ] ++ (optionals condition [ + more + items + ]) + ; + b = with pkgs; [ + a + lot + of + packages + ]; + } ] diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index d891e38c..a7c3fe7d 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -105,25 +105,28 @@ rec { ; # bitwise “and” - bitAnd = builtins.bitAnd or (import ./zip-int-bits.nix (a: b: - if a == 1 && b == 1 then - 1 - else - 0)); + bitAnd = + builtins.bitAnd or (import ./zip-int-bits.nix (a: b: + if a == 1 && b == 1 then + 1 + else + 0)); # bitwise “or” - bitOr = builtins.bitOr or (import ./zip-int-bits.nix (a: b: - if a == 1 || b == 1 then - 1 - else - 0)); + bitOr = + builtins.bitOr or (import ./zip-int-bits.nix (a: b: + if a == 1 || b == 1 then + 1 + else + 0)); # bitwise “xor” - bitXor = builtins.bitXor or (import ./zip-int-bits.nix (a: b: - if a != b then - 1 - else - 0)); + bitXor = + builtins.bitXor or (import ./zip-int-bits.nix (a: b: + if a != b then + 1 + else + 0)); # bitwise “not” bitNot = builtins.sub (-1); @@ -210,7 +213,9 @@ rec { ## nixpkgs version strings # Returns the current full nixpkgs version number. - version = release + versionSuffix; + version = + release + versionSuffix + ; # Returns the current nixpkgs release number as string. release = lib.strings.fileContents ../.version; @@ -261,7 +266,9 @@ rec { Type: inNixShell :: bool */ - inNixShell = builtins.getEnv "IN_NIX_SHELL" != ""; + inNixShell = + builtins.getEnv "IN_NIX_SHELL" != "" + ; ## Integer operations diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 1467102a..b94e71d6 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -423,8 +423,10 @@ rec { "''\${" "'''" ]; - singlelineResult = ''"'' - + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; + singlelineResult = + ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + + ''"'' + ; multilineResult = let escapedLines = map escapeMultiline lines; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 04d4920c..679948e4 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -277,15 +277,19 @@ in (mkIf (!config.boot.isContainer) { system.build = { inherit kernel; }; - system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; + system.modulesTree = + [ kernel ] ++ config.boot.extraModulePackages + ; # Implement consoleLogLevel both in early boot and using sysctl # (so you don't need to reboot to have changes take effect). - boot.kernelParams = [ "loglevel=${toString config.boot.consoleLogLevel}" ] + boot.kernelParams = + [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" - ]; + ] + ; boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index af05e497..6a6f78d4 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -834,9 +834,7 @@ in let c = cfg.config; writePhpArray = - a: - "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]" - ; + a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]"; requiresReadSecretFunction = c.dbpassFile != null || c.objectstore.s3.enable; objectstoreConfig = @@ -887,9 +885,7 @@ in ; nextcloudGreaterOrEqualThan = - req: - versionAtLeast cfg.package.version req - ; + req: versionAtLeast cfg.package.version req; overrideConfig = pkgs.writeText "nextcloud-config.php" '' =65 without having to track @@ -285,123 +291,128 @@ buildStdenv.mkDerivation ({ HOST_CC = "${llvmPackagesBuildBuild.stdenv.cc}/bin/cc"; HOST_CXX = "${llvmPackagesBuildBuild.stdenv.cc}/bin/c++"; - nativeBuildInputs = [ - autoconf - cargo - gnum4 - llvmPackagesBuildBuild.bintools - makeWrapper - nodejs - perl - pkg-config - python3 - rust-cbindgen - rustPlatform.bindgenHook - rustc - unzip - which - wrapGAppsHook - ] ++ lib.optionals crashreporterSupport [ - dump_syms - patchelf - ] ++ lib.optionals pgoSupport [ xvfb-run ] ++ extraNativeBuildInputs; + nativeBuildInputs = + [ + autoconf + cargo + gnum4 + llvmPackagesBuildBuild.bintools + makeWrapper + nodejs + perl + pkg-config + python3 + rust-cbindgen + rustPlatform.bindgenHook + rustc + unzip + which + wrapGAppsHook + ] ++ lib.optionals crashreporterSupport [ + dump_syms + patchelf + ] ++ lib.optionals pgoSupport [ xvfb-run ] ++ extraNativeBuildInputs + ; setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. - preConfigure = '' - # remove distributed configuration files - rm -f configure js/src/configure .mozconfig* - - # Runs autoconf through ./mach configure in configurePhase - configureScript="$(realpath ./mach) configure" - - # Set predictable directories for build and state - export MOZ_OBJDIR=$(pwd)/mozobj - export MOZBUILD_STATE_PATH=$(pwd)/mozbuild - - # Don't try to send libnotify notifications during build - export MOZ_NOSPAM=1 - - # Set consistent remoting name to ensure wmclass matches with desktop file - export MOZ_APP_REMOTINGNAME="${binaryName}" - - # AS=as in the environment causes build failure - # https://bugzilla.mozilla.org/show_bug.cgi?id=1497286 - unset AS - - # Use our own python - export MACH_BUILD_PYTHON_NATIVE_PACKAGE_SOURCE=system - - # RBox WASM Sandboxing - export WASM_CC=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}cc - export WASM_CXX=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}c++ - '' + lib.optionalString pgoSupport '' - if [ -e "$TMPDIR/merged.profdata" ]; then - echo "Configuring with profiling data" - for i in "''${!configureFlagsArray[@]}"; do - if [[ ''${configureFlagsArray[i]} = "--enable-profile-generate=cross" ]]; then - unset 'configureFlagsArray[i]' - fi - done - configureFlagsArray+=( - "--enable-profile-use=cross" - "--with-pgo-profile-path="$TMPDIR/merged.profdata"" - "--with-pgo-jarlog="$TMPDIR/jarlog"" - ) - else - echo "Configuring to generate profiling data" - configureFlagsArray+=( - "--enable-profile-generate=cross" - ) - fi - '' + lib.optionalString googleAPISupport '' - # Google API key used by Chromium and Firefox. - # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, - # please get your own set of keys at https://www.chromium.org/developers/how-tos/api-keys/. - echo "AIzaSyDGi15Zwl11UNe6Y-5XW_upsfyw31qwZPI" > $TMPDIR/google-api-key - # 60.5+ & 66+ did split the google API key arguments: https://bugzilla.mozilla.org/show_bug.cgi?id=1531176 - configureFlagsArray+=("--with-google-location-service-api-keyfile=$TMPDIR/google-api-key") - configureFlagsArray+=("--with-google-safebrowsing-api-keyfile=$TMPDIR/google-api-key") - '' + lib.optionalString mlsAPISupport '' - # Mozilla Location services API key - # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, - # please get your own set of keys at https://location.services.mozilla.com/api. - echo "dfd7836c-d458-4917-98bb-421c82d3c8a0" > $TMPDIR/mls-api-key - configureFlagsArray+=("--with-mozilla-api-keyfile=$TMPDIR/mls-api-key") - '' + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' - export MOZILLA_OFFICIAL=1 - ''; + preConfigure = + '' + # remove distributed configuration files + rm -f configure js/src/configure .mozconfig* + + # Runs autoconf through ./mach configure in configurePhase + configureScript="$(realpath ./mach) configure" + + # Set predictable directories for build and state + export MOZ_OBJDIR=$(pwd)/mozobj + export MOZBUILD_STATE_PATH=$(pwd)/mozbuild + + # Don't try to send libnotify notifications during build + export MOZ_NOSPAM=1 + + # Set consistent remoting name to ensure wmclass matches with desktop file + export MOZ_APP_REMOTINGNAME="${binaryName}" + + # AS=as in the environment causes build failure + # https://bugzilla.mozilla.org/show_bug.cgi?id=1497286 + unset AS + + # Use our own python + export MACH_BUILD_PYTHON_NATIVE_PACKAGE_SOURCE=system + + # RBox WASM Sandboxing + export WASM_CC=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}cc + export WASM_CXX=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}c++ + '' + lib.optionalString pgoSupport '' + if [ -e "$TMPDIR/merged.profdata" ]; then + echo "Configuring with profiling data" + for i in "''${!configureFlagsArray[@]}"; do + if [[ ''${configureFlagsArray[i]} = "--enable-profile-generate=cross" ]]; then + unset 'configureFlagsArray[i]' + fi + done + configureFlagsArray+=( + "--enable-profile-use=cross" + "--with-pgo-profile-path="$TMPDIR/merged.profdata"" + "--with-pgo-jarlog="$TMPDIR/jarlog"" + ) + else + echo "Configuring to generate profiling data" + configureFlagsArray+=( + "--enable-profile-generate=cross" + ) + fi + '' + lib.optionalString googleAPISupport '' + # Google API key used by Chromium and Firefox. + # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, + # please get your own set of keys at https://www.chromium.org/developers/how-tos/api-keys/. + echo "AIzaSyDGi15Zwl11UNe6Y-5XW_upsfyw31qwZPI" > $TMPDIR/google-api-key + # 60.5+ & 66+ did split the google API key arguments: https://bugzilla.mozilla.org/show_bug.cgi?id=1531176 + configureFlagsArray+=("--with-google-location-service-api-keyfile=$TMPDIR/google-api-key") + configureFlagsArray+=("--with-google-safebrowsing-api-keyfile=$TMPDIR/google-api-key") + '' + lib.optionalString mlsAPISupport '' + # Mozilla Location services API key + # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, + # please get your own set of keys at https://location.services.mozilla.com/api. + echo "dfd7836c-d458-4917-98bb-421c82d3c8a0" > $TMPDIR/mls-api-key + configureFlagsArray+=("--with-mozilla-api-keyfile=$TMPDIR/mls-api-key") + '' + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' + export MOZILLA_OFFICIAL=1 + '' + ; # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags configurePlatforms = [ ]; - configureFlags = [ - "--disable-tests" - "--disable-updater" - "--enable-application=${application}" - "--enable-default-toolkit=cairo-gtk3${ - lib.optionalString waylandSupport "-wayland" - }" - "--enable-system-pixman" - "--with-distribution-id=org.nixos" - "--with-libclang-path=${llvmPackagesBuildBuild.libclang.lib}/lib" - "--with-system-ffi" - "--with-system-icu" - "--with-system-jpeg" - "--with-system-libevent" - "--with-system-libvpx" - "--with-system-nspr" - "--with-system-nss" - "--with-system-png" # needs APNG support - "--with-system-webp" - "--with-system-zlib" - "--with-wasi-sysroot=${wasiSysRoot}" - # for firefox, host is buildPlatform, target is hostPlatform - "--host=${buildStdenv.buildPlatform.config}" - "--target=${buildStdenv.hostPlatform.config}" - ] - # LTO is done using clang and lld on Linux. + configureFlags = + [ + "--disable-tests" + "--disable-updater" + "--enable-application=${application}" + "--enable-default-toolkit=cairo-gtk3${ + lib.optionalString waylandSupport "-wayland" + }" + "--enable-system-pixman" + "--with-distribution-id=org.nixos" + "--with-libclang-path=${llvmPackagesBuildBuild.libclang.lib}/lib" + "--with-system-ffi" + "--with-system-icu" + "--with-system-jpeg" + "--with-system-libevent" + "--with-system-libvpx" + "--with-system-nspr" + "--with-system-nss" + "--with-system-png" # needs APNG support + "--with-system-webp" + "--with-system-zlib" + "--with-wasi-sysroot=${wasiSysRoot}" + # for firefox, host is buildPlatform, target is hostPlatform + "--host=${buildStdenv.buildPlatform.config}" + "--target=${buildStdenv.hostPlatform.config}" + ] + # LTO is done using clang and lld on Linux. ++ lib.optionals ltoSupport [ "--enable-lto=cross" # Cross-Language LTO "--enable-linker=lld" @@ -435,45 +446,47 @@ buildStdenv.mkDerivation ({ "--disable-install-strip" ] ++ lib.optional enableOfficialBranding "--enable-official-branding" ++ lib.optional (branding != null) "--with-branding=${branding}" - ++ extraConfigureFlags; - - buildInputs = [ - bzip2 - dbus - dbus-glib - file - fontconfig - freetype - glib - gtk3 - icu - libffi - libGL - libGLU - libevent - libjpeg - libpng - libstartup_notification - libvpx - libwebp - nasm - nspr - pango - perl - xorg.libX11 - xorg.libXcursor - xorg.libXdamage - xorg.libXext - xorg.libXft - xorg.libXi - xorg.libXrender - xorg.libXt - xorg.libXtst - xorg.pixman - xorg.xorgproto - zip - zlib - ] ++ [ + ++ extraConfigureFlags + ; + + buildInputs = + [ + bzip2 + dbus + dbus-glib + file + fontconfig + freetype + glib + gtk3 + icu + libffi + libGL + libGLU + libevent + libjpeg + libpng + libstartup_notification + libvpx + libwebp + nasm + nspr + pango + perl + xorg.libX11 + xorg.libXcursor + xorg.libXdamage + xorg.libXext + xorg.libXft + xorg.libXi + xorg.libXrender + xorg.libXt + xorg.libXtst + xorg.pixman + xorg.xorgproto + zip + zlib + ] ++ [ (if (lib.versionAtLeast version "103") then nss_latest else @@ -484,7 +497,8 @@ buildStdenv.mkDerivation ({ ++ lib.optionals waylandSupport [ libxkbcommon libdrm - ] ++ lib.optional jemallocSupport jemalloc ++ extraBuildInputs; + ] ++ lib.optional jemallocSupport jemalloc ++ extraBuildInputs + ; profilingPhase = lib.optionalString pgoSupport '' # Package up Firefox for profiling @@ -524,26 +538,30 @@ buildStdenv.mkDerivation ({ # Generate build symbols once after the final build # https://firefox-source-docs.mozilla.org/crash-reporting/uploading_symbol.html - preInstall = lib.optionalString crashreporterSupport '' - ./mach buildsymbols - mkdir -p $symbols/ - cp mozobj/dist/*.crashreporter-symbols.zip $symbols/ - '' + '' - cd mozobj - ''; + preInstall = + lib.optionalString crashreporterSupport '' + ./mach buildsymbols + mkdir -p $symbols/ + cp mozobj/dist/*.crashreporter-symbols.zip $symbols/ + '' + '' + cd mozobj + '' + ; - postInstall = '' - # Install distribution customizations - install -Dvm644 ${distributionIni} $out/lib/${binaryName}/distribution/distribution.ini - install -Dvm644 ${defaultPrefsFile} $out/lib/${binaryName}/browser/defaults/preferences/nixos-default-prefs.js + postInstall = + '' + # Install distribution customizations + install -Dvm644 ${distributionIni} $out/lib/${binaryName}/distribution/distribution.ini + install -Dvm644 ${defaultPrefsFile} $out/lib/${binaryName}/browser/defaults/preferences/nixos-default-prefs.js - '' + lib.optionalString buildStdenv.isLinux '' - # Remove SDK cruft. FIXME: move to a separate output? - rm -rf $out/share/idl $out/include $out/lib/${binaryName}-devel-* + '' + lib.optionalString buildStdenv.isLinux '' + # Remove SDK cruft. FIXME: move to a separate output? + rm -rf $out/share/idl $out/include $out/lib/${binaryName}-devel-* - # Needed to find Mozilla runtime - gappsWrapperArgs+=(--argv0 "$out/bin/.${binaryName}-wrapped") - ''; + # Needed to find Mozilla runtime + gappsWrapperArgs+=(--argv0 "$out/bin/.${binaryName}-wrapped") + '' + ; postFixup = lib.optionalString crashreporterSupport '' patchelf --add-rpath "${ diff --git a/test/diff/inherit_comment/out.nix b/test/diff/inherit_comment/out.nix index a8d2746e..403a2353 100644 --- a/test/diff/inherit_comment/out.nix +++ b/test/diff/inherit_comment/out.nix @@ -6,8 +6,9 @@ ; # https://github.com/kamadorueda/alejandra/issues/372 - inherit (pkgs.haskell.lib) - # doJailbreak - remove package bounds from build-depends of a package + inherit + (pkgs.haskell.lib) + # doJailbreak - remove package bounds from build-depends of a package doJailbreak # dontCheck - skip tests dontCheck diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index bb746aad..62f80068 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -15,10 +15,11 @@ ; } { - inherit ({ - foo = "1"; - bar = "2"; # force multiline - }) + inherit + ({ + foo = "1"; + bar = "2"; # force multiline + }) foo bar ; @@ -67,177 +68,201 @@ ; } { - inherit (c # d - ) + inherit + (c # d + ) f h ; } { - inherit (c # d - ) + inherit + (c # d + ) f h # i ; } { - inherit (c # d - ) + inherit + (c # d + ) f # g h ; } { - inherit (c # d - ) + inherit + (c # d + ) f # g h # i ; } { - inherit (c # d - ) # e + inherit + (c # d + ) # e f h ; } { - inherit (c # d - ) # e + inherit + (c # d + ) # e f h # i ; } { - inherit (c # d - ) # e + inherit + (c # d + ) # e f # g h ; } { - inherit (c # d - ) # e + inherit + (c # d + ) # e f # g h # i ; } { - inherit ( # b - c) + inherit + ( # b + c) f h ; } { - inherit ( # b - c) + inherit + ( # b + c) f h # i ; } { - inherit ( # b - c) + inherit + ( # b + c) f # g h ; } { - inherit ( # b - c) + inherit + ( # b + c) f # g h # i ; } { - inherit ( # b - c) # e + inherit + ( # b + c) # e f h ; } { - inherit ( # b - c) # e + inherit + ( # b + c) # e f h # i ; } { - inherit ( # b - c) # e + inherit + ( # b + c) # e f # g h ; } { - inherit ( # b - c) # e + inherit + ( # b + c) # e f # g h # i ; } { - inherit ( # b - c # d - ) + inherit + ( # b + c # d + ) f h ; } { - inherit ( # b - c # d - ) + inherit + ( # b + c # d + ) f h # i ; } { - inherit ( # b - c # d - ) + inherit + ( # b + c # d + ) f # g h ; } { - inherit ( # b - c # d - ) + inherit + ( # b + c # d + ) f # g h # i ; } { - inherit ( # b - c # d - ) # e + inherit + ( # b + c # d + ) # e f h ; } { - inherit ( # b - c # d - ) # e + inherit + ( # b + c # d + ) # e f h # i ; } { - inherit ( # b - c # d - ) # e + inherit + ( # b + c # d + ) # e f # g h ; } { - inherit ( # b - c # d - ) # e + inherit + ( # b + c # d + ) # e f # g h # i ; diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 24378b34..24bf71a9 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -177,7 +177,8 @@ in ++ - kernelPatches; + kernelPatches + ; features From 0528d788bc515c041ef1ab94104ae12d2b57f5c1 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 18 May 2023 21:05:56 +0200 Subject: [PATCH 025/125] Special case selection operator --- src/Nixfmt/Pretty.hs | 8 +++++++- test/diff/attr_set/out.nix | 6 ++++-- test/diff/idioms_lib_2/out.nix | 3 ++- test/diff/select/in.nix | 4 ++++ test/diff/select/out.nix | 5 +++++ 5 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index af2dfcb6..19abe77b 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -114,7 +114,13 @@ prettyTerm :: Term -> Doc prettyTerm (Token t) = pretty t prettyTerm (String s) = pretty s prettyTerm (Path p) = pretty p -prettyTerm (Selection term selectors) = pretty term <> hcat selectors +-- Selection (`foo.bar.baz`) case distinction on the first element (`foo`): +-- If it is an ident, keep it all together +prettyTerm (Selection term@(Token _) selectors) = pretty term <> hcat selectors +-- If it is a parenthesized expression, maybe add a line break +prettyTerm (Selection term@(Parenthesized _ _ _) selectors) = pretty term <> softline' <> hcat selectors +-- Otherwise, very likely add a line break +prettyTerm (Selection term selectors) = pretty term <> line' <> hcat selectors -- Empty list prettyTerm (List (Ann paropen Nothing []) [] parclose) diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 442dc489..2dd4c688 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -84,13 +84,15 @@ foo = 1; bar = 2; # multiline - }.${x}; + } + .${x}; y = # more multiline { foo = 1; bar = 2; # multiline - }.${x}; + } + .${x}; z = functionCall { # multi #line diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index a7c3fe7d..7e44c1ee 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -550,7 +550,8 @@ rec { "13" = "D"; "14" = "E"; "15" = "F"; - }.${toString d} + } + .${toString d} ; in lib.concatMapStrings toHexDigit (toBaseDigits 16 i) diff --git a/test/diff/select/in.nix b/test/diff/select/in.nix index c66751e3..9938bdf1 100644 --- a/test/diff/select/in.nix +++ b/test/diff/select/in.nix @@ -6,4 +6,8 @@ ( a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a ) ( a.a .a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a ) + ({ + # multiple lines + foo = "bar"; + }.a.b.c) ] diff --git a/test/diff/select/out.nix b/test/diff/select/out.nix index 39c6e3da..b5c6371f 100644 --- a/test/diff/select/out.nix +++ b/test/diff/select/out.nix @@ -5,4 +5,9 @@ (a.a) (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) + ({ + # multiple lines + foo = "bar"; + } + .a.b.c) ] From 8a6cb8c05cb7e3f072b5697abdaa370650bcac81 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 19 May 2023 11:15:47 +0200 Subject: [PATCH 026/125] Rework operators They now get expanded and indented more liberally, with some exceptions. Things still look weird at places because of parentheses formatting. --- src/Nixfmt/Pretty.hs | 20 ++++++-- test/diff/attr_set/out.nix | 17 ++++--- test/diff/idioms_lib_3/out.nix | 36 +++++++++----- test/diff/idioms_nixos_1/out.nix | 20 ++++---- test/diff/idioms_nixos_2/out.nix | 8 ++-- test/diff/idioms_pkgs_3/out.nix | 82 +++++++++++++++++++++----------- test/diff/operation/in.nix | 47 ++++++++++++++++++ test/diff/operation/out.nix | 81 +++++++++++++++++++++++++++++++ 8 files changed, 248 insertions(+), 63 deletions(-) create mode 100644 test/diff/operation/in.nix create mode 100644 test/diff/operation/out.nix diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 19abe77b..36e0748c 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -279,9 +279,23 @@ instance Pretty Expression where pretty (Application f x) = group $ pretty f <> absorbApp x - pretty (Operation a op b) - = pretty a <> softline - <> pretty op <> hardspace <> pretty b + -- '//' operator + pretty operation@(Operation a op@(Ann TUpdate _ _) b) + = pretty a <> softline <> pretty op <> hardspace <> pretty b + -- all other operators + pretty operation@(Operation _ op _) + = let + -- Walk the operation tree and put a list of things on the same level + flatten (Operation a op' b) | op' == op = (flatten a) ++ (flatten b) + flatten x = [x] + flattened = flatten operation + + -- Some children need nesting + absorbOperation (Term t) | isAbsorbable t = pretty t + absorbOperation x@(Operation _ _ _) = nest 2 (pretty x) + absorbOperation x = base $ nest 2 (pretty x) + in + group $ sepBy (line <> pretty op <> hardspace) (map absorbOperation flattened) pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 2dd4c688..85984f3f 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -104,16 +104,21 @@ [ some flags # multiline - ] ++ [ short ] ++ [ + ] + ++ [ short ] + ++ [ more stuff # multiline - ] ++ (if foo then + ] + ++ (if foo then [ bar ] else - [ baz ]) ++ [ ] ++ (optionals condition [ - more - items - ]) + [ baz ]) + ++ [ ] + ++ (optionals condition [ + more + items + ]) ; b = with pkgs; [ a diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index b94e71d6..e0eb0743 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -162,7 +162,8 @@ rec { sectName: sectValues: '' [${mkSectionName sectName}] - '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues + '' + + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues ; # map input to ini sections in @@ -424,7 +425,8 @@ rec { "'''" ]; singlelineResult = - ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + ''"'' + + concatStringsSep "\\n" (map escapeSingleline lines) + ''"'' ; multilineResult = @@ -434,12 +436,14 @@ rec { # indentation level. Otherwise, '' is appended to the last line. lastLine = lib.last escapedLines; in - "''" + introSpace + "''" + + introSpace + concatStringsSep introSpace (lib.init escapedLines) + (if lastLine == "" then outroSpace else - introSpace + lastLine) + "''" + introSpace + lastLine) + + "''" ; in if multiline && length lines > 1 then @@ -458,9 +462,11 @@ rec { if v == [ ] then "[ ]" else - "[" + introSpace + "[" + + introSpace + libStr.concatMapStringsSep introSpace (go (indent + " ")) v - + outroSpace + "]" + + outroSpace + + "]" else if isFunction v then let fna = lib.functionArgs v; @@ -486,13 +492,17 @@ rec { else if v ? type && v.type == "derivation" then "" else - "{" + introSpace + libStr.concatStringsSep introSpace - (libAttr.mapAttrsToList (name: value: - "${libStr.escapeNixIdentifier name} = ${ - builtins.addErrorContext - "while evaluating an attribute `${name}`" - (go (indent + " ") value) - };") v) + outroSpace + "}" + "{" + + introSpace + + libStr.concatStringsSep introSpace (libAttr.mapAttrsToList + (name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext + "while evaluating an attribute `${name}`" + (go (indent + " ") value) + };") v) + + outroSpace + + "}" else abort "generators.toPretty: should never happen (v = ${v})" ; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 679948e4..a15d79df 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -257,15 +257,16 @@ in "hid_logitech_dj" "hid_microsoft" - ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ - # Misc. x86 keyboard stuff. - "pcips2" - "atkbd" - "i8042" + ] + ++ optionals pkgs.stdenv.hostPlatform.isx86 [ + # Misc. x86 keyboard stuff. + "pcips2" + "atkbd" + "i8042" - # x86 RTC needed by the stage 2 init script. - "rtc_cmos" - ]); + # x86 RTC needed by the stage 2 init script. + "rtc_cmos" + ]); boot.initrd.kernelModules = optionals config.boot.initrd.includeDefaultModules [ @@ -370,7 +371,8 @@ in # !!! Should this really be needed? (isYes "MODULES") (isYes "BINFMT_ELF") - ] ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); + ] + ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); # nixpkgs kernels are assumed to have all required features assertions = diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 6a6f78d4..77fdaa72 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -32,8 +32,9 @@ let else [ cfg.phpPackage.extensions.openssl ]) ++ optional cfg.enableImagemagick imagick - # Optionally enabled depending on caching settings - ++ optional cfg.caching.apcu apcu ++ optional cfg.caching.redis redis + # Optionally enabled depending on caching settings + ++ optional cfg.caching.apcu apcu + ++ optional cfg.caching.redis redis ++ optional cfg.caching.memcached memcached) ++ cfg.phpExtraExtensions all ; # Enabled by user @@ -756,7 +757,8 @@ in (optional (cfg.poolConfig != null) '' Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. Please migrate your configuration to config.services.nextcloud.poolSettings. - '') ++ (optional (versionOlder cfg.package.version "23") + '') + ++ (optional (versionOlder cfg.package.version "23") (upgradeWarning 22 "22.05")) ++ (optional (versionOlder cfg.package.version "24") (upgradeWarning 23 "22.05")) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 03a510ae..9deb7ff8 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -163,8 +163,10 @@ }: assert stdenv.cc.libc or null != null; -assert pipewireSupport -> !waylandSupport || !webrtcSupport -> throw - "${pname}: pipewireSupport requires both wayland and webrtc support."; +assert pipewireSupport + -> !waylandSupport || !webrtcSupport + -> throw + "${pname}: pipewireSupport requires both wayland and webrtc support."; let inherit (lib) @@ -257,26 +259,29 @@ buildStdenv.mkDerivation ({ patches = lib.optionals (lib.versionOlder version "102.6.0") [ - (fetchpatch { - # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 - name = "rust-cbindgen-0.24.2-compat.patch"; - url = - "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; - hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; - }) - ] ++ lib.optional (lib.versionOlder version "111") - ./env_var_for_system_dir-ff86.patch + (fetchpatch { + # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 + name = "rust-cbindgen-0.24.2-compat.patch"; + url = + "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; + hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; + }) + ] + ++ lib.optional (lib.versionOlder version "111") + ./env_var_for_system_dir-ff86.patch ++ lib.optional (lib.versionAtLeast version "111") - ./env_var_for_system_dir-ff111.patch + ./env_var_for_system_dir-ff111.patch ++ lib.optional (lib.versionAtLeast version "96") - ./no-buildconfig-ffx96.patch ++ extraPatches + ./no-buildconfig-ffx96.patch + ++ extraPatches ; postPatch = '' rm -rf obj-x86_64-pc-linux-gnu patchShebangs mach build - '' + extraPostPatch + '' + + extraPostPatch ; # Ignore trivial whitespace changes in patches, this fixes compatibility of @@ -308,10 +313,13 @@ buildStdenv.mkDerivation ({ unzip which wrapGAppsHook - ] ++ lib.optionals crashreporterSupport [ + ] + ++ lib.optionals crashreporterSupport [ dump_syms patchelf - ] ++ lib.optionals pgoSupport [ xvfb-run ] ++ extraNativeBuildInputs + ] + ++ lib.optionals pgoSupport [ xvfb-run ] + ++ extraNativeBuildInputs ; setOutputFlags = @@ -345,7 +353,8 @@ buildStdenv.mkDerivation ({ # RBox WASM Sandboxing export WASM_CC=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}cc export WASM_CXX=${pkgsCross.wasi32.stdenv.cc}/bin/${pkgsCross.wasi32.stdenv.cc.targetPrefix}c++ - '' + lib.optionalString pgoSupport '' + '' + + lib.optionalString pgoSupport '' if [ -e "$TMPDIR/merged.profdata" ]; then echo "Configuring with profiling data" for i in "''${!configureFlagsArray[@]}"; do @@ -364,7 +373,8 @@ buildStdenv.mkDerivation ({ "--enable-profile-generate=cross" ) fi - '' + lib.optionalString googleAPISupport '' + '' + + lib.optionalString googleAPISupport '' # Google API key used by Chromium and Firefox. # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, # please get your own set of keys at https://www.chromium.org/developers/how-tos/api-keys/. @@ -372,13 +382,15 @@ buildStdenv.mkDerivation ({ # 60.5+ & 66+ did split the google API key arguments: https://bugzilla.mozilla.org/show_bug.cgi?id=1531176 configureFlagsArray+=("--with-google-location-service-api-keyfile=$TMPDIR/google-api-key") configureFlagsArray+=("--with-google-safebrowsing-api-keyfile=$TMPDIR/google-api-key") - '' + lib.optionalString mlsAPISupport '' + '' + + lib.optionalString mlsAPISupport '' # Mozilla Location services API key # Note: These are for NixOS/nixpkgs use ONLY. For your own distribution, # please get your own set of keys at https://location.services.mozilla.com/api. echo "dfd7836c-d458-4917-98bb-421c82d3c8a0" > $TMPDIR/mls-api-key configureFlagsArray+=("--with-mozilla-api-keyfile=$TMPDIR/mls-api-key") - '' + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' + '' + + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' export MOZILLA_OFFICIAL=1 '' ; @@ -421,7 +433,9 @@ buildStdenv.mkDerivation ({ # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 ++ lib.optional (ltoSupport && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64)) - "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ + "--disable-elf-hack" + ++ lib.optional (!drmSupport) "--disable-eme" + ++ [ (enableFeature alsaSupport "alsa") (enableFeature crashreporterSupport "crashreporter") (enableFeature ffmpegSupport "ffmpeg") @@ -441,10 +455,12 @@ buildStdenv.mkDerivation ({ # of RAM, and the 32-bit memory space cannot handle that linking (enableFeature (!debugBuild && !stdenv.is32bit) "release") (enableFeature enableDebugSymbols "debug-symbols") - ] ++ lib.optionals enableDebugSymbols [ + ] + ++ lib.optionals enableDebugSymbols [ "--disable-strip" "--disable-install-strip" - ] ++ lib.optional enableOfficialBranding "--enable-official-branding" + ] + ++ lib.optional enableOfficialBranding "--enable-official-branding" ++ lib.optional (branding != null) "--with-branding=${branding}" ++ extraConfigureFlags ; @@ -486,18 +502,24 @@ buildStdenv.mkDerivation ({ xorg.xorgproto zip zlib - ] ++ [ + ] + ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) - ] ++ lib.optional alsaSupport alsa-lib ++ lib.optional jackSupport libjack2 + ] + ++ lib.optional alsaSupport alsa-lib + ++ lib.optional jackSupport libjack2 ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed - ++ lib.optional sndioSupport sndio ++ lib.optional gssSupport libkrb5 + ++ lib.optional sndioSupport sndio + ++ lib.optional gssSupport libkrb5 ++ lib.optionals waylandSupport [ libxkbcommon libdrm - ] ++ lib.optional jemallocSupport jemalloc ++ extraBuildInputs + ] + ++ lib.optional jemallocSupport jemalloc + ++ extraBuildInputs ; profilingPhase = lib.optionalString pgoSupport '' @@ -543,7 +565,8 @@ buildStdenv.mkDerivation ({ ./mach buildsymbols mkdir -p $symbols/ cp mozobj/dist/*.crashreporter-symbols.zip $symbols/ - '' + '' + '' + + '' cd mozobj '' ; @@ -554,7 +577,8 @@ buildStdenv.mkDerivation ({ install -Dvm644 ${distributionIni} $out/lib/${binaryName}/distribution/distribution.ini install -Dvm644 ${defaultPrefsFile} $out/lib/${binaryName}/browser/defaults/preferences/nixos-default-prefs.js - '' + lib.optionalString buildStdenv.isLinux '' + '' + + lib.optionalString buildStdenv.isLinux '' # Remove SDK cruft. FIXME: move to a separate output? rm -rf $out/share/idl $out/include $out/lib/${binaryName}-devel-* diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix new file mode 100644 index 00000000..3453c92f --- /dev/null +++ b/test/diff/operation/in.nix @@ -0,0 +1,47 @@ +[ + ([ 1 2 3] ++ [4 5 6] ++ [7 8 9]) + + ([ + some flags # multiline + ] ++ [ short ] ++ [ + more stuff # multiline + ] ++ (if foo then [ bar ] else [baz ]) ++ [] ++ + (optionals condition [more items]) + ) + + # Test precedence + (aaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbb + + ccccccccccccccccccccccccccc + ddddddddddddddddddddddd + * eeeeeeeeeeeeeeeeeeeeeeee + ffffffffffffffffffffffffff + * gggggggggggggggggggggggg ++ hhhhhhhhhhhhhhhhhhhhhhhhhhh + ++ iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii * jjjjjjjjjjjjjjjjjjjjj) + + # Logical precedence + (assert pipewireSupport -> !waylandSupport || !webrtcSupport -> pipewireSupport; + if aaaaaaaaaaaaaa && bbbbbbbbbbbb + || cccccccccccccccccccc && ddddddddddddddddd + || eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff + then [] else + if aaaaaaaaaaaaaaaaaaaaa || bbbbbbbbbbbbbbbbbbb + && cccccccccccccccccccccccccccccccc || ddddddddddddddddd + && eeeeeeeeeeeeeeeeeeee || fffffffffffffffffffffffffff + then [] else + {} + ) + + # Indentation + ( + [ + #multiline + zip + zlib + ] + ++ [ + (if (lib.versionAtLeast version "103") then + nss_latest + else + nss_esr) + ] + ) + +] diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix new file mode 100644 index 00000000..d59236d6 --- /dev/null +++ b/test/diff/operation/out.nix @@ -0,0 +1,81 @@ +[ + ([ + 1 + 2 + 3 + ] + ++ [ + 4 + 5 + 6 + ] + ++ [ + 7 + 8 + 9 + ]) + + ([ + some + flags # multiline + ] + ++ [ short ] + ++ [ + more + stuff # multiline + ] + ++ (if foo then + [ bar ] + else + [ baz ]) + ++ [ ] + ++ (optionals condition [ + more + items + ])) + + # Test precedence + (aaaaaaaaaaaaaaa + + bbbbbbbbbbbbbbbbbbbb + + ccccccccccccccccccccccccccc + + ddddddddddddddddddddddd * eeeeeeeeeeeeeeeeeeeeeeee + + ffffffffffffffffffffffffff + * gggggggggggggggggggggggg + ++ hhhhhhhhhhhhhhhhhhhhhhhhhhh + ++ iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii + * jjjjjjjjjjjjjjjjjjjjj) + + # Logical precedence + (assert pipewireSupport + -> !waylandSupport || !webrtcSupport + -> pipewireSupport; + if + aaaaaaaaaaaaaa && bbbbbbbbbbbb + || cccccccccccccccccccc && ddddddddddddddddd + || eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff + then + [ ] + else if + aaaaaaaaaaaaaaaaaaaaa + || bbbbbbbbbbbbbbbbbbb && cccccccccccccccccccccccccccccccc + || ddddddddddddddddd && eeeeeeeeeeeeeeeeeeee + || fffffffffffffffffffffffffff + then + [ ] + else + { }) + + # Indentation + ([ + #multiline + zip + zlib + ] + ++ [ + (if (lib.versionAtLeast version "103") then + nss_latest + else + nss_esr) + ]) + +] From 487d3136679f9f0d9b00baf678c306c9b8725bb8 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 19 May 2023 11:39:58 +0200 Subject: [PATCH 027/125] Rework parentheses With a couple of exceptions, multiline parentheses are now forced to start on the next line. --- src/Nixfmt/Pretty.hs | 13 +- test/diff/apply/out.nix | 20 +- test/diff/assert/out.nix | 58 ++-- test/diff/attr_set/out.nix | 10 +- test/diff/comment/out.nix | 33 +- test/diff/idioms_lib_2/out.nix | 18 +- test/diff/idioms_lib_3/out.nix | 116 ++++--- test/diff/idioms_nixos_1/out.nix | 114 ++++--- test/diff/idioms_nixos_2/out.nix | 56 ++-- test/diff/idioms_pkgs_3/out.nix | 39 ++- test/diff/if_else/out.nix | 536 ++++++++++++++++++------------ test/diff/inherit_comment/out.nix | 4 +- test/diff/inherit_from/out.nix | 128 ++++--- test/diff/lambda/out.nix | 69 ++-- test/diff/lists/out.nix | 10 +- test/diff/monsters_5/out.nix | 24 +- test/diff/operation/out.nix | 76 +++-- test/diff/or_default/out.nix | 10 +- test/diff/paren/out.nix | 84 +++-- test/diff/pattern/out.nix | 462 ++++++++++++++++--------- test/diff/select/out.nix | 16 +- test/diff/with/out.nix | 34 +- 22 files changed, 1203 insertions(+), 727 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 36e0748c..5b766223 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -154,9 +154,20 @@ prettyTerm (Set krec (Ann paropen trailing leading) binders parclose) <> nest 2 (pretty leading <> sepBy hardline binders) <> line <> pretty parclose +-- Parentheses prettyTerm (Parenthesized (Ann paropen trailing leading) expr parclose) = base $ pretty paropen <> pretty trailing - <> nest 2 (pretty leading <> group expr) <> pretty parclose + <> nest 2 (pretty leading <> absorbedLine <> group expr <> absorbedLine) <> pretty parclose + where + absorbedLine = + case expr of + -- Start on the same line for these + (Term t) | isAbsorbable t -> mempty + (Application _ _) -> mempty + (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t -> mempty + + -- Start on a new line for the others + _ -> line' instance Pretty Term where pretty l@(List _ _ _) = group $ prettyTerm l diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 87619c4b..91bcd32b 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -7,16 +7,16 @@ )) '' otherModules=${ - pkgs.writeText "other-modules.json" (l.toJSON (l.mapAttrs - (pname: subOutputs: - let - pkg = subOutputs.packages."${pname}".overrideAttrs (old: { - buildScript = "true"; - installMethod = "copy"; - }); - in - "${pkg}/lib/node_modules/${pname}/node_modules" - ) outputs.subPackages)) + pkgs.writeText "other-modules.json" (l.toJSON (l.mapAttrs ( + pname: subOutputs: + let + pkg = subOutputs.packages."${pname}".overrideAttrs (old: { + buildScript = "true"; + installMethod = "copy"; + }); + in + "${pkg}/lib/node_modules/${pname}/node_modules" + ) outputs.subPackages)) } '' { diff --git a/test/diff/assert/out.nix b/test/diff/assert/out.nix index 1228cdba..de9c0151 100644 --- a/test/diff/assert/out.nix +++ b/test/diff/assert/out.nix @@ -1,27 +1,41 @@ [ (assert b; e) - (assert b; # d - e) - (assert b # c - ; - e) - (assert b # c - ; # d - e) - (assert # a - b; - e) - (assert # a - b; # d - e) - (assert # a - b # c - ; - e) - (assert # a - b # c - ; # d - e) + ( + assert b; # d + e + ) + ( + assert b # c + ; + e + ) + ( + assert b # c + ; # d + e + ) + ( + assert # a + b; + e + ) + ( + assert # a + b; # d + e + ) + ( + assert # a + b # c + ; + e + ) + ( + assert # a + b # c + ; # d + e + ) (assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) (assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 85984f3f..f1ed1c9f 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -110,10 +110,12 @@ more stuff # multiline ] - ++ (if foo then - [ bar ] - else - [ baz ]) + ++ ( + if foo then + [ bar ] + else + [ baz ] + ) ++ [ ] ++ (optionals condition [ more diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index 1f5f795f..1e4fb822 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -60,24 +60,27 @@ #7 } - (let # 1 - #2 - a = 1; # 3 - b = 1; - c = 1; # 4 - #5 - - #6 - - d = 1; - #7 - in - d + ( + let # 1 + #2 + a = 1; # 3 + b = 1; + c = 1; # 4 + #5 + + #6 + + d = 1; + #7 + in + d ) - ({ + ( + { a, # comment b ? 2, # comment }: - _) + _ + ) ] diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 7e44c1ee..f725180b 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -106,27 +106,33 @@ rec { # bitwise “and” bitAnd = - builtins.bitAnd or (import ./zip-int-bits.nix (a: b: + builtins.bitAnd or (import ./zip-int-bits.nix ( + a: b: if a == 1 && b == 1 then 1 else - 0)); + 0 + )); # bitwise “or” bitOr = - builtins.bitOr or (import ./zip-int-bits.nix (a: b: + builtins.bitOr or (import ./zip-int-bits.nix ( + a: b: if a == 1 || b == 1 then 1 else - 0)); + 0 + )); # bitwise “xor” bitXor = - builtins.bitXor or (import ./zip-int-bits.nix (a: b: + builtins.bitXor or (import ./zip-int-bits.nix ( + a: b: if a != b then 1 else - 0)); + 0 + )); # bitwise “not” bitNot = builtins.sub (-1); diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index e0eb0743..c5c465e6 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -37,8 +37,10 @@ rec { let err = t: v: - abort ("generators.mkValueStringDefault: " - + "${t} not supported: ${toPretty { } v}") + abort ( + "generators.mkValueStringDefault: " + + "${t} not supported: ${toPretty { } v}" + ) ; in if isInt v then @@ -106,10 +108,12 @@ rec { mkLines = if listsAsDuplicateKeys then k: v: - map (mkLine k) (if lib.isList v then - v - else - [ v ]) + map (mkLine k) ( + if lib.isList v then + v + else + [ v ] + ) else k: v: [ (mkLine k v) ] ; @@ -141,11 +145,13 @@ rec { toINI = { # apply transformations (e.g. escapes) to section names - mkSectionName ? (name: + mkSectionName ? ( + name: libStr.escape [ "[" "]" - ] name), + ] name + ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys @@ -203,11 +209,13 @@ rec { toINIWithGlobalSection = { # apply transformations (e.g. escapes) to section names - mkSectionName ? (name: + mkSectionName ? ( + name: libStr.escape [ "[" "]" - ] name), + ] name + ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys @@ -217,11 +225,13 @@ rec { globalSection, sections, }: - (if globalSection == { } then - "" - else - (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) - + "\n") + ( + if globalSection == { } then + "" + else + (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + + "\n" + ) + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections) ; @@ -439,10 +449,12 @@ rec { "''" + introSpace + concatStringsSep introSpace (lib.init escapedLines) - + (if lastLine == "" then - outroSpace - else - introSpace + lastLine) + + ( + if lastLine == "" then + outroSpace + else + introSpace + lastLine + ) + "''" ; in @@ -470,12 +482,13 @@ rec { else if isFunction v then let fna = lib.functionArgs v; - showFnas = concatStringsSep ", " (libAttr.mapAttrsToList - (name: hasDefVal: - if hasDefVal then - name + "?" - else - name) fna); + showFnas = concatStringsSep ", " (libAttr.mapAttrsToList ( + name: hasDefVal: + if hasDefVal then + name + "?" + else + name + ) fna); in if fna == { } then "" @@ -494,13 +507,14 @@ rec { else "{" + introSpace - + libStr.concatStringsSep introSpace (libAttr.mapAttrsToList - (name: value: - "${libStr.escapeNixIdentifier name} = ${ - builtins.addErrorContext - "while evaluating an attribute `${name}`" - (go (indent + " ") value) - };") v) + + libStr.concatStringsSep introSpace (libAttr.mapAttrsToList ( + name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext + "while evaluating an attribute `${name}`" + (go (indent + " ") value) + };" + ) v) + outroSpace + "}" else @@ -541,10 +555,12 @@ rec { bool = ind: x: - literal ind (if x then - "" - else - "") + literal ind ( + if x then + "" + else + "" + ) ; int = ind: x: literal ind "${toString x}"; str = ind: x: literal ind "${x}"; @@ -578,12 +594,13 @@ rec { attrFilter = name: value: name != "_module" && value != null; in ind: x: - libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList - (name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ]) x)) + libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList ( + name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ] + ) x)) ; in @@ -607,8 +624,9 @@ rec { in if isAttrs v then "{ ${ - concatItems (lib.attrsets.mapAttrsToList - (key: value: "${key} = ${toDhall args value}") v) + concatItems (lib.attrsets.mapAttrsToList ( + key: value: "${key} = ${toDhall args value}" + ) v) } }" else if isList v then "[ ${concatItems (map (toDhall args) v)} ]" @@ -620,10 +638,12 @@ rec { "+" }${toString v}" else if isBool v then - (if v then - "True" - else - "False") + ( + if v then + "True" + else + "False" + ) else if isFunction v then abort "generators.toDhall: cannot convert a function to Dhall" else if v == null then diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index a15d79df..310d665c 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -42,14 +42,16 @@ in type = types.unspecified // { merge = mergeEqualOption; }; apply = kernelPackages: - kernelPackages.extend (self: super: { - kernel = super.kernel.override (originalArgs: { - inherit randstructSeed; - kernelPatches = - (originalArgs.kernelPatches or [ ]) ++ kernelPatches; - features = lib.recursiveUpdate super.kernel.features features; - }); - }) + kernelPackages.extend ( + self: super: { + kernel = super.kernel.override (originalArgs: { + inherit randstructSeed; + kernelPatches = + (originalArgs.kernelPatches or [ ]) ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + }); + } + ) ; # We don't want to evaluate all of linuxPackages for the manual # - some of it might not even evaluate correctly. @@ -90,10 +92,12 @@ in }; boot.kernelParams = mkOption { - type = types.listOf (types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { - name = "kernelParam"; - description = "string, with spaces inside double quotes"; - }); + type = types.listOf ( + types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { + name = "kernelParam"; + description = "string, with spaces inside double quotes"; + } + ); default = [ ]; description = "Parameters added to the kernel command line."; }; @@ -217,47 +221,48 @@ in config = mkMerge [ (mkIf config.boot.initrd.enable { boot.initrd.availableKernelModules = - optionals config.boot.initrd.includeDefaultModules ([ - # Note: most of these (especially the SATA/PATA modules) - # shouldn't be included by default since nixos-generate-config - # detects them, but I'm keeping them for now for backwards - # compatibility. - - # Some SATA/PATA stuff. - "ahci" - "sata_nv" - "sata_via" - "sata_sis" - "sata_uli" - "ata_piix" - "pata_marvell" - - # Standard SCSI stuff. - "sd_mod" - "sr_mod" - - # SD cards and internal eMMC drives. - "mmc_block" - - # Support USB keyboards, in case the boot fails and we only have - # a USB keyboard, or for LUKS passphrase prompt. - "uhci_hcd" - "ehci_hcd" - "ehci_pci" - "ohci_hcd" - "ohci_pci" - "xhci_hcd" - "xhci_pci" - "usbhid" - "hid_generic" - "hid_lenovo" - "hid_apple" - "hid_roccat" - "hid_logitech_hidpp" - "hid_logitech_dj" - "hid_microsoft" - - ] + optionals config.boot.initrd.includeDefaultModules ( + [ + # Note: most of these (especially the SATA/PATA modules) + # shouldn't be included by default since nixos-generate-config + # detects them, but I'm keeping them for now for backwards + # compatibility. + + # Some SATA/PATA stuff. + "ahci" + "sata_nv" + "sata_via" + "sata_sis" + "sata_uli" + "ata_piix" + "pata_marvell" + + # Standard SCSI stuff. + "sd_mod" + "sr_mod" + + # SD cards and internal eMMC drives. + "mmc_block" + + # Support USB keyboards, in case the boot fails and we only have + # a USB keyboard, or for LUKS passphrase prompt. + "uhci_hcd" + "ehci_hcd" + "ehci_pci" + "ohci_hcd" + "ohci_pci" + "xhci_hcd" + "xhci_pci" + "usbhid" + "hid_generic" + "hid_lenovo" + "hid_apple" + "hid_roccat" + "hid_logitech_hidpp" + "hid_logitech_dj" + "hid_microsoft" + + ] ++ optionals pkgs.stdenv.hostPlatform.isx86 [ # Misc. x86 keyboard stuff. "pcips2" @@ -266,7 +271,8 @@ in # x86 RTC needed by the stage 2 init script. "rtc_cmos" - ]); + ] + ); boot.initrd.kernelModules = optionals config.boot.initrd.includeDefaultModules [ diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 77fdaa72..1092e579 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -21,21 +21,25 @@ let enabled, all, }: - (with all; - # disable default openssl extension + ( + with all; + # disable default openssl extension (lib.filter (e: e.pname != "php-openssl") enabled) # use OpenSSL 1.1 for RC4 Nextcloud encryption if user # has acknowledged the brokenness of the ciphers (RC4). # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. - ++ (if cfg.enableBrokenCiphersForSSE then - [ cfg.phpPackage.extensions.openssl-legacy ] - else - [ cfg.phpPackage.extensions.openssl ]) + ++ ( + if cfg.enableBrokenCiphersForSSE then + [ cfg.phpPackage.extensions.openssl-legacy ] + else + [ cfg.phpPackage.extensions.openssl ] + ) ++ optional cfg.enableImagemagick imagick # Optionally enabled depending on caching settings ++ optional cfg.caching.apcu apcu ++ optional cfg.caching.redis redis - ++ optional cfg.caching.memcached memcached) + ++ optional cfg.caching.memcached memcached + ) ++ cfg.phpExtraExtensions all ; # Enabled by user extraConfig = toKeyValue phpOptions; @@ -786,18 +790,20 @@ in ; services.nextcloud.package = with pkgs; - mkDefault (if pkgs ? nextcloud then - throw '' - The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default - nextcloud defined in an overlay, please set `services.nextcloud.package` to - `pkgs.nextcloud`. - '' - else if versionOlder stateVersion "22.11" then - nextcloud24 - else if versionOlder stateVersion "23.05" then - nextcloud25 - else - nextcloud26); + mkDefault ( + if pkgs ? nextcloud then + throw '' + The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default + nextcloud defined in an overlay, please set `services.nextcloud.package` to + `pkgs.nextcloud`. + '' + else if versionOlder stateVersion "22.11" then + nextcloud24 + else if versionOlder stateVersion "23.05" then + nextcloud25 + else + nextcloud26 + ); services.nextcloud.phpPackage = if versionOlder cfg.package.version "26" then @@ -1060,10 +1066,14 @@ in ${installFlags} '' ; - occSetTrustedDomainsCmd = concatStringsSep "\n" (imap0 (i: v: '' - ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ - ${toString i} --value="${toString v}" - '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains)); + occSetTrustedDomainsCmd = concatStringsSep "\n" (imap0 ( + i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '' + ) ( + [ cfg.hostName ] ++ cfg.config.extraTrustedDomains + )); in { diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 9deb7ff8..90023c38 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -234,10 +234,12 @@ let }; defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" - (lib.concatStringsSep "\n" (lib.mapAttrsToList (key: value: '' - // ${value.reason} - pref("${key}", ${builtins.toJSON value.value}); - '') defaultPrefs)); + (lib.concatStringsSep "\n" (lib.mapAttrsToList ( + key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '' + ) defaultPrefs)); in buildStdenv.mkDerivation ({ @@ -431,9 +433,12 @@ buildStdenv.mkDerivation ({ ] # elf-hack is broken when using clang+lld: # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 - ++ lib.optional (ltoSupport - && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64)) - "--disable-elf-hack" + ++ lib.optional ( + ltoSupport + && ( + buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64 + ) + ) "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ (enableFeature alsaSupport "alsa") @@ -447,10 +452,12 @@ buildStdenv.mkDerivation ({ (enableFeature sndioSupport "sndio") (enableFeature webrtcSupport "webrtc") (enableFeature debugBuild "debug") - (if debugBuild then - "--enable-profiling" - else - "--enable-optimize") + ( + if debugBuild then + "--enable-profiling" + else + "--enable-optimize" + ) # --enable-release adds -ffunction-sections & LTO that require a big amount # of RAM, and the 32-bit memory space cannot handle that linking (enableFeature (!debugBuild && !stdenv.is32bit) "release") @@ -504,10 +511,12 @@ buildStdenv.mkDerivation ({ zlib ] ++ [ - (if (lib.versionAtLeast version "103") then - nss_latest - else - nss_esr) + ( + if (lib.versionAtLeast version "103") then + nss_latest + else + nss_esr + ) ] ++ lib.optional alsaSupport alsa-lib ++ lib.optional jackSupport libjack2 diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index acb5206d..e1a64e30 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -1,238 +1,338 @@ [ - (if true then - { version = "1.2.3"; } - else - { version = "3.2.1"; }) - (if true then - '' - some text - '' - else - '' - other text - '') - (if ./a then - b - else - c) - (if a then - b - else - c) - (if # test - a # test - then # test - b # test - else # test - c) - (if # test - a # test - then # test - b # test - else # test - c) - (if - [ - multiline - # tmp - condition - ] - then - foo - else if - [ - more - multi - line - ] - then - bar - else - baz) - (if - unabsorbable # comment - == multiline - then - foo - else if - unabsorbable # comment - == multiline - then - bar - else - baz) - (if - if a then + ( + if true then + { version = "1.2.3"; } + else + { version = "3.2.1"; } + ) + ( + if true then + '' + some text + '' + else + '' + other text + '' + ) + ( + if ./a then b else c - then - b - else if a then - b - else if a then - b - else - c) - (if + ) + ( if a then b else c - then - b - else if a then - b - else # x - if a then - b - else - c) - (if - (if - (if - (if a then - b - else - c) - then - (if a then - b - else - c) - else - (if a then - b - else - c)) + ) + ( + if # test + a # test + then # test + b # test + else # test + c + ) + ( + if # test + a # test + then # test + b # test + else # test + c + ) + ( + if + [ + multiline + # tmp + condition + ] then - (if - (if a then - b - else - c) - then - (if a then - b - else - c) - else - (if a then - b - else - c)) + foo + else if + [ + more + multi + line + ] + then + bar else - (if - (if a then - b - else - c) - then - (if a then - b - else - c) - else - (if a then - b - else - c))) - then - (if - (if - (if a then - b - else - c) - then - (if a then - b - else - c) - else - (if a then - b - else - c)) + baz + ) + ( + if + unabsorbable # comment + == multiline then - (if - (if a then - b - else - c) - then - (if a then - b - else - c) - else - (if a then - b - else - c)) + foo + else if + unabsorbable # comment + == multiline + then + bar else - (if - (if a then - b - else - c) - then - (if a then - b - else - c) - else - (if a then - b - else - c))) - else - (if - (if - (if a then - b - else - c) - then - (if a then - b - else - c) + baz + ) + ( + if + if a then + b else - (if a then - b - else - c)) + c then - (if - (if a then - b - else - c) - then - (if a then - b - else - c) + b + else if a then + b + else if a then + b + else + c + ) + ( + if + if a then + b else - (if a then - b - else - c)) + c + then + b + else if a then + b + else # x + if a then + b else - (if - (if a then - b + c + ) + ( + if + ( + if + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) + then + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) else - c) - then - (if a then - b + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) + ) + then + ( + if + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) + then + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) else - c) - else - (if a then - b + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) + ) + else + ( + if + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) + then + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) else - c)))) + ( + if + ( + if a then + b + else + c + ) + then + ( + if a then + b + else + c + ) + else + ( + if a then + b + else + c + ) + ) + ) + ) ] diff --git a/test/diff/inherit_comment/out.nix b/test/diff/inherit_comment/out.nix index 403a2353..0b7086ce 100644 --- a/test/diff/inherit_comment/out.nix +++ b/test/diff/inherit_comment/out.nix @@ -7,7 +7,9 @@ # https://github.com/kamadorueda/alejandra/issues/372 inherit - (pkgs.haskell.lib) + ( + pkgs.haskell.lib + ) # doJailbreak - remove package bounds from build-depends of a package doJailbreak # dontCheck - skip tests diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 62f80068..820b1015 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -69,7 +69,8 @@ } { inherit - (c # d + ( + c # d ) f h @@ -77,7 +78,8 @@ } { inherit - (c # d + ( + c # d ) f h # i @@ -85,7 +87,8 @@ } { inherit - (c # d + ( + c # d ) f # g h @@ -93,7 +96,8 @@ } { inherit - (c # d + ( + c # d ) f # g h # i @@ -101,7 +105,8 @@ } { inherit - (c # d + ( + c # d ) # e f h @@ -109,7 +114,8 @@ } { inherit - (c # d + ( + c # d ) # e f h # i @@ -117,7 +123,8 @@ } { inherit - (c # d + ( + c # d ) # e f # g h @@ -125,7 +132,8 @@ } { inherit - (c # d + ( + c # d ) # e f # g h # i @@ -134,7 +142,8 @@ { inherit ( # b - c) + c + ) f h ; @@ -142,7 +151,8 @@ { inherit ( # b - c) + c + ) f h # i ; @@ -150,7 +160,8 @@ { inherit ( # b - c) + c + ) f # g h ; @@ -158,7 +169,8 @@ { inherit ( # b - c) + c + ) f # g h # i ; @@ -166,7 +178,8 @@ { inherit ( # b - c) # e + c + ) # e f h ; @@ -174,7 +187,8 @@ { inherit ( # b - c) # e + c + ) # e f h # i ; @@ -182,7 +196,8 @@ { inherit ( # b - c) # e + c + ) # e f # g h ; @@ -190,7 +205,8 @@ { inherit ( # b - c) # e + c + ) # e f # g h # i ; @@ -269,63 +285,80 @@ } { inherit # a - (c) + ( + c + ) f h ; } { inherit # a - (c) + ( + c + ) f h # i ; } { inherit # a - (c) + ( + c + ) f # g h ; } { inherit # a - (c) + ( + c + ) f # g h # i ; } { inherit # a - (c) # e + ( + c + ) # e f h ; } { inherit # a - (c) # e + ( + c + ) # e f h # i ; } { inherit # a - (c) # e + ( + c + ) # e f # g h ; } { inherit # a - (c) # e + ( + c + ) # e f # g h # i ; } { inherit # a - (c # d + ( + c # d ) f h @@ -333,7 +366,8 @@ } { inherit # a - (c # d + ( + c # d ) f h # i @@ -341,7 +375,8 @@ } { inherit # a - (c # d + ( + c # d ) f # g h @@ -349,7 +384,8 @@ } { inherit # a - (c # d + ( + c # d ) f # g h # i @@ -357,7 +393,8 @@ } { inherit # a - (c # d + ( + c # d ) # e f h @@ -365,7 +402,8 @@ } { inherit # a - (c # d + ( + c # d ) # e f h # i @@ -373,7 +411,8 @@ } { inherit # a - (c # d + ( + c # d ) # e f # g h @@ -381,7 +420,8 @@ } { inherit # a - (c # d + ( + c # d ) # e f # g h # i @@ -390,7 +430,8 @@ { inherit # a ( # b - c) + c + ) f h ; @@ -398,7 +439,8 @@ { inherit # a ( # b - c) + c + ) f h # i ; @@ -406,7 +448,8 @@ { inherit # a ( # b - c) + c + ) f # g h ; @@ -414,7 +457,8 @@ { inherit # a ( # b - c) + c + ) f # g h # i ; @@ -422,7 +466,8 @@ { inherit # a ( # b - c) # e + c + ) # e f h ; @@ -430,7 +475,8 @@ { inherit # a ( # b - c) # e + c + ) # e f h # i ; @@ -438,7 +484,8 @@ { inherit # a ( # b - c) # e + c + ) # e f # g h ; @@ -446,7 +493,8 @@ { inherit # a ( # b - c) # e + c + ) # e f # g h # i ; diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 0f417180..302d0347 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -1,40 +1,59 @@ [ - (a: b: # c - d) - ({ }: + ( + a: b: # c + d + ) + ( + { }: b: # c - d) - (a: + d + ) + ( + a: { }: # c - d) + d + ) (a: d) - (a: # c - d) - (a # b + ( + a: # c + d + ) + ( + a # b : - d) - (a # b + d + ) + ( + a # b : # c - d) + d + ) (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) - (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) - ({ + ( + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + ) + ( + { pkgs ? import ./.. { }, locationsXml, }: - null) + null + ) (a: b: c: { }: a: b: c: a) - ({ + ( + { pkgs, ... }: { # Stuff - }) + } + ) - ({ + ( + { pkgs, ... }: @@ -43,7 +62,8 @@ pkgs ) - (a: + ( + a: { b, ... @@ -51,9 +71,11 @@ c: { # Stuff - }) + } + ) - (a: + ( + a: { b, c, @@ -62,5 +84,6 @@ d: { # Stuff - }) + } + ) ] diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 7ddc70a1..39d98134 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -5,10 +5,12 @@ foo2 = "barbar"; } ] [ - (if foo then - bar # multiline too - else - baz) + ( + if foo then + bar # multiline too + else + baz + ) ] [ 1 ] diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 24bf71a9..d89e906a 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -18,14 +18,18 @@ let inherit - (config.boot) + ( + config.boot + ) kernelPatches ; inherit - (config.boot.kernel) + ( + config.boot.kernel + ) features @@ -34,7 +38,9 @@ let inherit - (config.boot.kernelPackages) + ( + config.boot.kernelPackages + ) kernel ; @@ -144,7 +150,8 @@ in kernelPackages.extend - (self: + ( + self: super: @@ -169,11 +176,13 @@ in = - (originalArgs.kernelPatches + ( + originalArgs.kernelPatches or - [ ]) + [ ] + ) ++ @@ -192,7 +201,8 @@ in }); - }) + } + ) ; # We don't want to evaluate all of linuxPackages for the manual diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index d59236d6..414b5d87 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -1,9 +1,10 @@ [ - ([ - 1 - 2 - 3 - ] + ( + [ + 1 + 2 + 3 + ] ++ [ 4 5 @@ -13,29 +14,35 @@ 7 8 9 - ]) + ] + ) - ([ - some - flags # multiline - ] + ( + [ + some + flags # multiline + ] ++ [ short ] ++ [ more stuff # multiline ] - ++ (if foo then - [ bar ] - else - [ baz ]) + ++ ( + if foo then + [ bar ] + else + [ baz ] + ) ++ [ ] ++ (optionals condition [ more items - ])) + ]) + ) # Test precedence - (aaaaaaaaaaaaaaa + ( + aaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbb + ccccccccccccccccccccccccccc + ddddddddddddddddddddddd * eeeeeeeeeeeeeeeeeeeeeeee @@ -43,12 +50,14 @@ * gggggggggggggggggggggggg ++ hhhhhhhhhhhhhhhhhhhhhhhhhhh ++ iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii - * jjjjjjjjjjjjjjjjjjjjj) + * jjjjjjjjjjjjjjjjjjjjj + ) # Logical precedence - (assert pipewireSupport - -> !waylandSupport || !webrtcSupport - -> pipewireSupport; + ( + assert pipewireSupport + -> !waylandSupport || !webrtcSupport + -> pipewireSupport; if aaaaaaaaaaaaaa && bbbbbbbbbbbb || cccccccccccccccccccc && ddddddddddddddddd @@ -63,19 +72,24 @@ then [ ] else - { }) + { } + ) # Indentation - ([ - #multiline - zip - zlib - ] + ( + [ + #multiline + zip + zlib + ] ++ [ - (if (lib.versionAtLeast version "103") then - nss_latest - else - nss_esr) - ]) + ( + if (lib.versionAtLeast version "103") then + nss_latest + else + nss_esr + ) + ] + ) ] diff --git a/test/diff/or_default/out.nix b/test/diff/or_default/out.nix index 66fd5cfc..09dfccee 100644 --- a/test/diff/or_default/out.nix +++ b/test/diff/or_default/out.nix @@ -5,9 +5,13 @@ (a.b or c) (a.b or (a.b or (a.b or c))) (a.b or (a.b or (a.b or c))) - (a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a) - (a.a or a.a # test + ( + a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + ) + ( + a.a or a.a # test or a.a # test or # test - a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a) + a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + ) ] diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 2722d6bd..7e213715 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -1,35 +1,59 @@ (( # test a # test -) ((c)) ((c) # e -) ((c # d -)) ((c # d -) # e -) (( # b - c)) (( # b - c) # e - ) (( # b +) ( + (c) +) ( + (c) # e +) ( + ( c # d - )) (( # b + ) +) ( + ( c # d ) # e - ) ( # a - (c)) ( # a - (c) # e - ) ( # a - (c # d - )) ( # a - (c # d - ) # e - ) ( # a - ( # b - c)) ( # a - ( # b - c) # e - ) ( # a - ( # b - c # d - )) ( # a - ( # b - c # d - ) # e - )) +) ( + ( # b + c + ) +) ( + ( # b + c + ) # e +) ( + ( # b + c # d + ) +) ( + ( # b + c # d + ) # e +) ( # a + (c) +) ( # a + (c) # e +) ( # a + ( + c # d + ) +) ( # a + ( + c # d + ) # e +) ( # a + ( # b + c + ) +) ( # a + ( # b + c + ) # e +) ( # a + ( # b + c # d + ) +) ( # a + ( # b + c # d + ) # e +)) diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 27875c1b..a2ae10d8 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -1,31 +1,40 @@ [ - ({ + ( + { foo, bar # Some comment , baz, }: - { }) - ({ + { } + ) + ( + { foo, bar # Some comment , }: - { }) - (a@{ + { } + ) + ( + a@{ self, gomod2nix, mach-nix, }: - _) - ({ + _ + ) + ( + { self, gomod2nix, mach-nix, }@inp: - _) - ({ + _ + ) + ( + { a ? [ 1 2 @@ -35,484 +44,626 @@ # ... } }: - _) + _ + ) ({ }: _) - ({ + ( + { a, }: - _) + _ + ) ({ }: _) - ({ + ( + { ... }: - _) - ({ + _ + ) + ( + { ... }: - _) - ({ + _ + ) + ( + { ... }: - _) - ({ + _ + ) + ( + { ... }: - _) + _ + ) - ({ + ( + { b, e, ... }: - _) - ({ + _ + ) + ( + { b, e, ... # h }: - _) - ({ + _ + ) + ( + { b, e, # g ... }: - _) - ({ + _ + ) + ( + { b, e, # g ... # h }: - _) - ({ + _ + ) + ( + { b, e # f , ... }: - _) - ({ + _ + ) + ( + { b, e # f , ... # h }: - _) - ({ + _ + ) + ( + { b, e # f , # g ... }: - _) - ({ + _ + ) + ( + { b, e # f , # g ... # h }: - _) - ({ + _ + ) + ( + { b, # d e, ... }: - _) - ({ + _ + ) + ( + { b, # d e, ... # h }: - _) - ({ + _ + ) + ( + { b, # d e, # g ... }: - _) - ({ + _ + ) + ( + { b, # d e, # g ... # h }: - _) - ({ + _ + ) + ( + { b, # d e # f , ... }: - _) - ({ + _ + ) + ( + { b, # d e # f , ... # h }: - _) - ({ + _ + ) + ( + { b, # d e # f , # g ... }: - _) - ({ + _ + ) + ( + { b, # d e # f , # g ... # h }: - _) - ({ + _ + ) + ( + { b # c , e, ... }: - _) - ({ + _ + ) + ( + { b # c , e, ... # h }: - _) - ({ + _ + ) + ( + { b # c , e, # g ... }: - _) - ({ + _ + ) + ( + { b # c , e, # g ... # h }: - _) - ({ + _ + ) + ( + { b # c , e # f , ... }: - _) - ({ + _ + ) + ( + { b # c , e # f , ... # h }: - _) - ({ + _ + ) + ( + { b # c , e # f , # g ... }: - _) - ({ + _ + ) + ( + { b # c , e # f , # g ... # h }: - _) - ({ + _ + ) + ( + { b # c , # d e, ... }: - _) - ({ + _ + ) + ( + { b # c , # d e, ... # h }: - _) - ({ + _ + ) + ( + { b # c , # d e, # g ... }: - _) - ({ + _ + ) + ( + { b # c , # d e, # g ... # h }: - _) - ({ + _ + ) + ( + { b # c , # d e # f , ... }: - _) - ({ + _ + ) + ( + { b # c , # d e # f , ... # h }: - _) - ({ + _ + ) + ( + { b # c , # d e # f , # g ... }: - _) - ({ + _ + ) + ( + { b # c , # d e # f , # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, e, ... }: - _) - ({ # a + _ + ) + ( + { # a b, e, ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, e, # g ... }: - _) - ({ # a + _ + ) + ( + { # a b, e, # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, e # f , ... }: - _) - ({ # a + _ + ) + ( + { # a b, e # f , ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, e # f , # g ... }: - _) - ({ # a + _ + ) + ( + { # a b, e # f , # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, # d e, ... }: - _) - ({ # a + _ + ) + ( + { # a b, # d e, ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, # d e, # g ... }: - _) - ({ # a + _ + ) + ( + { # a b, # d e, # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, # d e # f , ... }: - _) - ({ # a + _ + ) + ( + { # a b, # d e # f , ... # h }: - _) - ({ # a + _ + ) + ( + { # a b, # d e # f , # g ... }: - _) - ({ # a + _ + ) + ( + { # a b, # d e # f , # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , e, ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , e, ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , e, # g ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , e, # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , e # f , ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , e # f , ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , e # f , # g ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , e # f , # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e, ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e, ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e, # g ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e, # g ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e # f , ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e # f , ... # h }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e # f , # g ... }: - _) - ({ # a + _ + ) + ( + { # a b # c , # d e # f , # g ... # h }: - _) + _ + ) - ({ + ( + { a ? null }: - _) - ({ # a + _ + ) + ( + { # a b # a ? # a null # c @@ -523,9 +674,11 @@ , # g ... # h }: - _) + _ + ) - ({ + ( + { # a # b @@ -561,5 +714,6 @@ : # j # - _) + _ + ) ] diff --git a/test/diff/select/out.nix b/test/diff/select/out.nix index b5c6371f..945fa0ba 100644 --- a/test/diff/select/out.nix +++ b/test/diff/select/out.nix @@ -4,10 +4,14 @@ (a.a) (a.a) (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) - (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) - ({ - # multiple lines - foo = "bar"; - } - .a.b.c) + ( + a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a + ) + ( + { + # multiple lines + foo = "bar"; + } + .a.b.c + ) ] diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 0f658ee4..ce9c2cca 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -1,13 +1,19 @@ [ (with b; c) - (with b; # b - c) - (with # a - b; - c) - (with # a - b; # b - c) + ( + with b; # b + c + ) + ( + with # a + b; + c + ) + ( + with # a + b; # b + c + ) (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) { a = with b; 1; } @@ -31,18 +37,22 @@ # comment } (with a; with b; with c; { a = 1; }) - (with a; + ( + with a; with b; with c; { a = 1; b = 2; - }) - (with a; # comment + } + ) + ( + with a; # comment with b; with c; { a = 1; b = 2; - }) + } + ) { a = with b; with b; with b; 1; } { binPath = with pkgs; From 6ce18ad0ddbeab96220b81ccdce095e5d4a31dca Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 19 May 2023 16:39:49 +0200 Subject: [PATCH 028/125] Rework function calls --- src/Nixfmt/Predoc.hs | 38 +- src/Nixfmt/Pretty.hs | 44 +- test/diff/apply/in.nix | 30 + test/diff/apply/out.nix | 126 ++- test/diff/attr_set/out.nix | 16 +- test/diff/idioms_lib_2/out.nix | 9 +- test/diff/idioms_lib_3/out.nix | 105 ++- test/diff/idioms_nixos_1/out.nix | 20 +- test/diff/idioms_nixos_2/out.nix | 1314 ++++++++++++++++-------------- test/diff/idioms_pkgs_2/out.nix | 3 +- test/diff/idioms_pkgs_3/out.nix | 54 +- test/diff/monsters_5/out.nix | 6 +- test/diff/paren/out.nix | 116 +-- 13 files changed, 1061 insertions(+), 820 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 3d572f14..0f0b7eb1 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -64,11 +64,11 @@ data DocAnn -- in docs should be converted to line breaks. This does not affect softlines, -- those will be expanded only as necessary and with a lower priority. -- - -- The boolean argument determines how to handle whitespace directly before the - -- group or at the start of the group. By default (False), it gets pulled out - -- in front of the group, which is what you want in most cases. If set to True, - -- whitespace before the group will be pulled in instead. - = Group Bool + -- The boolean arguments determine how to handle whitespace directly before/after the + -- group or at the start/end of the group. By default (False), it gets pulled out the + -- group, which is what you want in most cases. If set to True, + -- whitespace before/after the group will be pulled in instead. + = Group Bool Bool -- | Node (Nest n) doc indicates all line starts in doc should be indented -- by n more spaces than the surrounding Base. | Nest Int @@ -110,12 +110,15 @@ text t = [Text t] -- | Group document elements together (see Node Group documentation) -- Any whitespace at the start of the group will get pulled out in front of it. group :: Pretty a => a -> Doc -group = pure . Node (Group False) . pretty +group = pure . Node (Group False False) . pretty -- | Group document elements together (see Node Group documentation) --- Any whitespace directly before the group will be pulled into it. -group' :: Pretty a => a -> Doc -group' = pure . Node (Group True) . pretty +-- Any whitespace directly before and/or after the group will be pulled into it. +-- Use with caution, and only in situations where you control the surroundings of +-- that group. Especially, never use as a top-level element of a `pretty` instance, +-- or you'll get some *very* confusing bugs … +group' :: Pretty a => Bool -> Bool -> a -> Doc +group' pre post = pure . Node (Group pre post) . pretty -- | @nest n doc@ sets the indentation for lines in @doc@ to @n@ more than the -- indentation of the part before it. This is based on the actual indentation of @@ -216,10 +219,13 @@ moveLinesIn :: Doc -> Doc moveLinesIn [] = [] -- Move space before Nest in moveLinesIn (Spacing l : Node (Nest level) xs : ys) = - Node (Nest level) (moveLinesIn (Spacing l : xs)) : moveLinesIn ys --- Move space before (Group True) in -moveLinesIn (Spacing l : Node (Group True) xs : ys) = - Node (Group False) (moveLinesIn (Spacing l : xs)) : moveLinesIn ys + moveLinesIn ((Node (Nest level) (Spacing l : xs)) : ys) +-- Move space before (Group True _) in +moveLinesIn (Spacing l : Node ann@(Group True _) xs : ys) = + moveLinesIn ((Node ann (Spacing l : xs)) : ys) +-- Move space after (Group _ True) in +moveLinesIn (Node ann@(Group _ True) xs : Spacing l : ys) = + moveLinesIn ((Node ann (xs ++ [Spacing l])) : ys) moveLinesIn (Node ann xs : ys) = Node ann (moveLinesIn xs) : moveLinesIn ys @@ -273,7 +279,7 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs go c (Text t : xs) = go (c - textWidth t) xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth - go c (Node (Group _) ys : xs) = + go c (Node (Group _ _) ys : xs) = case fits (c - firstLineWidth xs) ys of Nothing -> go c (ys ++ xs) Just t -> go (c - textWidth t) xs @@ -298,7 +304,7 @@ unChunk (Chunk _ doc) = doc -- Only for the tokens starting on the next line the current -- indentation will match the target indentation. layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] +layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False False) doc] where go :: Int -> Int -> [Chunk] -> [Text] go _ _ [] = [] go cc ci (Chunk ti x : xs) = case x of @@ -324,7 +330,7 @@ layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] Node (Nest l) ys -> go cc ci $ map (Chunk (ti + l)) ys ++ xs Node Base ys -> go cc ci $ map (Chunk ci) ys ++ xs - Node (Group _) ys -> + Node (Group _ _) ys -> -- Does the group (plus whatever comes after it on that line) fit in one line? -- This is where treating whitespace as "compact" happens case fits (tw - cc - firstLineWidth (map unChunk xs)) ys of diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 5b766223..d3f711e5 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -8,6 +8,7 @@ module Nixfmt.Pretty where +import Debug.Trace import Prelude hiding (String) import Data.Char (isSpace) @@ -79,7 +80,7 @@ instance Pretty Binder where -- `inherit (foo) bar` statement pretty (Inherit inherit source ids semicolon) = base $ group (pretty inherit <> hardspace <> nest 2 ( - (group' (line <> pretty source)) <> line + (group' True False (line <> pretty source)) <> line <> sepBy line ids <> line' <> pretty semicolon )) @@ -95,7 +96,7 @@ instance Pretty Binder where (Term t) | isAbsorbable t -> hardspace <> group expr <> pretty semicolon -- Non-absorbable term -- If it is multi-line, force it to start on a new line with indentation - (Term _) -> group' (line <> pretty expr) <> pretty semicolon + (Term _) -> group' True False (line <> pretty expr) <> pretty semicolon -- Function calls and with expressions -- Try to absorb and keep the semicolon attached, spread otherwise (Application _ _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) @@ -243,11 +244,6 @@ absorbElse (If if_ cond then_ expr0 else_ expr1) absorbElse x = hardline <> nest 2 (group x) -absorbApp :: Expression -> Doc -absorbApp (Application f x) = softline <> pretty f <> absorbApp x -absorbApp (Term t) | isAbsorbable t = hardspace <> group (prettyTerm t) -absorbApp x = softline <> pretty x - instance Pretty Expression where pretty (Term t) = pretty t @@ -288,25 +284,51 @@ instance Pretty Expression where pretty (Abstraction param colon body) = pretty param <> pretty colon <> absorbSet body - pretty (Application f x) = group $ pretty f <> absorbApp x + -- Function application + -- Some example mapping of Nix code to Doc (using parentheses as groups, but omitting the outermost group + -- and groups around the expressions for conciseness): + -- `f a` -> (f line*) a + -- `f g a` -> (f line g line*) a + -- `f g h a` -> ((f line g) line h line*) a + -- `f g h i a` -> (((f line g) line h) line i line*) a + -- As you can see, it separates the elements by `line` whitespace. However, there are two tricks to make it look good: + -- Firstly, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion + -- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining + -- ones on a separate line each. + -- Secondly, the `line` between the second-to-last and last argument (marked with asterisk above) is moved into its preceding + -- group. This allows the last argument to be multi-line without forcing the preceding arguments to be multiline. + pretty (Application f a) + = let + absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (group a') + absorbApp expr = pretty expr + + absorbLast (Term t) | isAbsorbable t + = prettyTerm t + absorbLast (Term (Parenthesized open expr close)) + = base $ group $ pretty open <> line' <> nest 2 (group expr) <> line' <> pretty close + absorbLast arg = group arg + in + group $ + (group' False True $ (absorbApp f) <> line) <> (absorbLast a) -- '//' operator - pretty operation@(Operation a op@(Ann TUpdate _ _) b) + pretty (Operation a op@(Ann TUpdate _ _) b) = pretty a <> softline <> pretty op <> hardspace <> pretty b -- all other operators pretty operation@(Operation _ op _) = let -- Walk the operation tree and put a list of things on the same level + flatten :: Expression -> [Expression] flatten (Operation a op' b) | op' == op = (flatten a) ++ (flatten b) flatten x = [x] - flattened = flatten operation -- Some children need nesting + absorbOperation :: Expression -> Doc absorbOperation (Term t) | isAbsorbable t = pretty t absorbOperation x@(Operation _ _ _) = nest 2 (pretty x) absorbOperation x = base $ nest 2 (pretty x) in - group $ sepBy (line <> pretty op <> hardspace) (map absorbOperation flattened) + group $ (sepBy (line <> pretty op <> hardspace) . map absorbOperation . flatten) operation pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index 26cc0f98..ad893f5d 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -49,11 +49,13 @@ name2 = function arg { asdf = 1; + # multiline } argument; name3 = function arg { asdf = 1; + # multiline } { qwer = 12345; } @@ -97,4 +99,32 @@ # For each supported platform, utils.lib.eachDefaultSystem (system: {}); } + { + escapeSingleline = libStr.escape [ + "\\" + ''"'' + "\${" + ]; + escapeMultiline = + libStr.replaceStrings + [ + "\${" + "''" + ] + [ + "''\${" + "'''" + ]; + test = foo + [ # multiline + 1 2 3 + ] + [] + {} + [] + [ 1 2 3 # multiline + ]; + looooooooong = (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } sections); + looooooooong' = toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } sections; + } ] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 91bcd32b..2747da1e 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -1,22 +1,32 @@ [ (a b) - ((a b) (a b) (a # b - c) ( # a + ((a b) (a b) + (a # b + c) + ( # a b # c d # e )) '' otherModules=${ - pkgs.writeText "other-modules.json" (l.toJSON (l.mapAttrs ( - pname: subOutputs: - let - pkg = subOutputs.packages."${pname}".overrideAttrs (old: { - buildScript = "true"; - installMethod = "copy"; - }); - in - "${pkg}/lib/node_modules/${pname}/node_modules" - ) outputs.subPackages)) + pkgs.writeText "other-modules.json" ( + l.toJSON ( + l.mapAttrs + ( + pname: subOutputs: + let + pkg = subOutputs.packages."${pname}".overrideAttrs ( + old: { + buildScript = "true"; + installMethod = "copy"; + } + ); + in + "${pkg}/lib/node_modules/${pname}/node_modules" + ) + outputs.subPackages + ) + ) } '' { @@ -29,31 +39,50 @@ { name1 = function arg { asdf = 1; }; - name2 = function arg { asdf = 1; } argument; + name2 = function arg + { + asdf = 1; + # multiline + } + argument; - name3 = function arg { asdf = 1; } { qwer = 12345; } argument; + name3 = function arg + { + asdf = 1; + # multiline + } + { qwer = 12345; } + argument; } { - name4 = function arg { asdf = 1; } { - qwer = 12345; - qwer2 = 54321; - } argument; + name4 = function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + argument; } { - option1 = function arg { asdf = 1; } { - qwer = 12345; - qwer2 = 54321; - } lastArg; + option1 = function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + lastArg; - option2 = function arg { asdf = 1; } { - qwer = 12345; - qwer2 = 54321; - } lastArg; + option2 = function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + lastArg; - option3 = function arg { asdf = 1; } { - qwer = 12345; - qwer2 = 54321; - } lastArg; + option3 = function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + lastArg; } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { @@ -65,4 +94,41 @@ utils.lib.eachDefaultSystem (system: { }) ; } + { + escapeSingleline = libStr.escape [ + "\\" + ''"'' + "\${" + ]; + escapeMultiline = libStr.replaceStrings + [ + "\${" + "''" + ] + [ + "''\${" + "'''" + ]; + test = foo + [ # multiline + 1 + 2 + 3 + ] + [ ] + { } + [ ] + [ + 1 + 2 + 3 # multiline + ]; + looooooooong = + (toINI + { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + sections); + looooooooong' = toINI + { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + sections; + } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index f1ed1c9f..61daf73e 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -93,13 +93,15 @@ # multiline } .${x}; - z = functionCall { - # multi - #line - } [ - # several - items - ]; + z = functionCall + { + # multi + #line + } + [ + # several + items + ]; a = [ some diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index f725180b..f31505f0 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -265,7 +265,8 @@ rec { ; nixpkgsVersion = builtins.trace - "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version; + "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" + version; /* Determine whether the function is being called from inside a Nix shell. @@ -418,8 +419,10 @@ rec { ] then msg: - builtins.trace "warning: ${msg}" (abort - "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors.") + builtins.trace "warning: ${msg}" ( + abort + "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors." + ) else msg: builtins.trace "warning: ${msg}" ; diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index c5c465e6..5ad4e7ec 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -119,8 +119,9 @@ rec { ; in attrs: - libStr.concatStrings - (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) + libStr.concatStrings ( + lib.concatLists (libAttr.mapAttrsToList mkLines attrs) + ) ; # Generate an INI-style config file from an @@ -147,10 +148,12 @@ rec { # apply transformations (e.g. escapes) to section names mkSectionName ? ( name: - libStr.escape [ + libStr.escape + [ "[" "]" - ] name + ] + name ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", @@ -211,10 +214,12 @@ rec { # apply transformations (e.g. escapes) to section names mkSectionName ? ( name: - libStr.escape [ + libStr.escape + [ "[" "]" - ] name + ] + name ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", @@ -232,7 +237,8 @@ rec { (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" ) - + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } + + (toINI + { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections) ; @@ -287,7 +293,8 @@ rec { recurse = path: value: if isAttrs value && !lib.isDerivation value then - lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) + lib.mapAttrsToList + (name: value: recurse ([ name ] ++ path) value) value else if length path > 1 then { @@ -427,13 +434,15 @@ rec { ''"'' "\${" ]; - escapeMultiline = libStr.replaceStrings [ - "\${" - "''" - ] [ - "''\${" - "'''" - ]; + escapeMultiline = libStr.replaceStrings + [ + "\${" + "''" + ] + [ + "''\${" + "'''" + ]; singlelineResult = ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) @@ -482,13 +491,17 @@ rec { else if isFunction v then let fna = lib.functionArgs v; - showFnas = concatStringsSep ", " (libAttr.mapAttrsToList ( - name: hasDefVal: - if hasDefVal then - name + "?" - else - name - ) fna); + showFnas = concatStringsSep ", " ( + libAttr.mapAttrsToList + ( + name: hasDefVal: + if hasDefVal then + name + "?" + else + name + ) + fna + ); in if fna == { } then "" @@ -507,14 +520,18 @@ rec { else "{" + introSpace - + libStr.concatStringsSep introSpace (libAttr.mapAttrsToList ( - name: value: - "${libStr.escapeNixIdentifier name} = ${ - builtins.addErrorContext - "while evaluating an attribute `${name}`" - (go (indent + " ") value) - };" - ) v) + + libStr.concatStringsSep introSpace ( + libAttr.mapAttrsToList + ( + name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext + "while evaluating an attribute `${name}`" + (go (indent + " ") value) + };" + ) + v + ) + outroSpace + "}" else @@ -594,13 +611,19 @@ rec { attrFilter = name: value: name != "_module" && value != null; in ind: x: - libStr.concatStringsSep "\n" (lib.flatten (lib.mapAttrsToList ( - name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ] - ) x)) + libStr.concatStringsSep "\n" ( + lib.flatten ( + lib.mapAttrsToList + ( + name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ] + ) + x + ) + ) ; in @@ -624,9 +647,11 @@ rec { in if isAttrs v then "{ ${ - concatItems (lib.attrsets.mapAttrsToList ( - key: value: "${key} = ${toDhall args value}" - ) v) + concatItems ( + lib.attrsets.mapAttrsToList + (key: value: "${key} = ${toDhall args value}") + v + ) } }" else if isList v then "[ ${concatItems (map (toDhall args) v)} ]" diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 310d665c..655fe1a4 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -44,12 +44,14 @@ in kernelPackages: kernelPackages.extend ( self: super: { - kernel = super.kernel.override (originalArgs: { - inherit randstructSeed; - kernelPatches = - (originalArgs.kernelPatches or [ ]) ++ kernelPatches; - features = lib.recursiveUpdate super.kernel.features features; - }); + kernel = super.kernel.override ( + originalArgs: { + inherit randstructSeed; + kernelPatches = + (originalArgs.kernelPatches or [ ]) ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + } + ); } ) ; @@ -388,10 +390,12 @@ in let cfg = config.boot.kernelPackages.kernel.config; in - map (attrs: { + map + (attrs: { assertion = attrs.assertion cfg; inherit (attrs) message; - }) config.system.requiredKernelConfig + }) + config.system.requiredKernelConfig ; }) diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 1092e579..75a0ad20 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -75,46 +75,54 @@ in { imports = [ - (mkRemovedOptionModule [ - "services" - "nextcloud" - "config" - "adminpass" - ] '' - Please use `services.nextcloud.config.adminpassFile' instead! - '') - (mkRemovedOptionModule [ - "services" - "nextcloud" - "config" - "dbpass" - ] '' - Please use `services.nextcloud.config.dbpassFile' instead! - '') - (mkRemovedOptionModule [ - "services" - "nextcloud" - "nginx" - "enable" - ] '' - The nextcloud module supports `nginx` as reverse-proxy by default and doesn't - support other reverse-proxies officially. - - However it's possible to use an alternative reverse-proxy by - - * disabling nginx - * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value - - Further details about this can be found in the `Nextcloud`-section of the NixOS-manual - (which can be opened e.g. by running `nixos-help`). - '') - (mkRemovedOptionModule [ - "services" - "nextcloud" - "disableImagemagick" - ] '' - Use services.nextcloud.enableImagemagick instead. - '') + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "config" + "adminpass" + ] + '' + Please use `services.nextcloud.config.adminpassFile' instead! + '') + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "config" + "dbpass" + ] + '' + Please use `services.nextcloud.config.dbpassFile' instead! + '') + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "nginx" + "enable" + ] + '' + The nextcloud module supports `nginx` as reverse-proxy by default and doesn't + support other reverse-proxies officially. + + However it's possible to use an alternative reverse-proxy by + + * disabling nginx + * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value + + Further details about this can be found in the `Nextcloud`-section of the NixOS-manual + (which can be opened e.g. by running `nixos-help`). + '') + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "disableImagemagick" + ] + '' + Use services.nextcloud.enableImagemagick instead. + '') ]; options.services.nextcloud = { @@ -330,11 +338,13 @@ in poolSettings = mkOption { type = with types; - attrsOf (oneOf [ - str - int - bool - ]); + attrsOf ( + oneOf [ + str + int + bool + ] + ); default = { "pm" = "dynamic"; "pm.max_children" = "32"; @@ -460,10 +470,12 @@ in }; overwriteProtocol = mkOption { - type = types.nullOr (types.enum [ - "http" - "https" - ]); + type = types.nullOr ( + types.enum [ + "http" + "https" + ] + ); default = null; example = "https"; @@ -495,15 +507,17 @@ in objectstore = { s3 = { - enable = mkEnableOption (lib.mdDoc '' - S3 object storage as primary storage. + enable = mkEnableOption ( + lib.mdDoc '' + S3 object storage as primary storage. - This mounts a bucket on an Amazon S3 object storage or compatible - implementation into the virtual filesystem. + This mounts a bucket on an Amazon S3 object storage or compatible + implementation into the virtual filesystem. - Further details about this feature can be found in the - [upstream documentation](https://docs.nextcloud.com/server/22/admin_manual/configuration_files/primary_storage.html). - ''); + Further details about this feature can be found in the + [upstream documentation](https://docs.nextcloud.com/server/22/admin_manual/configuration_files/primary_storage.html). + '' + ); bucket = mkOption { type = types.str; example = "nextcloud"; @@ -599,13 +613,15 @@ in }; }; - enableImagemagick = mkEnableOption (lib.mdDoc '' - the ImageMagick module for PHP. - This is used by the theming app and for generating previews of certain images (e.g. SVG and HEIF). - You may want to disable it for increased security. In that case, previews will still be available - for some images (e.g. JPEG and PNG). - See . - '') // { + enableImagemagick = mkEnableOption ( + lib.mdDoc '' + the ImageMagick module for PHP. + This is used by the theming app and for generating previews of certain images (e.g. SVG and HEIF). + You may want to disable it for increased security. In that case, previews will still be available + for some images (e.g. JPEG and PNG). + See . + '' + ) // { default = true; }; @@ -733,614 +749,652 @@ in }; }; - config = mkIf cfg.enable (mkMerge [ - { - warnings = - let - latest = 26; - upgradeWarning = - major: nixos: '' - A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. - - After nextcloud${ - toString major - } is installed successfully, you can safely upgrade - to ${ - toString (major + 1) - }. The latest version available is nextcloud${toString latest}. - - Please note that Nextcloud doesn't support upgrades across multiple major versions - (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). - - The package can be upgraded by explicitly declaring the service-option - `services.nextcloud.package`. - '' - ; - - in - (optional (cfg.poolConfig != null) '' - Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. - Please migrate your configuration to config.services.nextcloud.poolSettings. - '') - ++ (optional (versionOlder cfg.package.version "23") - (upgradeWarning 22 "22.05")) - ++ (optional (versionOlder cfg.package.version "24") - (upgradeWarning 23 "22.05")) - ++ (optional (versionOlder cfg.package.version "25") - (upgradeWarning 24 "22.11")) - ++ (optional (versionOlder cfg.package.version "26") - (upgradeWarning 25 "23.05")) - ++ (optional cfg.enableBrokenCiphersForSSE '' - You're using PHP's openssl extension built against OpenSSL 1.1 for Nextcloud. - This is only necessary if you're using Nextcloud's server-side encryption. - Please keep in mind that it's using the broken RC4 cipher. - - If you don't use that feature, you can switch to OpenSSL 3 and get - rid of this warning by declaring - - services.nextcloud.enableBrokenCiphersForSSE = false; - - If you need to use server-side encryption you can ignore this warning. - Otherwise you'd have to disable server-side encryption first in order - to be able to safely disable this option and get rid of this warning. - See on how to achieve this. - - For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 - '') - ; - - services.nextcloud.package = with pkgs; - mkDefault ( - if pkgs ? nextcloud then - throw '' - The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default - nextcloud defined in an overlay, please set `services.nextcloud.package` to - `pkgs.nextcloud`. - '' - else if versionOlder stateVersion "22.11" then - nextcloud24 - else if versionOlder stateVersion "23.05" then - nextcloud25 - else - nextcloud26 - ); - - services.nextcloud.phpPackage = - if versionOlder cfg.package.version "26" then - pkgs.php81 - else - pkgs.php82 - ; - } - - { - assertions = [ { - assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; - message = - "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; - } ]; - } - - { - systemd.timers.nextcloud-cron = { - wantedBy = [ "timers.target" ]; - after = [ "nextcloud-setup.service" ]; - timerConfig.OnBootSec = "5m"; - timerConfig.OnUnitActiveSec = "5m"; - timerConfig.Unit = "nextcloud-cron.service"; - }; - - systemd.tmpfiles.rules = [ "d ${cfg.home} 0750 nextcloud nextcloud" ]; - - systemd.services = { - # When upgrading the Nextcloud package, Nextcloud can report errors such as - # "The files of the app [all apps in /var/lib/nextcloud/apps] were not replaced correctly" - # Restarting phpfpm on Nextcloud package update fixes these issues (but this is a workaround). - phpfpm-nextcloud.restartTriggers = [ cfg.package ]; - - nextcloud-setup = + config = mkIf cfg.enable ( + mkMerge [ + { + warnings = let - c = cfg.config; - writePhpArray = - a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]"; - requiresReadSecretFunction = - c.dbpassFile != null || c.objectstore.s3.enable; - objectstoreConfig = - let - s3 = c.objectstore.s3; - in - optionalString s3.enable '' - 'objectstore' => [ - 'class' => '\\OC\\Files\\ObjectStore\\S3', - 'arguments' => [ - 'bucket' => '${s3.bucket}', - 'autocreate' => ${boolToString s3.autocreate}, - 'key' => '${s3.key}', - 'secret' => nix_read_secret('${s3.secretFile}'), - ${ - optionalString (s3.hostname != null) - "'hostname' => '${s3.hostname}'," - } - ${ - optionalString (s3.port != null) - "'port' => ${toString s3.port}," - } - 'use_ssl' => ${boolToString s3.useSsl}, - ${ - optionalString (s3.region != null) - "'region' => '${s3.region}'," - } - 'use_path_style' => ${boolToString s3.usePathStyle}, - ${ - optionalString (s3.sseCKeyFile != null) - "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," - } - ], - ] + latest = 26; + upgradeWarning = + major: nixos: '' + A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. + + After nextcloud${ + toString major + } is installed successfully, you can safely upgrade + to ${ + toString (major + 1) + }. The latest version available is nextcloud${toString latest}. + + Please note that Nextcloud doesn't support upgrades across multiple major versions + (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). + + The package can be upgraded by explicitly declaring the service-option + `services.nextcloud.package`. '' ; - showAppStoreSetting = - cfg.appstoreEnable != null || cfg.extraApps != { }; - renderedAppStoreSetting = - let - x = cfg.appstoreEnable; - in - if x == null then - "false" - else - boolToString x - ; + in + (optional (cfg.poolConfig != null) '' + Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. + Please migrate your configuration to config.services.nextcloud.poolSettings. + '') + ++ (optional (versionOlder cfg.package.version "23") ( + upgradeWarning 22 "22.05" + )) + ++ (optional (versionOlder cfg.package.version "24") ( + upgradeWarning 23 "22.05" + )) + ++ (optional (versionOlder cfg.package.version "25") ( + upgradeWarning 24 "22.11" + )) + ++ (optional (versionOlder cfg.package.version "26") ( + upgradeWarning 25 "23.05" + )) + ++ (optional cfg.enableBrokenCiphersForSSE '' + You're using PHP's openssl extension built against OpenSSL 1.1 for Nextcloud. + This is only necessary if you're using Nextcloud's server-side encryption. + Please keep in mind that it's using the broken RC4 cipher. + + If you don't use that feature, you can switch to OpenSSL 3 and get + rid of this warning by declaring + + services.nextcloud.enableBrokenCiphersForSSE = false; + + If you need to use server-side encryption you can ignore this warning. + Otherwise you'd have to disable server-side encryption first in order + to be able to safely disable this option and get rid of this warning. + See on how to achieve this. + + For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 + '') + ; + + services.nextcloud.package = with pkgs; + mkDefault ( + if pkgs ? nextcloud then + throw '' + The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default + nextcloud defined in an overlay, please set `services.nextcloud.package` to + `pkgs.nextcloud`. + '' + else if versionOlder stateVersion "22.11" then + nextcloud24 + else if versionOlder stateVersion "23.05" then + nextcloud25 + else + nextcloud26 + ); + + services.nextcloud.phpPackage = + if versionOlder cfg.package.version "26" then + pkgs.php81 + else + pkgs.php82 + ; + } - nextcloudGreaterOrEqualThan = - req: versionAtLeast cfg.package.version req; + { + assertions = [ { + assertion = + cfg.database.createLocally -> cfg.config.dbtype == "mysql"; + message = + "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; + } ]; + } + + { + systemd.timers.nextcloud-cron = { + wantedBy = [ "timers.target" ]; + after = [ "nextcloud-setup.service" ]; + timerConfig.OnBootSec = "5m"; + timerConfig.OnUnitActiveSec = "5m"; + timerConfig.Unit = "nextcloud-cron.service"; + }; - overrideConfig = pkgs.writeText "nextcloud-config.php" '' - [ + 'class' => '\\OC\\Files\\ObjectStore\\S3', + 'arguments' => [ + 'bucket' => '${s3.bucket}', + 'autocreate' => ${boolToString s3.autocreate}, + 'key' => '${s3.key}', + 'secret' => nix_read_secret('${s3.secretFile}'), + ${ + optionalString + (s3.hostname != null) + "'hostname' => '${s3.hostname}'," + } + ${ + optionalString (s3.port != null) "'port' => ${ + toString s3.port + }," + } + 'use_ssl' => ${boolToString s3.useSsl}, + ${ + optionalString + (s3.region != null) + "'region' => '${s3.region}'," + } + 'use_path_style' => ${boolToString s3.usePathStyle}, + ${ + optionalString + (s3.sseCKeyFile != null) + "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," + } + ], + ] + '' + ; + + showAppStoreSetting = + cfg.appstoreEnable != null || cfg.extraApps != { }; + renderedAppStoreSetting = + let + x = cfg.appstoreEnable; + in + if x == null then + "false" + else + boolToString x + ; + + nextcloudGreaterOrEqualThan = + req: versionAtLeast cfg.package.version req; + + overrideConfig = pkgs.writeText "nextcloud-config.php" '' + [ + return $decoded; + } + $CONFIG = [ + 'apps_paths' => [ + ${ + optionalString + (cfg.extraApps != { }) + "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," + } + [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], + [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], + ], ${ - optionalString (cfg.extraApps != { }) - "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," + optionalString + (showAppStoreSetting) + "'appstoreenabled' => ${renderedAppStoreSetting}," } - [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], - [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], - ], - ${ - optionalString (showAppStoreSetting) - "'appstoreenabled' => ${renderedAppStoreSetting}," - } - 'datadirectory' => '${datadir}/data', - 'skeletondirectory' => '${cfg.skeletonDirectory}', - ${ - optionalString cfg.caching.apcu - "'memcache.local' => '\\OC\\Memcache\\APCu'," - } - 'log_type' => '${cfg.logType}', - 'loglevel' => '${builtins.toString cfg.logLevel}', - ${ - optionalString (c.overwriteProtocol != null) - "'overwriteprotocol' => '${c.overwriteProtocol}'," - } - ${ - optionalString (c.dbname != null) "'dbname' => '${c.dbname}'," - } - ${ - optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}'," - } - ${ - optionalString (c.dbport != null) - "'dbport' => '${toString c.dbport}'," - } - ${ - optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}'," - } - ${ - optionalString (c.dbtableprefix != null) - "'dbtableprefix' => '${toString c.dbtableprefix}'," - } - ${ - optionalString (c.dbpassFile != null) '' - 'dbpassword' => nix_read_secret( - "${c.dbpassFile}" - ), - '' - } - 'dbtype' => '${c.dbtype}', - 'trusted_domains' => ${ - writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) - }, - 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, - ${ - optionalString (c.defaultPhoneRegion != null) - "'default_phone_region' => '${c.defaultPhoneRegion}'," - } - ${ - optionalString (nextcloudGreaterOrEqualThan "23") - "'profile.enabled' => ${boolToString cfg.globalProfiles}," - } - ${objectstoreConfig} - ]; - - $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( - "${ - jsonFormat.generate "nextcloud-extraOptions.json" - cfg.extraOptions - }", - "impossible: this should never happen (decoding generated extraOptions file %s failed)" - )); - - ${optionalString (cfg.secretFile != null) '' + 'datadirectory' => '${datadir}/data', + 'skeletondirectory' => '${cfg.skeletonDirectory}', + ${ + optionalString + cfg.caching.apcu + "'memcache.local' => '\\OC\\Memcache\\APCu'," + } + 'log_type' => '${cfg.logType}', + 'loglevel' => '${builtins.toString cfg.logLevel}', + ${ + optionalString + (c.overwriteProtocol != null) + "'overwriteprotocol' => '${c.overwriteProtocol}'," + } + ${ + optionalString + (c.dbname != null) + "'dbname' => '${c.dbname}'," + } + ${ + optionalString + (c.dbhost != null) + "'dbhost' => '${c.dbhost}'," + } + ${ + optionalString (c.dbport != null) "'dbport' => '${ + toString c.dbport + }'," + } + ${ + optionalString + (c.dbuser != null) + "'dbuser' => '${c.dbuser}'," + } + ${ + optionalString + (c.dbtableprefix != null) + "'dbtableprefix' => '${toString c.dbtableprefix}'," + } + ${ + optionalString (c.dbpassFile != null) '' + 'dbpassword' => nix_read_secret( + "${c.dbpassFile}" + ), + '' + } + 'dbtype' => '${c.dbtype}', + 'trusted_domains' => ${ + writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) + }, + 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, + ${ + optionalString + (c.defaultPhoneRegion != null) + "'default_phone_region' => '${c.defaultPhoneRegion}'," + } + ${ + optionalString + (nextcloudGreaterOrEqualThan "23") + "'profile.enabled' => ${boolToString cfg.globalProfiles}," + } + ${objectstoreConfig} + ]; + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( - "${cfg.secretFile}", - "Cannot start Nextcloud, secrets file %s set by NixOS doesn't exist!" + "${ + jsonFormat.generate + "nextcloud-extraOptions.json" + cfg.extraOptions + }", + "impossible: this should never happen (decoding generated extraOptions file %s failed)" )); - ''} - ''; - occInstallCmd = - let - mkExport = - { - arg, - value, - }: - "export ${arg}=${value}" - ; - dbpass = { - arg = "DBPASS"; - value = - if c.dbpassFile != null then - ''"$(<"${toString c.dbpassFile}")"'' - else - ''""'' + + ${optionalString (cfg.secretFile != null) '' + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( + "${cfg.secretFile}", + "Cannot start Nextcloud, secrets file %s set by NixOS doesn't exist!" + )); + ''} + ''; + occInstallCmd = + let + mkExport = + { + arg, + value, + }: + "export ${arg}=${value}" ; - }; - adminpass = { - arg = "ADMINPASS"; - value = ''"$(<"${toString c.adminpassFile}")"''; - }; - installFlags = concatStringsSep " \\\n " - (mapAttrsToList (k: v: "${k} ${toString v}") { - "--database" = ''"${c.dbtype}"''; - # The following attributes are optional depending on the type of - # database. Those that evaluate to null on the left hand side - # will be omitted. - ${ - if c.dbname != null then - "--database-name" + dbpass = { + arg = "DBPASS"; + value = + if c.dbpassFile != null then + ''"$(<"${toString c.dbpassFile}")"'' else - null - } = ''"${c.dbname}"''; - ${ - if c.dbhost != null then - "--database-host" - else - null - } = ''"${c.dbhost}"''; - ${ - if c.dbport != null then - "--database-port" - else - null - } = ''"${toString c.dbport}"''; - ${ - if c.dbuser != null then - "--database-user" - else - null - } = ''"${c.dbuser}"''; - "--database-pass" = ''"''$${dbpass.arg}"''; - "--admin-user" = ''"${c.adminuser}"''; - "--admin-pass" = ''"''$${adminpass.arg}"''; - "--data-dir" = ''"${datadir}/data"''; - }); - in - '' - ${mkExport dbpass} - ${mkExport adminpass} - ${occ}/bin/nextcloud-occ maintenance:install \ - ${installFlags} - '' - ; - occSetTrustedDomainsCmd = concatStringsSep "\n" (imap0 ( - i: v: '' - ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ - ${toString i} --value="${toString v}" - '' - ) ( - [ cfg.hostName ] ++ cfg.config.extraTrustedDomains - )); - - in - { - wantedBy = [ "multi-user.target" ]; - before = [ "phpfpm-nextcloud.service" ]; - path = [ occ ]; - script = '' - ${optionalString (c.dbpassFile != null) '' - if [ ! -r "${c.dbpassFile}" ]; then - echo "dbpassFile ${c.dbpassFile} is not readable by nextcloud:nextcloud! Aborting..." + ''""'' + ; + }; + adminpass = { + arg = "ADMINPASS"; + value = ''"$(<"${toString c.adminpassFile}")"''; + }; + installFlags = concatStringsSep " \\\n " ( + mapAttrsToList (k: v: "${k} ${toString v}") { + "--database" = ''"${c.dbtype}"''; + # The following attributes are optional depending on the type of + # database. Those that evaluate to null on the left hand side + # will be omitted. + ${ + if c.dbname != null then + "--database-name" + else + null + } = ''"${c.dbname}"''; + ${ + if c.dbhost != null then + "--database-host" + else + null + } = ''"${c.dbhost}"''; + ${ + if c.dbport != null then + "--database-port" + else + null + } = ''"${toString c.dbport}"''; + ${ + if c.dbuser != null then + "--database-user" + else + null + } = ''"${c.dbuser}"''; + "--database-pass" = ''"''$${dbpass.arg}"''; + "--admin-user" = ''"${c.adminuser}"''; + "--admin-pass" = ''"''$${adminpass.arg}"''; + "--data-dir" = ''"${datadir}/data"''; + } + ); + in + '' + ${mkExport dbpass} + ${mkExport adminpass} + ${occ}/bin/nextcloud-occ maintenance:install \ + ${installFlags} + '' + ; + occSetTrustedDomainsCmd = concatStringsSep "\n" ( + imap0 + ( + i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '' + ) + ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) + ); + + in + { + wantedBy = [ "multi-user.target" ]; + before = [ "phpfpm-nextcloud.service" ]; + path = [ occ ]; + script = '' + ${optionalString (c.dbpassFile != null) '' + if [ ! -r "${c.dbpassFile}" ]; then + echo "dbpassFile ${c.dbpassFile} is not readable by nextcloud:nextcloud! Aborting..." + exit 1 + fi + if [ -z "$(<${c.dbpassFile})" ]; then + echo "dbpassFile ${c.dbpassFile} is empty!" + exit 1 + fi + ''} + if [ ! -r "${c.adminpassFile}" ]; then + echo "adminpassFile ${c.adminpassFile} is not readable by nextcloud:nextcloud! Aborting..." exit 1 fi - if [ -z "$(<${c.dbpassFile})" ]; then - echo "dbpassFile ${c.dbpassFile} is empty!" + if [ -z "$(<${c.adminpassFile})" ]; then + echo "adminpassFile ${c.adminpassFile} is empty!" exit 1 fi - ''} - if [ ! -r "${c.adminpassFile}" ]; then - echo "adminpassFile ${c.adminpassFile} is not readable by nextcloud:nextcloud! Aborting..." - exit 1 - fi - if [ -z "$(<${c.adminpassFile})" ]; then - echo "adminpassFile ${c.adminpassFile} is empty!" - exit 1 - fi - - ln -sf ${cfg.package}/apps ${cfg.home}/ - - # Install extra apps - ln -sfT \ - ${ - pkgs.linkFarm "nix-apps" - (mapAttrsToList (name: path: { inherit name path; }) - cfg.extraApps) - } \ - ${cfg.home}/nix-apps - - # create nextcloud directories. - # if the directories exist already with wrong permissions, we fix that - for dir in ${datadir}/config ${datadir}/data ${cfg.home}/store-apps ${cfg.home}/nix-apps; do - if [ ! -e $dir ]; then - install -o nextcloud -g nextcloud -d $dir - elif [ $(stat -c "%G" $dir) != "nextcloud" ]; then - chgrp -R nextcloud $dir - fi - done - ln -sf ${overrideConfig} ${datadir}/config/override.config.php + ln -sf ${cfg.package}/apps ${cfg.home}/ - # Do not install if already installed - if [[ ! -e ${datadir}/config/config.php ]]; then - ${occInstallCmd} - fi + # Install extra apps + ln -sfT \ + ${ + pkgs.linkFarm "nix-apps" ( + mapAttrsToList + (name: path: { inherit name path; }) + cfg.extraApps + ) + } \ + ${cfg.home}/nix-apps + + # create nextcloud directories. + # if the directories exist already with wrong permissions, we fix that + for dir in ${datadir}/config ${datadir}/data ${cfg.home}/store-apps ${cfg.home}/nix-apps; do + if [ ! -e $dir ]; then + install -o nextcloud -g nextcloud -d $dir + elif [ $(stat -c "%G" $dir) != "nextcloud" ]; then + chgrp -R nextcloud $dir + fi + done + + ln -sf ${overrideConfig} ${datadir}/config/override.config.php + + # Do not install if already installed + if [[ ! -e ${datadir}/config/config.php ]]; then + ${occInstallCmd} + fi - ${occ}/bin/nextcloud-occ upgrade + ${occ}/bin/nextcloud-occ upgrade - ${occ}/bin/nextcloud-occ config:system:delete trusted_domains + ${occ}/bin/nextcloud-occ config:system:delete trusted_domains - ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' - # Try to enable apps - ${occ}/bin/nextcloud-occ app:enable ${ - concatStringsSep " " (attrNames cfg.extraApps) - } - ''} - - ${occSetTrustedDomainsCmd} - ''; + ${optionalString + (cfg.extraAppsEnable && cfg.extraApps != { }) + '' + # Try to enable apps + ${occ}/bin/nextcloud-occ app:enable ${ + concatStringsSep " " (attrNames cfg.extraApps) + } + ''} + + ${occSetTrustedDomainsCmd} + ''; + serviceConfig.Type = "oneshot"; + serviceConfig.User = "nextcloud"; + # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent + # an automatic creation of the database user. + environment.NC_setup_create_db_user = + lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; + } + ; + nextcloud-cron = { + after = [ "nextcloud-setup.service" ]; + environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; serviceConfig.Type = "oneshot"; serviceConfig.User = "nextcloud"; - # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent - # an automatic creation of the database user. - environment.NC_setup_create_db_user = - lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; - } - ; - nextcloud-cron = { - after = [ "nextcloud-setup.service" ]; - environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; - serviceConfig.Type = "oneshot"; - serviceConfig.User = "nextcloud"; - serviceConfig.ExecStart = - "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; - }; - nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { - after = [ "nextcloud-setup.service" ]; - serviceConfig.Type = "oneshot"; - serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; - serviceConfig.User = "nextcloud"; - startAt = cfg.autoUpdateApps.startAt; + serviceConfig.ExecStart = + "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; + }; + nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { + after = [ "nextcloud-setup.service" ]; + serviceConfig.Type = "oneshot"; + serviceConfig.ExecStart = + "${occ}/bin/nextcloud-occ app:update --all"; + serviceConfig.User = "nextcloud"; + startAt = cfg.autoUpdateApps.startAt; + }; }; - }; - services.phpfpm = { - pools.nextcloud = { - user = "nextcloud"; - group = "nextcloud"; - phpPackage = phpPackage; - phpEnv = { - NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; - PATH = - "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; + services.phpfpm = { + pools.nextcloud = { + user = "nextcloud"; + group = "nextcloud"; + phpPackage = phpPackage; + phpEnv = { + NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + PATH = + "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; + }; + settings = mapAttrs (name: mkDefault) { + "listen.owner" = config.services.nginx.user; + "listen.group" = config.services.nginx.group; + } // cfg.poolSettings; + extraConfig = cfg.poolConfig; }; - settings = mapAttrs (name: mkDefault) { - "listen.owner" = config.services.nginx.user; - "listen.group" = config.services.nginx.group; - } // cfg.poolSettings; - extraConfig = cfg.poolConfig; }; - }; - - users.users.nextcloud = { - home = "${cfg.home}"; - group = "nextcloud"; - isSystemUser = true; - }; - users.groups.nextcloud.members = [ - "nextcloud" - config.services.nginx.user - ]; - environment.systemPackages = [ occ ]; - - services.mysql = lib.mkIf cfg.database.createLocally { - enable = true; - package = lib.mkDefault pkgs.mariadb; - ensureDatabases = [ cfg.config.dbname ]; - ensureUsers = [ { - name = cfg.config.dbuser; - ensurePermissions = { "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; }; - } ]; - initialScript = pkgs.writeText "mysql-init" '' - CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${ - builtins.readFile (cfg.config.dbpassFile) - }'; - CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; - GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, - CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' - IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; - FLUSH privileges; - ''; - }; + users.users.nextcloud = { + home = "${cfg.home}"; + group = "nextcloud"; + isSystemUser = true; + }; + users.groups.nextcloud.members = [ + "nextcloud" + config.services.nginx.user + ]; - services.nginx.enable = mkDefault true; + environment.systemPackages = [ occ ]; + + services.mysql = lib.mkIf cfg.database.createLocally { + enable = true; + package = lib.mkDefault pkgs.mariadb; + ensureDatabases = [ cfg.config.dbname ]; + ensureUsers = [ { + name = cfg.config.dbuser; + ensurePermissions = { + "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; + }; + } ]; + initialScript = pkgs.writeText "mysql-init" '' + CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${ + builtins.readFile (cfg.config.dbpassFile) + }'; + CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; + GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, + CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' + IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; + FLUSH privileges; + ''; + }; - services.nginx.virtualHosts.${cfg.hostName} = { - root = cfg.package; - locations = { - "= /robots.txt" = { - priority = 100; - extraConfig = '' - allow all; - access_log off; + services.nginx.enable = mkDefault true; + + services.nginx.virtualHosts.${cfg.hostName} = { + root = cfg.package; + locations = { + "= /robots.txt" = { + priority = 100; + extraConfig = '' + allow all; + access_log off; + ''; + }; + "= /" = { + priority = 100; + extraConfig = '' + if ( $http_user_agent ~ ^DavClnt ) { + return 302 /remote.php/webdav/$is_args$args; + } + ''; + }; + "/" = { + priority = 900; + extraConfig = "rewrite ^ /index.php;"; + }; + "~ ^/store-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "~ ^/nix-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "^~ /.well-known" = { + priority = 210; + extraConfig = '' + absolute_redirect off; + location = /.well-known/carddav { + return 301 /remote.php/dav; + } + location = /.well-known/caldav { + return 301 /remote.php/dav; + } + location ~ ^/\.well-known/(?!acme-challenge|pki-validation) { + return 301 /index.php$request_uri; + } + try_files $uri $uri/ =404; + ''; + }; + "~ ^/(?:build|tests|config|lib|3rdparty|templates|data)(?:$|/)".extraConfig = '' + return 404; ''; - }; - "= /" = { - priority = 100; - extraConfig = '' - if ( $http_user_agent ~ ^DavClnt ) { - return 302 /remote.php/webdav/$is_args$args; - } + "~ ^/(?:\\.(?!well-known)|autotest|occ|issue|indie|db_|console)".extraConfig = '' + return 404; ''; - }; - "/" = { - priority = 900; - extraConfig = "rewrite ^ /index.php;"; - }; - "~ ^/store-apps" = { - priority = 201; - extraConfig = "root ${cfg.home};"; - }; - "~ ^/nix-apps" = { - priority = 201; - extraConfig = "root ${cfg.home};"; - }; - "^~ /.well-known" = { - priority = 210; - extraConfig = '' - absolute_redirect off; - location = /.well-known/carddav { - return 301 /remote.php/dav; - } - location = /.well-known/caldav { - return 301 /remote.php/dav; - } - location ~ ^/\.well-known/(?!acme-challenge|pki-validation) { - return 301 /index.php$request_uri; - } - try_files $uri $uri/ =404; + "~ ^\\/(?:index|remote|public|cron|core\\/ajax\\/update|status|ocs\\/v[12]|updater\\/.+|oc[ms]-provider\\/.+|.+\\/richdocumentscode\\/proxy)\\.php(?:$|\\/)" = { + priority = 500; + extraConfig = '' + include ${config.services.nginx.package}/conf/fastcgi.conf; + fastcgi_split_path_info ^(.+?\.php)(\\/.*)$; + set $path_info $fastcgi_path_info; + try_files $fastcgi_script_name =404; + fastcgi_param PATH_INFO $path_info; + fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; + fastcgi_param HTTPS ${ + if cfg.https then + "on" + else + "off" + }; + fastcgi_param modHeadersAvailable true; + fastcgi_param front_controller_active true; + fastcgi_pass unix:${fpm.socket}; + fastcgi_intercept_errors on; + fastcgi_request_buffering off; + fastcgi_read_timeout ${builtins.toString cfg.fastcgiTimeout}s; + ''; + }; + "~ \\.(?:css|js|woff2?|svg|gif|map)$".extraConfig = '' + try_files $uri /index.php$request_uri; + expires 6M; + access_log off; ''; - }; - "~ ^/(?:build|tests|config|lib|3rdparty|templates|data)(?:$|/)".extraConfig = '' - return 404; - ''; - "~ ^/(?:\\.(?!well-known)|autotest|occ|issue|indie|db_|console)".extraConfig = '' - return 404; - ''; - "~ ^\\/(?:index|remote|public|cron|core\\/ajax\\/update|status|ocs\\/v[12]|updater\\/.+|oc[ms]-provider\\/.+|.+\\/richdocumentscode\\/proxy)\\.php(?:$|\\/)" = { - priority = 500; - extraConfig = '' - include ${config.services.nginx.package}/conf/fastcgi.conf; - fastcgi_split_path_info ^(.+?\.php)(\\/.*)$; - set $path_info $fastcgi_path_info; - try_files $fastcgi_script_name =404; - fastcgi_param PATH_INFO $path_info; - fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; - fastcgi_param HTTPS ${ - if cfg.https then - "on" - else - "off" - }; - fastcgi_param modHeadersAvailable true; - fastcgi_param front_controller_active true; - fastcgi_pass unix:${fpm.socket}; - fastcgi_intercept_errors on; - fastcgi_request_buffering off; - fastcgi_read_timeout ${builtins.toString cfg.fastcgiTimeout}s; + "~ ^\\/(?:updater|ocs-provider|ocm-provider)(?:$|\\/)".extraConfig = '' + try_files $uri/ =404; + index index.php; + ''; + "~ \\.(?:png|html|ttf|ico|jpg|jpeg|bcmap|mp4|webm)$".extraConfig = '' + try_files $uri /index.php$request_uri; + access_log off; ''; }; - "~ \\.(?:css|js|woff2?|svg|gif|map)$".extraConfig = '' - try_files $uri /index.php$request_uri; - expires 6M; - access_log off; - ''; - "~ ^\\/(?:updater|ocs-provider|ocm-provider)(?:$|\\/)".extraConfig = '' - try_files $uri/ =404; - index index.php; - ''; - "~ \\.(?:png|html|ttf|ico|jpg|jpeg|bcmap|mp4|webm)$".extraConfig = '' - try_files $uri /index.php$request_uri; - access_log off; + extraConfig = '' + index index.php index.html /index.php$request_uri; + ${optionalString (cfg.nginx.recommendedHttpHeaders) '' + add_header X-Content-Type-Options nosniff; + add_header X-XSS-Protection "1; mode=block"; + add_header X-Robots-Tag "noindex, nofollow"; + add_header X-Download-Options noopen; + add_header X-Permitted-Cross-Domain-Policies none; + add_header X-Frame-Options sameorigin; + add_header Referrer-Policy no-referrer; + ''} + ${optionalString (cfg.https) '' + add_header Strict-Transport-Security "max-age=${ + toString cfg.nginx.hstsMaxAge + }; includeSubDomains" always; + ''} + client_max_body_size ${cfg.maxUploadSize}; + fastcgi_buffers 64 4K; + fastcgi_hide_header X-Powered-By; + gzip on; + gzip_vary on; + gzip_comp_level 4; + gzip_min_length 256; + gzip_proxied expired no-cache no-store private no_last_modified no_etag auth; + gzip_types application/atom+xml application/javascript application/json application/ld+json application/manifest+json application/rss+xml application/vnd.geo+json application/vnd.ms-fontobject application/x-font-ttf application/x-web-app-manifest+json application/xhtml+xml application/xml font/opentype image/bmp image/svg+xml image/x-icon text/cache-manifest text/css text/plain text/vcard text/vnd.rim.location.xloc text/vtt text/x-component text/x-cross-domain-policy; + + ${optionalString cfg.webfinger '' + rewrite ^/.well-known/host-meta /public.php?service=host-meta last; + rewrite ^/.well-known/host-meta.json /public.php?service=host-meta-json last; + ''} ''; }; - extraConfig = '' - index index.php index.html /index.php$request_uri; - ${optionalString (cfg.nginx.recommendedHttpHeaders) '' - add_header X-Content-Type-Options nosniff; - add_header X-XSS-Protection "1; mode=block"; - add_header X-Robots-Tag "noindex, nofollow"; - add_header X-Download-Options noopen; - add_header X-Permitted-Cross-Domain-Policies none; - add_header X-Frame-Options sameorigin; - add_header Referrer-Policy no-referrer; - ''} - ${optionalString (cfg.https) '' - add_header Strict-Transport-Security "max-age=${ - toString cfg.nginx.hstsMaxAge - }; includeSubDomains" always; - ''} - client_max_body_size ${cfg.maxUploadSize}; - fastcgi_buffers 64 4K; - fastcgi_hide_header X-Powered-By; - gzip on; - gzip_vary on; - gzip_comp_level 4; - gzip_min_length 256; - gzip_proxied expired no-cache no-store private no_last_modified no_etag auth; - gzip_types application/atom+xml application/javascript application/json application/ld+json application/manifest+json application/rss+xml application/vnd.geo+json application/vnd.ms-fontobject application/x-font-ttf application/x-web-app-manifest+json application/xhtml+xml application/xml font/opentype image/bmp image/svg+xml image/x-icon text/cache-manifest text/css text/plain text/vcard text/vnd.rim.location.xloc text/vtt text/x-component text/x-cross-domain-policy; - - ${optionalString cfg.webfinger '' - rewrite ^/.well-known/host-meta /public.php?service=host-meta last; - rewrite ^/.well-known/host-meta.json /public.php?service=host-meta-json last; - ''} - ''; - }; - } - ]); + } + ] + ); meta.doc = ./nextcloud.md; } diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index 4ff5fbf9..536de41e 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -23,7 +23,8 @@ stdenv.mkDerivation rec { version = testVersion { package = hello; }; invariant-under-noXlibs = testEqualDerivation - "hello must not be rebuilt when environment.noXlibs is set." hello + "hello must not be rebuilt when environment.noXlibs is set." + hello (nixos { environment.noXlibs = true; }).pkgs.hello; }; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 90023c38..e35a7be7 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -188,15 +188,16 @@ let }; # LTO requires LLVM bintools including ld.lld and llvm-ar. - buildStdenv = overrideCC llvmPackages.stdenv - (llvmPackages.stdenv.cc.override { + buildStdenv = overrideCC llvmPackages.stdenv ( + llvmPackages.stdenv.cc.override { bintools = if ltoSupport then buildPackages.rustc.llvmPackages.bintools else stdenv.cc.bintools ; - }); + } + ); # Compile the wasm32 sysroot to build the RLBox Sandbox # https://hacks.mozilla.org/2021/12/webassembly-and-back-again-fine-grained-sandboxing-in-firefox-95/ @@ -208,8 +209,8 @@ let done ''; - distributionIni = pkgs.writeText "distribution.ini" - (lib.generators.toINI { } { + distributionIni = pkgs.writeText "distribution.ini" ( + lib.generators.toINI { } { # Some light branding indicating this build uses our distro preferences Global = { id = "nixos"; @@ -222,7 +223,8 @@ let "app.distributor.channel" = "nixpkgs"; "app.partner.nixos" = "nixos"; }; - }); + } + ); defaultPrefs = { "geo.provider.network.url" = { @@ -233,13 +235,18 @@ let }; }; - defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" - (lib.concatStringsSep "\n" (lib.mapAttrsToList ( - key: value: '' - // ${value.reason} - pref("${key}", ${builtins.toJSON value.value}); - '' - ) defaultPrefs)); + defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" ( + lib.concatStringsSep "\n" ( + lib.mapAttrsToList + ( + key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '' + ) + defaultPrefs + ) + ); in buildStdenv.mkDerivation ({ @@ -269,11 +276,14 @@ buildStdenv.mkDerivation ({ hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; }) ] - ++ lib.optional (lib.versionOlder version "111") + ++ lib.optional + (lib.versionOlder version "111") ./env_var_for_system_dir-ff86.patch - ++ lib.optional (lib.versionAtLeast version "111") + ++ lib.optional + (lib.versionAtLeast version "111") ./env_var_for_system_dir-ff111.patch - ++ lib.optional (lib.versionAtLeast version "96") + ++ lib.optional + (lib.versionAtLeast version "96") ./no-buildconfig-ffx96.patch ++ extraPatches ; @@ -433,12 +443,14 @@ buildStdenv.mkDerivation ({ ] # elf-hack is broken when using clang+lld: # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 - ++ lib.optional ( - ltoSupport - && ( - buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64 + ++ lib.optional + ( + ltoSupport + && ( + buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64 + ) ) - ) "--disable-elf-hack" + "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ (enableFeature alsaSupport "alsa") diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index d89e906a..684dd12b 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -163,7 +163,8 @@ in super.kernel.override - (originalArgs: + ( + originalArgs: { @@ -199,7 +200,8 @@ in features; - }); + } + ); } ) diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 7e213715..20400980 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -1,59 +1,73 @@ (( # test a # test -) ( - (c) -) ( - (c) # e -) ( +) + ((c)) ( - c # d + (c) # e ) -) ( ( - c # d - ) # e -) ( - ( # b - c - ) -) ( - ( # b - c - ) # e -) ( - ( # b - c # d - ) -) ( - ( # b - c # d - ) # e -) ( # a - (c) -) ( # a - (c) # e -) ( # a + ( + c # d + ) + ) + ( + ( + c # d + ) # e + ) + ( + ( # b + c + ) + ) + ( + ( # b + c + ) # e + ) ( - c # d + ( # b + c # d + ) ) -) ( # a ( - c # d - ) # e -) ( # a - ( # b - c - ) -) ( # a - ( # b - c - ) # e -) ( # a - ( # b - c # d - ) -) ( # a - ( # b - c # d - ) # e -)) + ( # b + c # d + ) # e + ) + ( # a + (c) + ) + ( # a + (c) # e + ) + ( # a + ( + c # d + ) + ) + ( # a + ( + c # d + ) # e + ) + ( # a + ( # b + c + ) + ) + ( # a + ( # b + c + ) # e + ) + ( # a + ( # b + c # d + ) + ) + ( # a + ( # b + c # d + ) # e + )) From 3802eaa987de5608e91d6336909a201b9175846c Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 5 May 2023 11:49:12 +0200 Subject: [PATCH 029/125] Add direnv --- .envrc | 1 + .gitignore | 1 + 2 files changed, 2 insertions(+) create mode 100644 .envrc diff --git a/.envrc b/.envrc new file mode 100644 index 00000000..4a4726a5 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use_nix diff --git a/.gitignore b/.gitignore index 94462357..37ad2a5f 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ /dist-newstyle /.ghc.environment.* /result +/.direnv From 10745f33c5afbf2537da196f238857472e36159f Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 20 May 2023 01:40:33 +0200 Subject: [PATCH 030/125] Fix function commas - Trailing commas were missing on parameters with default values - Moving comments around to better migrate from leading-comma to trailing-comma style --- src/Nixfmt/Pretty.hs | 30 ++++++-- src/Nixfmt/Types.hs | 1 + test/diff/idioms_lib_3/out.nix | 15 ++-- test/diff/idioms_pkgs_3/out.nix | 34 ++++----- test/diff/monsters_4/out.nix | 3 +- test/diff/pattern/in.nix | 9 +++ test/diff/pattern/out.nix | 123 ++++++++++++++------------------ 7 files changed, 108 insertions(+), 107 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 50af3914..58f9b1f1 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -8,7 +8,6 @@ module Nixfmt.Pretty where -import Debug.Trace import Prelude hiding (String) import Data.Char (isSpace) @@ -205,20 +204,41 @@ toLeading Nothing = [] toLeading (Just (TrailingComment c)) = [LineComment (" " <> c)] instance Pretty ParamAttr where + -- Simple parameter, move comment around + -- Move comments around when switching from leading comma to trailing comma style: + -- `, name # foo` → `name, #foo` + pretty (ParamAttr (Ann trivia name (Just comment)) Nothing (Just (Ann trivia' comma Nothing))) + = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann trivia' comma (Just comment)))) + + -- Simple parameter, move comment around and add trailing comma + -- Same as above, but also add trailing comma + pretty (ParamAttr (Ann trivia name (Just comment)) Nothing Nothing) + = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] TComma (Just comment)))) + -- Simple parameter + -- Still need to handle missing trailing comma here, because the special cases above are not exhaustive pretty (ParamAttr name Nothing maybeComma) = pretty name <> (fromMaybe (text ",") (fmap pretty maybeComma)) <> softline -- With ? default - pretty (ParamAttr name (Just (qmark, def)) comma) + pretty (ParamAttr name (Just (qmark, def)) maybeComma) = group (pretty name <> hardspace <> pretty qmark <> absorb softline mempty (Just 2) def) - <> pretty comma <> softline + <> (fromMaybe (text ",") (fmap pretty maybeComma)) <> softline - -- ... + -- `...` pretty (ParamEllipsis ellipsis) = pretty ellipsis +-- When a `, name` entry has some line comments before it, they are actually attached to the comment +-- of the preceding item. Move them to the next one +moveParamComments :: [ParamAttr] -> [ParamAttr] +moveParamComments + ((ParamAttr name maybeDefault (Just (Ann trivia comma Nothing))) : (ParamAttr (Ann [] name' Nothing) maybeDefault' maybeComma') : xs) + = (ParamAttr name maybeDefault (Just (Ann [] comma Nothing))) : moveParamComments ((ParamAttr (Ann trivia name' Nothing) maybeDefault' maybeComma') : xs) +moveParamComments (x : xs) = x : moveParamComments xs +moveParamComments [] = [] + instance Pretty Parameter where -- param: pretty (IDParameter i) = pretty i @@ -230,7 +250,7 @@ instance Pretty Parameter where -- { stuff }: pretty (SetParameter bopen attrs bclose) = groupWithStart bopen $ hardline - <> nest 2 (sepBy hardline attrs) <> hardline + <> nest 2 (((sepBy hardline) . moveParamComments) attrs) <> hardline <> pretty bclose pretty (ContextParameter param1 at param2) diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 6c12851d..9f6bcd9a 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -94,6 +94,7 @@ data Term deriving (Eq, Show) data ParamAttr + -- name, Maybe question mark and default, maybe comma = ParamAttr Leaf (Maybe (Leaf, Expression)) (Maybe Leaf) | ParamEllipsis Leaf deriving (Eq, Show) diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 1e72a8de..d42adf6d 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -86,7 +86,7 @@ rec { # > "f\:oo:bar" mkKeyValueDefault = { - mkValueString ? mkValueStringDefault { } + mkValueString ? mkValueStringDefault { }, }: sep: k: v: "${libStr.escape [ sep ] k}${sep}${mkValueString v}" @@ -100,7 +100,7 @@ rec { toKeyValue = { mkKeyValue ? mkKeyValueDefault { } "=", - listsAsDuplicateKeys ? false + listsAsDuplicateKeys ? false, }: let mkLine = k: v: mkKeyValue k v + "\n"; @@ -157,7 +157,7 @@ rec { # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys - listsAsDuplicateKeys ? false + listsAsDuplicateKeys ? false, }: attrsOfAttrs: let @@ -223,7 +223,7 @@ rec { # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys - listsAsDuplicateKeys ? false + listsAsDuplicateKeys ? false, }: { globalSection, @@ -327,10 +327,9 @@ rec { withRecursion = { # If this option is not null, the given value will stop evaluating at a certain depth - depthLimit + depthLimit, # If this option is true, an error will be thrown, if a certain given depth is exceeded - , - throwOnDepthLimit ? true + throwOnDepthLimit ? true, }: assert builtins.isInt depthLimit; let @@ -390,7 +389,7 @@ rec { # If this option is true, the output is indented with newlines for attribute sets and lists multiline ? true, # Initial indentation level - indent ? "" + indent ? "", }: let go = diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 3789c32a..a5d88407 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -16,7 +16,7 @@ extraBuildInputs ? [ ], extraMakeFlags ? [ ], extraPassthru ? { }, - tests ? [ ] + tests ? [ ], }: { @@ -24,10 +24,9 @@ pkgs, stdenv, fetchpatch, - patchelf + patchelf, # build time - , autoconf, cargo, dump_syms, @@ -35,8 +34,7 @@ nodejs, perl, pkg-config, - pkgsCross # wasm32 rlbox - , + pkgsCross, # wasm32 rlbox python3, runCommand, rustc, @@ -44,10 +42,9 @@ rustPlatform, unzip, which, - wrapGAppsHook + wrapGAppsHook, # runtime - , bzip2, dbus, dbus-glib, @@ -75,22 +72,19 @@ xorg, zip, zlib, - pkgsBuildBuild + pkgsBuildBuild, # optionals ## debugging - , - debugBuild ? false + debugBuild ? false, # On 32bit platforms, we disable adding "-g" for easier linking. - , - enableDebugSymbols ? !stdenv.is32bit + enableDebugSymbols ? !stdenv.is32bit, ## optional libraries - , alsaSupport ? stdenv.isLinux, alsa-lib, ffmpegSupport ? true, @@ -112,23 +106,21 @@ sndio, waylandSupport ? true, libxkbcommon, - libdrm + libdrm, ## privacy-related options - , - privacySupport ? false + privacySupport ? false, # WARNING: NEVER set any of the options below to `true` by default. # Set to `!privacySupport` or `false`. - , crashreporterSupport ? !privacySupport, curl, geolocationSupport ? !privacySupport, googleAPISupport ? geolocationSupport, mlsAPISupport ? geolocationSupport, - webrtcSupport ? !privacySupport + webrtcSupport ? !privacySupport, # digital rights managemewnt @@ -137,8 +129,7 @@ # requests it. # Controlling the nagbar and widevine CDM at runtime is possible by setting # `browser.eme.ui.enabled` and `media.gmp-widevinecdm.enabled` accordingly - , - drmSupport ? true + drmSupport ? true, # As stated by Sylvestre Ledru (@sylvestre) on Nov 22, 2017 at # https://github.com/NixOS/nixpkgs/issues/31843#issuecomment-346372756 we @@ -158,8 +149,7 @@ # > Therefor, as long as you keep the patch queue sane and you don't alter # > the experience of Firefox users, you won't have any issues using the # > official branding. - , - enableOfficialBranding ? true + enableOfficialBranding ? true, }: assert stdenv.cc.libc or null != null; diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 10c74252..05784c95 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -29,8 +29,7 @@ , # Foo rustPlatform # Foo , # Foo - wrapGAppsHook4 # Foo - , + wrapGAppsHook4, # Foo }: # Foo stdenv.mkDerivation # Foo rec # Foo diff --git a/test/diff/pattern/in.nix b/test/diff/pattern/in.nix index da418a4b..8e1bbe87 100644 --- a/test/diff/pattern/in.nix +++ b/test/diff/pattern/in.nix @@ -1,4 +1,13 @@ [ + ({ foo, + bar, + # Some comment + baz, + }: {}) + ({ foo, + bar, # Some comment + baz # More comment + }: {}) ({ foo , bar # Some comment diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index f20a8dd0..352af4af 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -2,9 +2,8 @@ ( { foo, - bar + bar, # Some comment - , baz, }: { } @@ -12,8 +11,24 @@ ( { foo, - bar # Some comment - , + bar, # Some comment + baz, # More comment + }: + { } + ) + ( + { + foo, + bar, + # Some comment + baz, + }: + { } + ) + ( + { + foo, + bar, # Some comment }: { } ) @@ -42,7 +57,7 @@ ], b ? { # ... - } + }, }: _ ) @@ -114,8 +129,7 @@ ( { b, - e # f - , + e, # f ... }: _ @@ -123,8 +137,7 @@ ( { b, - e # f - , + e, # f ... # h }: _ @@ -182,8 +195,7 @@ ( { b, # d - e # f - , + e, # f ... }: _ @@ -191,8 +203,7 @@ ( { b, # d - e # f - , + e, # f ... # h }: _ @@ -217,8 +228,7 @@ ) ( { - b # c - , + b, # c e, ... }: @@ -226,8 +236,7 @@ ) ( { - b # c - , + b, # c e, ... # h }: @@ -235,8 +244,7 @@ ) ( { - b # c - , + b, # c e, # g ... }: @@ -244,8 +252,7 @@ ) ( { - b # c - , + b, # c e, # g ... # h }: @@ -253,28 +260,23 @@ ) ( { - b # c - , - e # f - , + b, # c + e, # f ... }: _ ) ( { - b # c - , - e # f - , + b, # c + e, # f ... # h }: _ ) ( { - b # c - , + b, # c e # f , # g ... @@ -283,8 +285,7 @@ ) ( { - b # c - , + b, # c e # f , # g ... # h @@ -331,8 +332,7 @@ { b # c , # d - e # f - , + e, # f ... }: _ @@ -341,8 +341,7 @@ { b # c , # d - e # f - , + e, # f ... # h }: _ @@ -402,8 +401,7 @@ ( { # a b, - e # f - , + e, # f ... }: _ @@ -411,8 +409,7 @@ ( { # a b, - e # f - , + e, # f ... # h }: _ @@ -470,8 +467,7 @@ ( { # a b, # d - e # f - , + e, # f ... }: _ @@ -479,8 +475,7 @@ ( { # a b, # d - e # f - , + e, # f ... # h }: _ @@ -505,8 +500,7 @@ ) ( { # a - b # c - , + b, # c e, ... }: @@ -514,8 +508,7 @@ ) ( { # a - b # c - , + b, # c e, ... # h }: @@ -523,8 +516,7 @@ ) ( { # a - b # c - , + b, # c e, # g ... }: @@ -532,8 +524,7 @@ ) ( { # a - b # c - , + b, # c e, # g ... # h }: @@ -541,28 +532,23 @@ ) ( { # a - b # c - , - e # f - , + b, # c + e, # f ... }: _ ) ( { # a - b # c - , - e # f - , + b, # c + e, # f ... # h }: _ ) ( { # a - b # c - , + b, # c e # f , # g ... @@ -571,8 +557,7 @@ ) ( { # a - b # c - , + b, # c e # f , # g ... # h @@ -619,8 +604,7 @@ { # a b # c , # d - e # f - , + e, # f ... }: _ @@ -629,8 +613,7 @@ { # a b # c , # d - e # f - , + e, # f ... # h }: _ @@ -658,7 +641,7 @@ ( { - a ? null + a ? null, }: _ ) From 20d35b3b5688d0163afcceb2c2792a6990ae3b4c Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 20 May 2023 20:30:27 +0200 Subject: [PATCH 031/125] Move comments around a bit Also make sure that comments do not accidentally force-expand expressions --- src/Nixfmt/Pretty.hs | 45 ++++++++++++++++++----- src/Nixfmt/Types.hs | 67 +++++++++++++++++++++++++++++++++- test/diff/apply/in.nix | 9 +++++ test/diff/apply/out.nix | 18 ++++++++- test/diff/comment/out.nix | 2 +- test/diff/idioms_lib_3/out.nix | 2 +- test/diff/let_in/out.nix | 12 ++++-- 7 files changed, 137 insertions(+), 18 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 58f9b1f1..24bed4dc 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-} module Nixfmt.Pretty where @@ -16,6 +16,7 @@ import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix) import qualified Data.Text as Text (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile) +-- import Debug.Trace (traceShowId) import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', nest, newline, pretty, sepBy, softline, softline', text, textWidth) @@ -23,7 +24,7 @@ import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), Token(..), TrailingComment(..), Trivia, Trivium(..), - Whole(..), tokenText) + Whole(..), tokenText, mapFirstToken') import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) prettyCommentLine :: Text -> Doc @@ -260,7 +261,7 @@ isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts isAbsorbable (Set _ _ (Items (_:_)) _) = True -isAbsorbable (List (Ann [] _ Nothing) (Items [CommentedItem [] item]) _) = True +isAbsorbable (List (Ann [] _ Nothing) (Items [CommentedItem [] _]) _) = True isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t isAbsorbable (List _ (Items (_:_:_)) _) = True isAbsorbable _ = False @@ -299,12 +300,35 @@ instance Pretty Expression where <> absorbSet expr1 -- Let bindings are always fully expanded (no single-line form) - pretty (Let let_ binders in_ expr) + -- We also take the comments around the `in` (trailing, leading and detached binder comments) + -- and move them down to the first token of the body + pretty (Let let_ binders (Ann leading in_ trailing) expr) = base $ letPart <> hardline <> inPart where + -- Convert the TrailingComment to a Trivium, if present + convertTrailing Nothing = [] + convertTrailing (Just (TrailingComment t)) = [(LineComment (" " <> t))] + + -- Extract detached comments at the bottom. + -- This uses a custom variant of span/spanJust/spanMaybe. + -- Note that this is a foldr which walks from the bottom, but the lists + -- are constructed in a way that they end up correct again. + (binderComments, bindersWithoutComments) + = foldr + (\item -> \(start, rest) -> + case item of + (DetachedComments inner) | null rest -> (inner : start, rest) + _ -> (start, item : rest) + ) + ([], []) + (unItems binders) + letPart = groupWithStart let_ $ hardline <> letBody - inPart = groupWithStart in_ $ hardline <> pretty expr <> hardline - letBody = nest 2 $ prettyItems hardline binders + letBody = nest 2 $ prettyItems hardline (Items bindersWithoutComments) + inPart = groupWithStart (Ann [] in_ Nothing) $ hardline + -- Take our trailing and inject it between `in` and body + <> pretty (concat binderComments ++ leading ++ convertTrailing trailing) + <> pretty expr <> hardline pretty (Assert assert cond semicolon expr) = base (pretty assert <> hardspace @@ -341,7 +365,7 @@ instance Pretty Expression where -- Secondly, the `line` between the second-to-last and last argument (marked with asterisk above) is moved into its preceding -- group. This allows the last argument to be multi-line without forcing the preceding arguments to be multiline. pretty (Application f a) - = let + = let absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (group a') absorbApp expr = pretty expr @@ -350,9 +374,12 @@ instance Pretty Expression where absorbLast (Term (Parenthesized open expr close)) = base $ group $ pretty open <> line' <> nest 2 (group expr) <> line' <> pretty close absorbLast arg = group arg + + -- Extract comment before the first function and move it out, to prevent functions being force-expanded + (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f in - group $ - (group' False True $ (absorbApp f) <> line) <> (absorbLast a) + pretty comment <> (group $ + (group' False True $ absorbApp fWithoutComment <> line) <> absorbLast a) -- '//' operator pretty (Operation a op@(Ann _ TUpdate _) b) diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 9f6bcd9a..a19a4cda 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE DeriveFoldable, OverloadedStrings #-} +{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes #-} module Nixfmt.Types where @@ -128,6 +128,71 @@ data Whole a type File = Whole Expression +-- Implemented by all AST-related types whose values are guaranteed to contain at least one (annotated) token +class LanguageElement a where + -- Map the first token of that expression, no matter how deep it sits + -- in the AST. This is useful for modifying comments + mapFirstToken :: (forall b. Ann b -> Ann b) -> a -> a + mapFirstToken f a = fst (mapFirstToken' (\x -> (f x, ())) a) + + -- Same as mapFirstToken, but the mapping function also yields a value that may be + -- returned. This is useful for getting/extracting values + mapFirstToken' :: (forall b. Ann b -> (Ann b, c)) -> a -> (a, c) + +instance LanguageElement Parameter where + mapFirstToken' f (IDParameter name) + = let (name', ret) = f name in (IDParameter name', ret) + mapFirstToken' f (SetParameter open items close) + = let (open', ret) = f open in (SetParameter open' items close, ret) + mapFirstToken' f (ContextParameter first at second) + = let (first', ret) = mapFirstToken' f first in ((ContextParameter first' at second), ret) + +instance LanguageElement Term where + mapFirstToken' f (Token leaf) + = let (leaf', ret) = (f leaf) in (Token leaf', ret) + mapFirstToken' f (String string) + = let (string', ret) = (f string) in (String string', ret) + mapFirstToken' f (Path path) + = let (path', ret) = (f path) in (Path path', ret) + mapFirstToken' f (List open items close) + = let (open', ret) = (f open) in (List open' items close, ret) + mapFirstToken' f (Set (Just rec) open items close) + = let (rec', ret) = (f rec) in (Set (Just rec') open items close, ret) + mapFirstToken' f (Set Nothing open items close) + = let (open', ret) = (f open) in (Set Nothing open' items close, ret) + mapFirstToken' f (Selection term selector) + = let (term', ret) = (mapFirstToken' f term) in (Selection term' selector, ret) + mapFirstToken' f (Parenthesized open expr close) + = let (open', ret) = (f open) in (Parenthesized open' expr close, ret) + +instance LanguageElement Expression where + mapFirstToken' f (Term term) + = let (term', ret) = (mapFirstToken' f term) in (Term term', ret) + mapFirstToken' f (With with expr0 semicolon expr1) + = let (with', ret) = (f with) in (With with' expr0 semicolon expr1, ret) + mapFirstToken' f (Let let_ items in_ body) + = let (let_', ret) = (f let_) in (Let let_' items in_ body, ret) + mapFirstToken' f (Assert assert cond semicolon body) + = let (assert', ret) = (f assert) in (Assert assert' cond semicolon body, ret) + mapFirstToken' f (If if_ expr0 then_ expr1 else_ expr2) + = let (if_', ret) = (f if_) in (If if_' expr0 then_ expr1 else_ expr2, ret) + mapFirstToken' f (Abstraction param colon body) + = let (param', ret) = (mapFirstToken' f param) in (Abstraction param' colon body, ret) + mapFirstToken' f (Application g a) + = let (g', ret) = (mapFirstToken' f g) in (Application g' a, ret) + mapFirstToken' f (Operation left op right) + = let (left', ret) = (mapFirstToken' f left) in (Operation left' op right, ret) + mapFirstToken' f (MemberCheck name dot selectors) + = let (name', ret) = (mapFirstToken' f name) in (MemberCheck name' dot selectors, ret) + mapFirstToken' f (Negation not_ expr) + = let (not_', ret) = (f not_) in (Negation not_' expr, ret) + mapFirstToken' f (Inversion tilde expr) + = let (tilde', ret) = (f tilde) in (Inversion tilde' expr, ret) + +instance LanguageElement a => LanguageElement (Whole a) where + mapFirstToken' f (Whole a trivia) + = let (a', ret) = (mapFirstToken' f a) in (Whole a' trivia, ret) + data Token = Integer Int | Float Double diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index ad893f5d..578b1549 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -1,4 +1,13 @@ [ + ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + # Function call with comment + (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + [ + (mapAttrsToStringsSep [force long] "\n" mkSection attrsOfAttrs) + ] (a b) ( diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 433bcfa6..d9b454d3 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -1,4 +1,19 @@ [ + ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + # Function call with comment + (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + [ + (mapAttrsToStringsSep + [ + force + long + ] + "\n" + mkSection + attrsOfAttrs) + ] (a b) ((a b) (a b) (a # b @@ -91,8 +106,7 @@ utils, }: # For each supported platform, - utils.lib.eachDefaultSystem - (system: { }) + utils.lib.eachDefaultSystem (system: { }) ; } { diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index 78e01644..e86b3079 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -71,8 +71,8 @@ #6 d = 1; - #7 in + #7 d ) diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index d42adf6d..5d6e6595 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -173,8 +173,8 @@ rec { '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues ; - # map input to ini sections in + # map input to ini sections mapAttrsToStringsSep "\n" mkSection attrsOfAttrs ; diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index 780c489e..8b0f8f30 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -17,7 +17,8 @@ let a = let c = 1; - in # e + in + # e f ; a = @@ -30,7 +31,8 @@ let a = let c = 1; # d - in # e + in + # e f ; a = @@ -42,7 +44,8 @@ let a = let # b c = 1; - in # e + in + # e f ; a = @@ -54,7 +57,8 @@ let a = let # b c = 1; # d - in # e + in + # e f ; From 2a9ec6b9dcfab82fab8679e5d79fb190b75806fc Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 21 May 2023 00:16:02 +0200 Subject: [PATCH 032/125] Tweak operations some more --- src/Nixfmt/Pretty.hs | 33 +++++++++++------ test/diff/idioms_pkgs_3/out.nix | 10 +++--- test/diff/operation/in.nix | 15 ++++++++ test/diff/operation/out.nix | 63 ++++++++++++++++++++++++++++++--- 4 files changed, 100 insertions(+), 21 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 24bed4dc..c8a7f9bb 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -190,11 +190,20 @@ prettyTerm (Parenthesized paropen expr parclose) case expr of -- Start on the same line for these (Term t) | isAbsorbable t -> mempty + -- Also absorb function calls (even though this rarely looks weird) (Application _ _) -> mempty + -- Absorb function declarations but only those with simple parameter (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t -> mempty - + -- Operations are fine too, except if their left hand side is an absorbable term. + -- In that case, we need to start on a new line, otherwise the starting and closing + -- bracket/brace would not end up on the same indentation as those of the RHS + (Operation left _ _) | startsWithAbsorbableTerm left -> line' + (Operation _ _ _) -> mempty -- Start on a new line for the others _ -> line' + startsWithAbsorbableTerm (Term t) | isAbsorbable t = True + startsWithAbsorbableTerm (Operation left _ _) = startsWithAbsorbableTerm left + startsWithAbsorbableTerm _ = False instance Pretty Term where pretty l@List{} = group $ prettyTerm l @@ -352,12 +361,12 @@ instance Pretty Expression where = pretty param <> pretty colon <> absorbSet body -- Function application - -- Some example mapping of Nix code to Doc (using parentheses as groups, but omitting the outermost group + -- Some example mapping of Nix code to Doc (using brackets as groups, but omitting the outermost group -- and groups around the expressions for conciseness): - -- `f a` -> (f line*) a - -- `f g a` -> (f line g line*) a - -- `f g h a` -> ((f line g) line h line*) a - -- `f g h i a` -> (((f line g) line h) line i line*) a + -- `f a` -> [f line*] a + -- `f g a` -> [f line g line*] a + -- `f g h a` -> [[f line g] line h line*] a + -- `f g h i a` -> [[[f line g] line h] line i line*] a -- As you can see, it separates the elements by `line` whitespace. However, there are two tricks to make it look good: -- Firstly, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion -- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining @@ -393,12 +402,14 @@ instance Pretty Expression where flatten x = [x] -- Some children need nesting - absorbOperation :: Expression -> Doc - absorbOperation (Term t) | isAbsorbable t = pretty t - absorbOperation x@(Operation _ _ _) = nest 2 (pretty x) - absorbOperation x = base $ nest 2 (pretty x) + -- Also pass in the index because we need to special case the first element + absorbOperation :: (Int, Expression) -> Doc + absorbOperation (_, (Term t)) | isAbsorbable t = pretty t + absorbOperation (0, x@(Operation _ _ _)) = pretty x + absorbOperation (_, x@(Operation _ _ _)) = nest 2 (pretty x) + absorbOperation (_, x) = base $ nest 2 (pretty x) in - group $ (sepBy (line <> pretty op <> hardspace) . map absorbOperation . flatten) operation + group $ (sepBy (line <> pretty op <> hardspace) . map absorbOperation . (zip [0..]) . flatten) operation pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index a5d88407..193f38f9 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -429,12 +429,10 @@ buildStdenv.mkDerivation ({ ] # LTO is done using clang and lld on Linux. ++ lib.optional - ( - ltoSupport - && ( - buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64 - ) - ) + (ltoSupport + && (buildStdenv.isAarch32 + || buildStdenv.isi686 + || buildStdenv.isx86_64)) "--disable-elf-hack" # LTO is done using clang and lld on Linux. ++ lib.optional (!drmSupport) "--disable-eme" diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix index 3453c92f..01e24663 100644 --- a/test/diff/operation/in.nix +++ b/test/diff/operation/in.nix @@ -1,4 +1,19 @@ [ + ( + if + (cpu.family == "arm" && cpu.bits == 32) + || (cpu.family == "sparc" && cpu.bits == 32) + || (cpu.family == "m68k" && cpu.bits == 32) + || (cpu.family == "x86" && cpu.bits == 32) + then + execFormats.aout + else + execFormats.elf + ) + ([ aaaaaaaaaaaaa aaaaaaaaaaaaa ] + [ bbbbbbbbbbbbbb bbbbbbbbbbbbbbb ] * [ ccccccccccccccc ccccccccccccccccccc ]) + ([ aaaaaaaaaaaaa aaaaaaaaaaaaa ] * [ bbbbbbbbbbbbbb bbbbbbbbbbbbbbb ] + [ ccccccccccccccc ccccccccccccccccccc ]) + + ([ 1 2 3] / [4 5 6] / [7 8 9]) ([ 1 2 3] ++ [4 5 6] ++ [7 8 9]) ([ diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 465afa4d..ab6f81c2 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -1,4 +1,61 @@ [ + ( + if + (cpu.family == "arm" && cpu.bits == 32) + || (cpu.family == "sparc" && cpu.bits == 32) + || (cpu.family == "m68k" && cpu.bits == 32) + || (cpu.family == "x86" && cpu.bits == 32) + then + execFormats.aout + else + execFormats.elf + ) + ( + [ + aaaaaaaaaaaaa + aaaaaaaaaaaaa + ] + + [ + bbbbbbbbbbbbbb + bbbbbbbbbbbbbbb + ] + * [ + ccccccccccccccc + ccccccccccccccccccc + ] + ) + ( + [ + aaaaaaaaaaaaa + aaaaaaaaaaaaa + ] + * [ + bbbbbbbbbbbbbb + bbbbbbbbbbbbbbb + ] + + [ + ccccccccccccccc + ccccccccccccccccccc + ] + ) + + ( + [ + 1 + 2 + 3 + ] + / [ + 4 + 5 + 6 + ] + / [ + 7 + 8 + 9 + ] + ) ( [ 1 @@ -41,8 +98,7 @@ ) # Test precedence - ( - aaaaaaaaaaaaaaa + (aaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbb + ccccccccccccccccccccccccccc + ddddddddddddddddddddddd * eeeeeeeeeeeeeeeeeeeeeeee @@ -50,8 +106,7 @@ * gggggggggggggggggggggggg ++ hhhhhhhhhhhhhhhhhhhhhhhhhhh ++ iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii - * jjjjjjjjjjjjjjjjjjjjj - ) + * jjjjjjjjjjjjjjjjjjjjj) # Logical precedence ( From cb309e4b890d3f77ad93272aa98182c7f9cfb6dd Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 21 May 2023 21:44:26 +0200 Subject: [PATCH 033/125] wip --- src/Nixfmt/Pretty.hs | 37 +++++++++++++------- test/diff/idioms_lib_3/out.nix | 4 +-- test/diff/idioms_nixos_2/out.nix | 13 +------ test/diff/idioms_pkgs_3/out.nix | 25 ++++++------- test/diff/monsters_5/out.nix | 2 +- test/diff/operation/in.nix | 39 +++++++++++++++++++++ test/diff/operation/out.nix | 60 ++++++++++++++++++++++++++++++++ 7 files changed, 136 insertions(+), 44 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index c8a7f9bb..7cebaa46 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -36,7 +36,9 @@ toLineComment :: Text -> Trivium toLineComment c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c -- Make sure a group is not expanded because the token that starts it has --- leading comments. +-- leading comments. This will render both arguments as a group, but +-- if the first argument has some leading comments they will be put before +-- the group groupWithStart :: Pretty a => Ann a -> Doc -> Doc groupWithStart (Ann leading a trailing) b = pretty leading <> group (pretty a <> pretty trailing <> b) @@ -347,7 +349,7 @@ instance Pretty Expression where pretty (If if_ cond then_ expr0 else_ expr1) = base $ group $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - (group (pretty if_ <> nest 2 (line <> pretty cond <> line) <> pretty then_)) + (groupWithStart if_ (nest 2 (line <> pretty cond <> line) <> pretty then_)) <> hardline <> nest 2 (group expr0) <> hardline <> pretty else_ <> absorbElse expr1 @@ -396,20 +398,29 @@ instance Pretty Expression where -- all other operators pretty operation@(Operation _ op _) = let - -- Walk the operation tree and put a list of things on the same level - flatten :: Expression -> [Expression] - flatten (Operation a op' b) | op' == op = (flatten a) ++ (flatten b) - flatten x = [x] + -- Walk the operation tree and put a list of things on the same level. + -- 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 x = [(opL, x)] -- Some children need nesting - -- Also pass in the index because we need to special case the first element - absorbOperation :: (Int, Expression) -> Doc - absorbOperation (_, (Term t)) | isAbsorbable t = pretty t - absorbOperation (0, x@(Operation _ _ _)) = pretty x - absorbOperation (_, x@(Operation _ _ _)) = nest 2 (pretty x) - absorbOperation (_, x) = base $ nest 2 (pretty x) + absorbOperation :: Expression -> Doc + absorbOperation (Term t) | isAbsorbable t = pretty t + absorbOperation x = nest 2 (pretty x) + + prettyOperation :: (Maybe Leaf, Expression) -> Doc + -- First element + prettyOperation (Nothing, expr) = pretty expr + -- The others + prettyOperation ((Just op'), expr) = line <> pretty op' <> hardspace <> absorbOperation expr + + -- Extract comment before the first operand and move it out, to prevent force-expanding the expression + (operationWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) operation in - group $ (sepBy (line <> pretty op <> hardspace) . map absorbOperation . (zip [0..]) . flatten) operation + pretty comment <> (group $ + (concat . map prettyOperation . (flatten Nothing)) operationWithoutComment) pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 5d6e6595..36f04573 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -504,9 +504,7 @@ rec { "" else if isAttrs v then # apply pretty values if allowed - if - allowPrettyValues && v ? __pretty && v ? val - then + if allowPrettyValues && v ? __pretty && v ? val then v.__pretty v.val else if v == { } then "{ }" diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index d6a35b80..78c8e278 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -34,21 +34,10 @@ let else [ cfg.phpPackage.extensions.openssl ] ) - # use OpenSSL 1.1 for RC4 Nextcloud encryption if user - # has acknowledged the brokenness of the ciphers (RC4). - # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. ++ optional cfg.enableImagemagick imagick - # use OpenSSL 1.1 for RC4 Nextcloud encryption if user - # has acknowledged the brokenness of the ciphers (RC4). - # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. + # Optionally enabled depending on caching settings ++ optional cfg.caching.apcu apcu - # use OpenSSL 1.1 for RC4 Nextcloud encryption if user - # has acknowledged the brokenness of the ciphers (RC4). - # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. ++ optional cfg.caching.redis redis - # use OpenSSL 1.1 for RC4 Nextcloud encryption if user - # has acknowledged the brokenness of the ciphers (RC4). - # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. ++ optional cfg.caching.memcached memcached ) ++ cfg.phpExtraExtensions all diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 193f38f9..f7c7c777 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -254,14 +254,14 @@ buildStdenv.mkDerivation ({ patches = lib.optionals (lib.versionOlder version "102.6.0") [ - (fetchpatch { - # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 - name = "rust-cbindgen-0.24.2-compat.patch"; - url = - "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; - hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; - }) - ] + (fetchpatch { + # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 + name = "rust-cbindgen-0.24.2-compat.patch"; + url = + "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; + hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; + }) + ] ++ lib.optional (lib.versionOlder version "111") ./env_var_for_system_dir-ff86.patch @@ -427,16 +427,15 @@ buildStdenv.mkDerivation ({ "--enable-lto=cross" # Cross-Language LTO "--enable-linker=lld" ] - # LTO is done using clang and lld on Linux. + # elf-hack is broken when using clang+lld: + # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 ++ lib.optional (ltoSupport && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64)) "--disable-elf-hack" - # LTO is done using clang and lld on Linux. ++ lib.optional (!drmSupport) "--disable-eme" - # LTO is done using clang and lld on Linux. ++ [ (enableFeature alsaSupport "alsa") (enableFeature crashreporterSupport "crashreporter") @@ -460,16 +459,12 @@ buildStdenv.mkDerivation ({ (enableFeature (!debugBuild && !stdenv.is32bit) "release") (enableFeature enableDebugSymbols "debug-symbols") ] - # LTO is done using clang and lld on Linux. ++ lib.optionals enableDebugSymbols [ "--disable-strip" "--disable-install-strip" ] - # LTO is done using clang and lld on Linux. ++ lib.optional enableOfficialBranding "--enable-official-branding" - # LTO is done using clang and lld on Linux. ++ lib.optional (branding != null) "--with-branding=${branding}" - # LTO is done using clang and lld on Linux. ++ extraConfigureFlags ; diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 528c8de6..0f761b16 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -186,7 +186,7 @@ in ++ - kernelPatches + kernelPatches ; features diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix index 01e24663..e6b37be6 100644 --- a/test/diff/operation/in.nix +++ b/test/diff/operation/in.nix @@ -1,4 +1,38 @@ [ + ( + # Filter out git + baseName == ".gitignore" + || (type == "directory" && baseName == ".git") + || (type == "directory" + && (baseName == "target" || baseName == "_site" || baseName == ".sass-cache" || baseName == ".jekyll-metadata" || baseName == "build-artifacts")) + || (type == "symlink" && lib.hasPrefix "result" baseName) + || (type == "directory" && (baseName == ".idea" || baseName == ".vscode")) + || lib.hasSuffix ".iml" baseName + # some other comment + || baseName == "Cargo.nix" + || lib.hasSuffix "~" baseName + || builtins.match "^\\.sw[a-z]$$" baseName != null + || # a third comment + builtins.match "^\\..*\\.sw[a-z]$$" baseName != null + || lib.hasSuffix ".tmp" baseName + || + # fourth comment + lib.hasSuffix ".bak" baseName + || + # fifth comment + baseName == "tests.nix" + ) + ( + # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading + # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. + if actualPlugins == [ ] then + terraform.overrideAttrs (orig: { passthru = orig.passthru // passthru; }) + else + lib.appendToName "with-plugins" ( + stdenv.mkDerivation { + inherit (terraform) meta pname version; + nativeBuildInputs = [ makeWrapper ]; + })) ( if (cpu.family == "arm" && cpu.bits == 32) @@ -59,4 +93,9 @@ ] ) + # Indentation with parenthesized multiline function call + ([ 1 2 3] + ++ (isOneOf item [1 2 3 4]) + ++ isOneOf item [1 2 3 4] + ) ] diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index ab6f81c2..cbfc1f5c 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -1,4 +1,43 @@ [ + ( + # Filter out git + baseName == ".gitignore" + || (type == "directory" && baseName == ".git") + || (type == "directory" + && (baseName == "target" + || baseName == "_site" + || baseName == ".sass-cache" + || baseName == ".jekyll-metadata" + || baseName == "build-artifacts")) + || (type == "symlink" && lib.hasPrefix "result" baseName) + || (type == "directory" && (baseName == ".idea" || baseName == ".vscode")) + || lib.hasSuffix ".iml" baseName + # some other comment + || baseName == "Cargo.nix" + || lib.hasSuffix "~" baseName + || builtins.match "^\\.sw[a-z]$$" baseName != null + || # a third comment + builtins.match "^\\..*\\.sw[a-z]$$" baseName != null + || lib.hasSuffix ".tmp" baseName + || + # fourth comment + lib.hasSuffix ".bak" baseName + || + # fifth comment + baseName == "tests.nix") + ( + # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading + # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. + if actualPlugins == [ ] then + terraform.overrideAttrs (orig: { passthru = orig.passthru // passthru; }) + else + lib.appendToName "with-plugins" ( + stdenv.mkDerivation { + inherit (terraform) meta pname version; + nativeBuildInputs = [ makeWrapper ]; + } + ) + ) ( if (cpu.family == "arm" && cpu.bits == 32) @@ -146,4 +185,25 @@ ) ] ) + + # Indentation with parenthesized multiline function call + ( + [ + 1 + 2 + 3 + ] + ++ (isOneOf item [ + 1 + 2 + 3 + 4 + ]) + ++ isOneOf item [ + 1 + 2 + 3 + 4 + ] + ) ] From 6f4791d635f01e6ea5972755ec706020a251b7d7 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 21 May 2023 22:52:35 +0200 Subject: [PATCH 034/125] pretty parentheses --- src/Nixfmt/Pretty.hs | 24 ++++++++++++++---------- src/Nixfmt/Types.hs | 1 + test/diff/idioms_pkgs_3/out.nix | 5 ++--- test/diff/inherit_from/out.nix | 32 ++++++++------------------------ test/diff/monsters_5/out.nix | 15 ++++----------- test/diff/operation/in.nix | 8 ++++++++ test/diff/operation/out.nix | 18 +++++++++++++++--- test/diff/or_default/out.nix | 12 ++++++------ test/diff/paren/in.nix | 7 +++++++ test/diff/paren/out.nix | 19 +++++++++++++++---- test/diff/select/out.nix | 3 +-- 11 files changed, 81 insertions(+), 63 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 7cebaa46..6d8ca98c 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -89,8 +89,8 @@ instance Pretty Selector where = pretty dot <> pretty sel pretty (Selector dot sel (Just (kw, def))) - = pretty dot <> pretty sel - <> hardspace <> pretty kw <> hardspace <> pretty def + = base $ pretty dot <> pretty sel + <> nest 2 (softline <> pretty kw <> hardspace <> pretty def) -- in attrsets and let bindings instance Pretty Binder where @@ -186,23 +186,26 @@ prettyTerm (Set krec paropen binders parclose) -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = base $ pretty paropen <> nest 2 (absorbedLine <> group expr <> absorbedLine) <> pretty parclose + = base $ groupWithStart paropen (nest 2 (lineL <> group expr <> lineR) <> pretty parclose) where - absorbedLine = + (lineL, lineR) = case expr of -- Start on the same line for these - (Term t) | isAbsorbable t -> mempty + (Term t) | isAbsorbable t -> (mempty, mempty) -- Also absorb function calls (even though this rarely looks weird) - (Application _ _) -> mempty + (Application _ _) -> (mempty, mempty) -- Absorb function declarations but only those with simple parameter - (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t -> mempty + (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t -> (mempty, mempty) -- Operations are fine too, except if their left hand side is an absorbable term. -- In that case, we need to start on a new line, otherwise the starting and closing -- bracket/brace would not end up on the same indentation as those of the RHS - (Operation left _ _) | startsWithAbsorbableTerm left -> line' - (Operation _ _ _) -> mempty + (Operation left (Ann _ op _) _) | startsWithAbsorbableTerm left || op == TUpdate -> (line', line') + (Operation _ _ _) -> (mempty, line') + -- Same thing for selections + (Term (Selection t _)) | isAbsorbable t -> (line', line') + (Term (Selection _ _)) -> (mempty, line') -- Start on a new line for the others - _ -> line' + _ -> (line', line') startsWithAbsorbableTerm (Term t) | isAbsorbable t = True startsWithAbsorbableTerm (Operation left _ _) = startsWithAbsorbableTerm left startsWithAbsorbableTerm _ = False @@ -414,6 +417,7 @@ instance Pretty Expression where -- First element prettyOperation (Nothing, expr) = pretty expr -- The others + -- TODO when expr contains a comment or op' has a trailing comment, move them before op' prettyOperation ((Just op'), expr) = line <> pretty op' <> hardspace <> absorbOperation expr -- Extract comment before the first operand and move it out, to prevent force-expanding the expression diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index a19a4cda..d86b7cc9 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -75,6 +75,7 @@ data SimpleSelector deriving (Eq, Show) data Selector + -- maybe dot, ident, maybe "or" and default value = Selector (Maybe Leaf) SimpleSelector (Maybe (Leaf, Term)) deriving (Eq, Show) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index f7c7c777..de1e8c58 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -431,9 +431,8 @@ buildStdenv.mkDerivation ({ # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 ++ lib.optional (ltoSupport - && (buildStdenv.isAarch32 - || buildStdenv.isi686 - || buildStdenv.isx86_64)) + && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64) + ) "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 820b1015..c04c21b9 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -285,72 +285,56 @@ } { inherit # a - ( - c - ) + (c) f h ; } { inherit # a - ( - c - ) + (c) f h # i ; } { inherit # a - ( - c - ) + (c) f # g h ; } { inherit # a - ( - c - ) + (c) f # g h # i ; } { inherit # a - ( - c - ) # e + (c) # e f h ; } { inherit # a - ( - c - ) # e + (c) # e f h # i ; } { inherit # a - ( - c - ) # e + (c) # e f # g h ; } { inherit # a - ( - c - ) # e + (c) # e f # g h # i ; diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 0f761b16..156ea2f3 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -18,18 +18,14 @@ let inherit - ( - config.boot - ) + (config.boot) kernelPatches ; inherit - ( - config.boot.kernel - ) + (config.boot.kernel) features @@ -38,9 +34,7 @@ let inherit - ( - config.boot.kernelPackages - ) + (config.boot.kernelPackages) kernel ; @@ -176,8 +170,7 @@ in = - ( - originalArgs.kernelPatches + (originalArgs.kernelPatches or diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix index e6b37be6..ad2e6417 100644 --- a/test/diff/operation/in.nix +++ b/test/diff/operation/in.nix @@ -22,6 +22,14 @@ # fifth comment baseName == "tests.nix" ) + # Filter out nix-build result symlinks + (type == "symlink" && lib.hasPrefix "result" baseName) + ( # Filter out nix-build result symlinks + (type == "symlink" && lib.hasPrefix "result" baseName) + || + # Filter out sockets and other types of files we can't have in the store. + (type == "unknown") + ) ( # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index cbfc1f5c..c02c3c64 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -8,7 +8,9 @@ || baseName == "_site" || baseName == ".sass-cache" || baseName == ".jekyll-metadata" - || baseName == "build-artifacts")) + || baseName == "build-artifacts" + ) + ) || (type == "symlink" && lib.hasPrefix "result" baseName) || (type == "directory" && (baseName == ".idea" || baseName == ".vscode")) || lib.hasSuffix ".iml" baseName @@ -24,7 +26,16 @@ lib.hasSuffix ".bak" baseName || # fifth comment - baseName == "tests.nix") + baseName == "tests.nix" + ) + # Filter out nix-build result symlinks + (type == "symlink" && lib.hasPrefix "result" baseName) + ( # Filter out nix-build result symlinks + (type == "symlink" && lib.hasPrefix "result" baseName) + || + # Filter out sockets and other types of files we can't have in the store. + (type == "unknown") + ) ( # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. @@ -145,7 +156,8 @@ * gggggggggggggggggggggggg ++ hhhhhhhhhhhhhhhhhhhhhhhhhhh ++ iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii - * jjjjjjjjjjjjjjjjjjjjj) + * jjjjjjjjjjjjjjjjjjjjj + ) # Logical precedence ( diff --git a/test/diff/or_default/out.nix b/test/diff/or_default/out.nix index 09dfccee..16c01f52 100644 --- a/test/diff/or_default/out.nix +++ b/test/diff/or_default/out.nix @@ -5,13 +5,13 @@ (a.b or c) (a.b or (a.b or (a.b or c))) (a.b or (a.b or (a.b or c))) - ( - a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + (a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a ) - ( - a.a or a.a # test + (a.a or a.a # test or a.a # test - or # test - a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + or # test + a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + or a.a or a.a or a.a or a.a or a.a or a.a ) ] diff --git a/test/diff/paren/in.nix b/test/diff/paren/in.nix index ec1b51d5..dbcd6d60 100644 --- a/test/diff/paren/in.nix +++ b/test/diff/paren/in.nix @@ -1,3 +1,10 @@ +[ + (done // listToAttrs [ { + # multline + name = entry; + value = 1; + }]) +] ( ( # test a # test diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 20400980..efecdb6a 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -1,6 +1,16 @@ -(( # test - a # test -) +[ + ( + done // listToAttrs [ { + # multline + name = entry; + value = 1; + } ] + ) +] +( + ( # test + a # test + ) ((c)) ( (c) # e @@ -70,4 +80,5 @@ ( # b c # d ) # e - )) + ) +) diff --git a/test/diff/select/out.nix b/test/diff/select/out.nix index 945fa0ba..f9cdc28b 100644 --- a/test/diff/select/out.nix +++ b/test/diff/select/out.nix @@ -4,8 +4,7 @@ (a.a) (a.a) (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) - ( - a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a + (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a ) ( { From 8d07dc9d6d0ad81fe39a33b78c9a4565724b20ed Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 21 May 2023 23:31:56 +0200 Subject: [PATCH 035/125] stupid silly bug --- src/Nixfmt/Pretty.hs | 2 +- test/diff/attr_set/in.nix | 8 ++++++++ test/diff/attr_set/out.nix | 8 ++++++++ 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 6d8ca98c..e09e7094 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -151,7 +151,7 @@ prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trail -- Singleton list -- Expand unless absorbable term or single line prettyTerm (List (Ann leading paropen Nothing) (Items [CommentedItem [] item]) (Ann [] parclose trailing)) - = pretty leading <> pretty paropen + = base $ pretty leading <> pretty paropen <> (if isAbsorbable item then (hardspace <> pretty item <> hardspace) else diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index 59590f74..df0a4fb4 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -94,4 +94,12 @@ packages ]; } + { + patches = [ + (substituteAll { + src = ./extensionOverridesPatches/vitals_at_corecoding.com.patch; + gtop_path = "${libgtop}/lib/girepository-1.0"; + }) + ]; + } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index d96efe35..83471b16 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -129,4 +129,12 @@ packages ]; } + { + patches = [ + (substituteAll { + src = ./extensionOverridesPatches/vitals_at_corecoding.com.patch; + gtop_path = "${libgtop}/lib/girepository-1.0"; + }) + ]; + } ] From b1b9313ea3b564d4402cd6b1d1e069483c77092c Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 7 Jun 2023 00:15:37 +0200 Subject: [PATCH 036/125] Absorb parenthesized abstractions with multiple arguments --- src/Nixfmt/Pretty.hs | 8 ++++++-- test/diff/idioms_nixos_2/out.nix | 10 ++++------ test/diff/idioms_pkgs_3/out.nix | 10 ++++------ 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index e09e7094..16ebf8f1 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -194,13 +194,14 @@ prettyTerm (Parenthesized paropen expr parclose) (Term t) | isAbsorbable t -> (mempty, mempty) -- Also absorb function calls (even though this rarely looks weird) (Application _ _) -> (mempty, mempty) - -- Absorb function declarations but only those with simple parameter - (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t -> (mempty, mempty) -- Operations are fine too, except if their left hand side is an absorbable term. -- In that case, we need to start on a new line, otherwise the starting and closing -- bracket/brace would not end up on the same indentation as those of the RHS (Operation left (Ann _ op _) _) | startsWithAbsorbableTerm left || op == TUpdate -> (line', line') (Operation _ _ _) -> (mempty, line') + -- Absorb function declarations but only those with simple parameter(s) + (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> (mempty, mempty) + (Operation _ _ _) -> (line', line') -- Same thing for selections (Term (Selection t _)) | isAbsorbable t -> (line', line') (Term (Selection _ _)) -> (mempty, line') @@ -209,6 +210,9 @@ prettyTerm (Parenthesized paropen expr parclose) startsWithAbsorbableTerm (Term t) | isAbsorbable t = True startsWithAbsorbableTerm (Operation left _ _) = startsWithAbsorbableTerm left startsWithAbsorbableTerm _ = False + isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True + isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ body) = isAbstractionWithAbsorbableTerm body + isAbstractionWithAbsorbableTerm _ = False instance Pretty Term where pretty l@List{} = group $ prettyTerm l diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 78c8e278..1def0c35 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -1109,12 +1109,10 @@ in ; occSetTrustedDomainsCmd = concatStringsSep "\n" ( imap0 - ( - i: v: '' - ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ - ${toString i} --value="${toString v}" - '' - ) + (i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) ); in diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index de1e8c58..be39f279 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -226,12 +226,10 @@ let defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" ( lib.concatStringsSep "\n" ( lib.mapAttrsToList - ( - key: value: '' - // ${value.reason} - pref("${key}", ${builtins.toJSON value.value}); - '' - ) + (key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '') defaultPrefs ) ); From 0b26acb69184794cf87a3e77db2a9abbbc3f8352 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 7 Jun 2023 00:22:34 +0200 Subject: [PATCH 037/125] Tweak operations some more - Nested operations don't get absorbed, start on new line instead - First element of parenthesized operation is not absorbed anymore --- src/Nixfmt/Pretty.hs | 12 ++----- test/diff/idioms_pkgs_3/out.nix | 3 +- test/diff/operation/in.nix | 23 +++++++++++++ test/diff/operation/out.nix | 58 ++++++++++++++++++++++++++++----- 4 files changed, 77 insertions(+), 19 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 16ebf8f1..fb66ef0e 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -194,11 +194,6 @@ prettyTerm (Parenthesized paropen expr parclose) (Term t) | isAbsorbable t -> (mempty, mempty) -- Also absorb function calls (even though this rarely looks weird) (Application _ _) -> (mempty, mempty) - -- Operations are fine too, except if their left hand side is an absorbable term. - -- In that case, we need to start on a new line, otherwise the starting and closing - -- bracket/brace would not end up on the same indentation as those of the RHS - (Operation left (Ann _ op _) _) | startsWithAbsorbableTerm left || op == TUpdate -> (line', line') - (Operation _ _ _) -> (mempty, line') -- Absorb function declarations but only those with simple parameter(s) (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> (mempty, mempty) (Operation _ _ _) -> (line', line') @@ -207,9 +202,6 @@ prettyTerm (Parenthesized paropen expr parclose) (Term (Selection _ _)) -> (mempty, line') -- Start on a new line for the others _ -> (line', line') - startsWithAbsorbableTerm (Term t) | isAbsorbable t = True - startsWithAbsorbableTerm (Operation left _ _) = startsWithAbsorbableTerm left - startsWithAbsorbableTerm _ = False isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ body) = isAbstractionWithAbsorbableTerm body isAbstractionWithAbsorbableTerm _ = False @@ -412,9 +404,11 @@ instance Pretty Expression where flatten opL (Operation a opR b) | opR == op = (flatten opL a) ++ (flatten (Just opR) b) flatten opL x = [(opL, x)] - -- Some children need nesting + -- Called on every operand except the first one (a.k.a RHS) absorbOperation :: Expression -> Doc absorbOperation (Term t) | isAbsorbable t = pretty t + -- Force nested operations to start on a new line + absorbOperation x@(Operation _ _ _) = group' True False $ line <> nest 2 (pretty x) absorbOperation x = nest 2 (pretty x) prettyOperation :: (Maybe Leaf, Expression) -> Doc diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index be39f279..ab6cfe47 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -428,7 +428,8 @@ buildStdenv.mkDerivation ({ # elf-hack is broken when using clang+lld: # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 ++ lib.optional - (ltoSupport + ( + ltoSupport && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64) ) "--disable-elf-hack" diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix index ad2e6417..e0c30b9c 100644 --- a/test/diff/operation/in.nix +++ b/test/diff/operation/in.nix @@ -83,6 +83,10 @@ && cccccccccccccccccccccccccccccccc || ddddddddddddddddd && eeeeeeeeeeeeeeeeeeee || fffffffffffffffffffffffffff then [] else + if aaaaaaaaaaaaaa && bbbbbbbbbbbb && aaaaaaaaaaaaaa && bbbbbbbbbbbb + || cccccccccccccccccccc && ddddddddddddddddd && cccccccccccccccccccc && ddddddddddddddddd + || eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff && eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff + then [] else {} ) @@ -106,4 +110,23 @@ ++ (isOneOf item [1 2 3 4]) ++ isOneOf item [1 2 3 4] ) + # Interaction with function calls + ( + g { + # multiline + y = 20; + } + * f { + # multiline + x = 10; + } + + g { + # multiline + y = 20; + } + * h { + # multiline + z = 30; + } +) ] diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index c02c3c64..73b8ae8c 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -3,8 +3,10 @@ # Filter out git baseName == ".gitignore" || (type == "directory" && baseName == ".git") - || (type == "directory" - && (baseName == "target" + || ( + type == "directory" + && ( + baseName == "target" || baseName == "_site" || baseName == ".sass-cache" || baseName == ".jekyll-metadata" @@ -65,10 +67,11 @@ aaaaaaaaaaaaa aaaaaaaaaaaaa ] - + [ - bbbbbbbbbbbbbb - bbbbbbbbbbbbbbb - ] + + + [ + bbbbbbbbbbbbbb + bbbbbbbbbbbbbbb + ] * [ ccccccccccccccc ccccccccccccccccccc @@ -148,12 +151,15 @@ ) # Test precedence - (aaaaaaaaaaaaaaa + ( + aaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbb + ccccccccccccccccccccccccccc + ddddddddddddddddddddddd * eeeeeeeeeeeeeeeeeeeeeeee - + ffffffffffffffffffffffffff - * gggggggggggggggggggggggg + + + ffffffffffffffffffffffffff + * + gggggggggggggggggggggggg ++ hhhhhhhhhhhhhhhhhhhhhhhhhhh ++ iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii * jjjjjjjjjjjjjjjjjjjjj @@ -177,6 +183,20 @@ || fffffffffffffffffffffffffff then [ ] + else if + aaaaaaaaaaaaaa && bbbbbbbbbbbb && aaaaaaaaaaaaaa && bbbbbbbbbbbb + || + cccccccccccccccccccc + && ddddddddddddddddd + && cccccccccccccccccccc + && ddddddddddddddddd + || + eeeeeeeeeeeeeeeeeeee + && fffffffffffffffffffffffffff + && eeeeeeeeeeeeeeeeeeee + && fffffffffffffffffffffffffff + then + [ ] else { } ) @@ -218,4 +238,24 @@ 4 ] ) + # Interaction with function calls + ( + g { + # multiline + y = 20; + } + * f { + # multiline + x = 10; + } + + + g { + # multiline + y = 20; + } + * h { + # multiline + z = 30; + } + ) ] From 3e16d203a0a2476dfcc033b69e00d5fd66b76cee Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 7 Jun 2023 00:29:01 +0200 Subject: [PATCH 038/125] Don't force-expand (simple) if statements anymore --- src/Nixfmt/Pretty.hs | 5 +- test/diff/attr_set/out.nix | 7 +- test/diff/idioms_lib_1/out.nix | 5 +- test/diff/idioms_lib_2/out.nix | 77 ++-------- test/diff/idioms_lib_3/out.nix | 57 +------- test/diff/idioms_nixos_2/out.nix | 44 ++---- test/diff/idioms_pkgs_3/out.nix | 16 +- test/diff/if_else/out.nix | 242 ++++--------------------------- test/diff/operation/out.nix | 16 +- 9 files changed, 72 insertions(+), 397 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index fb66ef0e..430b8c2d 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -295,11 +295,12 @@ absorbSet = absorb line mempty Nothing absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) + -- Using hardline here is okay because it will only apply to nested ifs, which should not be inline anyways. = hardspace <> (group (pretty if_ <> nest 2 (line <> pretty cond <> line) <> pretty then_)) <> hardline <> nest 2 (group expr0) <> hardline <> pretty else_ <> absorbElse expr1 absorbElse x - = hardline <> nest 2 (group x) + = line <> nest 2 (group x) instance Pretty Expression where pretty (Term t) = pretty t @@ -349,7 +350,7 @@ instance Pretty Expression where = base $ group $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) (groupWithStart if_ (nest 2 (line <> pretty cond <> line) <> pretty then_)) - <> hardline <> nest 2 (group expr0) <> hardline + <> line <> nest 2 (group expr0) <> line <> pretty else_ <> absorbElse expr1 pretty (Abstraction (IDParameter param) colon body) diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 83471b16..b45be0e7 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -110,12 +110,7 @@ more stuff # multiline ] - ++ ( - if foo then - [ bar ] - else - [ baz ] - ) + ++ (if foo then [ bar ] else [ baz ]) ++ [ ] ++ (optionals condition [ more diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix index 50646a88..48fde2de 100644 --- a/test/diff/idioms_lib_1/out.nix +++ b/test/diff/idioms_lib_1/out.nix @@ -6,9 +6,6 @@ msg: # Value to return x: - if pred then - trace msg x - else - x + if pred then trace msg x else x ; } diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index be21f397..85390b12 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -97,33 +97,18 @@ rec { # bitwise “and” bitAnd = - builtins.bitAnd or (import ./zip-int-bits.nix ( - a: b: - if a == 1 && b == 1 then - 1 - else - 0 - )); + builtins.bitAnd + or (import ./zip-int-bits.nix (a: b: if a == 1 && b == 1 then 1 else 0)); # bitwise “or” bitOr = - builtins.bitOr or (import ./zip-int-bits.nix ( - a: b: - if a == 1 || b == 1 then - 1 - else - 0 - )); + builtins.bitOr + or (import ./zip-int-bits.nix (a: b: if a == 1 || b == 1 then 1 else 0)); # bitwise “xor” bitXor = - builtins.bitXor or (import ./zip-int-bits.nix ( - a: b: - if a != b then - 1 - else - 0 - )); + builtins.bitXor + or (import ./zip-int-bits.nix (a: b: if a != b then 1 else 0)); # bitwise “not” bitNot = builtins.sub (-1); @@ -136,13 +121,7 @@ rec { Type: boolToString :: bool -> string */ - boolToString = - b: - if b then - "true" - else - "false" - ; + boolToString = b: if b then "true" else "false"; /* Merge two attribute sets shallowly, right side trumps left @@ -183,10 +162,7 @@ rec { f: # Argument to check for null before passing it to `f` a: - if a == null then - a - else - f a + if a == null then a else f a ; # Pull in some builtins not included elsewhere. @@ -264,22 +240,10 @@ rec { ## Integer operations # Return minimum of two numbers. - min = - x: y: - if x < y then - x - else - y - ; + min = x: y: if x < y then x else y; # Return maximum of two numbers. - max = - x: y: - if x > y then - x - else - y - ; + max = x: y: if x > y then x else y; /* Integer modulus @@ -339,10 +303,7 @@ rec { # Second value to compare b: if p a then - if p b then - yes a b - else - -1 + if p b then yes a b else -1 else if p b then 1 else @@ -406,13 +367,7 @@ rec { Type: bool -> string -> a -> a */ - warnIf = - cond: msg: - if cond then - warn msg - else - id - ; + warnIf = cond: msg: if cond then warn msg else id; /* Like the `assert b; e` expression, but with a custom error message and without the semicolon. @@ -432,13 +387,7 @@ rec { lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays pkgs */ - throwIfNot = - cond: msg: - if cond then - x: x - else - throw msg - ; + throwIfNot = cond: msg: if cond then x: x else throw msg; /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 36f04573..c869bd76 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -106,13 +106,7 @@ rec { mkLine = k: v: mkKeyValue k v + "\n"; mkLines = if listsAsDuplicateKeys then - k: v: - map (mkLine k) ( - if lib.isList v then - v - else - [ v ] - ) + k: v: map (mkLine k) (if lib.isList v then v else [ v ]) else k: v: [ (mkLine k v) ] ; @@ -341,10 +335,7 @@ rec { ]; stepIntoAttr = evalNext: name: - if builtins.elem name specialAttrs then - id - else - evalNext + if builtins.elem name specialAttrs then id else evalNext ; transform = depth: @@ -453,12 +444,7 @@ rec { "''" + introSpace + concatStringsSep introSpace (lib.init escapedLines) - + ( - if lastLine == "" then - outroSpace - else - introSpace + lastLine - ) + + (if lastLine == "" then outroSpace else introSpace + lastLine) + "''" ; in @@ -488,20 +474,11 @@ rec { fna = lib.functionArgs v; showFnas = concatStringsSep ", " ( libAttr.mapAttrsToList - ( - name: hasDefVal: - if hasDefVal then - name + "?" - else - name - ) + (name: hasDefVal: if hasDefVal then name + "?" else name) fna ); in - if fna == { } then - "" - else - "" + if fna == { } then "" else "" else if isAttrs v then # apply pretty values if allowed if allowPrettyValues && v ? __pretty && v ? val then @@ -563,15 +540,7 @@ rec { literal = ind: x: ind + x; - bool = - ind: x: - literal ind ( - if x then - "" - else - "" - ) - ; + bool = ind: x: literal ind (if x then "" else ""); int = ind: x: literal ind "${toString x}"; str = ind: x: literal ind "${x}"; key = ind: x: literal ind "${x}"; @@ -648,19 +617,9 @@ rec { else if isList v then "[ ${concatItems (map (toDhall args) v)} ]" else if isInt v then - "${ - if v < 0 then - "" - else - "+" - }${toString v}" + "${if v < 0 then "" else "+"}${toString v}" else if isBool v then - ( - if v then - "True" - else - "False" - ) + (if v then "True" else "False") else if isFunction v then abort "generators.toDhall: cannot convert a function to Dhall" else if v == null then diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 1def0c35..0e58bba7 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -911,10 +911,7 @@ in let x = cfg.appstoreEnable; in - if x == null then - "false" - else - boolToString x + if x == null then "false" else boolToString x ; nextcloudGreaterOrEqualThan = @@ -1069,30 +1066,14 @@ in # The following attributes are optional depending on the type of # database. Those that evaluate to null on the left hand side # will be omitted. - ${ - if c.dbname != null then - "--database-name" - else - null - } = ''"${c.dbname}"''; - ${ - if c.dbhost != null then - "--database-host" - else - null - } = ''"${c.dbhost}"''; - ${ - if c.dbport != null then - "--database-port" - else - null - } = ''"${toString c.dbport}"''; - ${ - if c.dbuser != null then - "--database-user" - else - null - } = ''"${c.dbuser}"''; + ${if c.dbname != null then "--database-name" else null} = + ''"${c.dbname}"''; + ${if c.dbhost != null then "--database-host" else null} = + ''"${c.dbhost}"''; + ${if c.dbport != null then "--database-port" else null} = + ''"${toString c.dbport}"''; + ${if c.dbuser != null then "--database-user" else null} = + ''"${c.dbuser}"''; "--database-pass" = ''"''$${dbpass.arg}"''; "--admin-user" = ''"${c.adminuser}"''; "--admin-pass" = ''"''$${adminpass.arg}"''; @@ -1326,12 +1307,7 @@ in try_files $fastcgi_script_name =404; fastcgi_param PATH_INFO $path_info; fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; - fastcgi_param HTTPS ${ - if cfg.https then - "on" - else - "off" - }; + fastcgi_param HTTPS ${if cfg.https then "on" else "off"}; fastcgi_param modHeadersAvailable true; fastcgi_param front_controller_active true; fastcgi_pass unix:${fpm.socket}; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index ab6cfe47..bdd2e8bd 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -446,12 +446,7 @@ buildStdenv.mkDerivation ({ (enableFeature sndioSupport "sndio") (enableFeature webrtcSupport "webrtc") (enableFeature debugBuild "debug") - ( - if debugBuild then - "--enable-profiling" - else - "--enable-optimize" - ) + (if debugBuild then "--enable-profiling" else "--enable-optimize") # --enable-release adds -ffunction-sections & LTO that require a big amount # of RAM, and the 32-bit memory space cannot handle that linking (enableFeature (!debugBuild && !stdenv.is32bit) "release") @@ -504,14 +499,7 @@ buildStdenv.mkDerivation ({ zip zlib ] - ++ [ - ( - if (lib.versionAtLeast version "103") then - nss_latest - else - nss_esr - ) - ] + ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] ++ lib.optional alsaSupport alsa-lib ++ lib.optional jackSupport libjack2 ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index e1a64e30..ece53e45 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -1,10 +1,5 @@ [ - ( - if true then - { version = "1.2.3"; } - else - { version = "3.2.1"; } - ) + (if true then { version = "1.2.3"; } else { version = "3.2.1"; }) ( if true then '' @@ -15,18 +10,8 @@ other text '' ) - ( - if ./a then - b - else - c - ) - ( - if a then - b - else - c - ) + (if ./a then b else c) + (if a then b else c) ( if # test a # test @@ -78,12 +63,7 @@ baz ) ( - if - if a then - b - else - c - then + if if a then b else c then b else if a then b @@ -93,12 +73,7 @@ c ) ( - if - if a then - b - else - c - then + if if a then b else c then b else if a then b @@ -113,225 +88,72 @@ ( if ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) then ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) else ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) ) then ( if ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) then ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) else ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) ) else ( if ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) then ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) else ( - if - ( - if a then - b - else - c - ) - then - ( - if a then - b - else - c - ) + if (if a then b else c) then + (if a then b else c) else - ( - if a then - b - else - c - ) + (if a then b else c) ) ) ) diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 73b8ae8c..5f08c0ee 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -137,12 +137,7 @@ more stuff # multiline ] - ++ ( - if foo then - [ bar ] - else - [ baz ] - ) + ++ (if foo then [ bar ] else [ baz ]) ++ [ ] ++ (optionals condition [ more @@ -208,14 +203,7 @@ zip zlib ] - ++ [ - ( - if (lib.versionAtLeast version "103") then - nss_latest - else - nss_esr - ) - ] + ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] ) # Indentation with parenthesized multiline function call From db2c93819699fe5d9d94a97bc568e870ca1fc58f Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 7 Jun 2023 01:29:18 +0200 Subject: [PATCH 039/125] Special case binary operators If we know that there are going to be two arguments at most, using a more compact form is fine --- src/Nixfmt/Pretty.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 430b8c2d..769fdb7e 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -395,6 +395,10 @@ instance Pretty Expression where -- '//' operator pretty (Operation a op@(Ann _ TUpdate _) b) = pretty a <> softline <> pretty op <> hardspace <> pretty b + -- binary operators + pretty (Operation a op@(Ann _ op' _) b) + | op' == TLess || op' == TGreater || op' == TLessEqual || op' == TGreaterEqual || op' == TEqual || op' == TUnequal + = pretty a <> softline <> pretty op <> hardspace <> pretty b -- all other operators pretty operation@(Operation _ op _) = let From 66ac4b49762a13552c01c6b5c5c019ccc08fc596 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 8 Jun 2023 15:57:13 +0200 Subject: [PATCH 040/125] Improve error message on verify Even if this is an "internal" error that requires users to file a bug report, at the end there still will be some developer who has to debug it. (It's me, I'm a developer who has to debug it) --- src/Nixfmt.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Nixfmt.hs b/src/Nixfmt.hs index ff0fcff1..ab83aa79 100644 --- a/src/Nixfmt.hs +++ b/src/Nixfmt.hs @@ -12,7 +12,7 @@ module Nixfmt ) where import Data.Bifunctor (bimap, first) -import Data.Text (Text) +import Data.Text (Text, unpack) import qualified Text.Megaparsec as Megaparsec (parse) import Text.Megaparsec.Error (errorBundlePretty) @@ -40,7 +40,7 @@ formatVerify width path unformatted = do if formattedOnceParsed /= unformattedParsed then pleaseReport "Parses differently after formatting." else if formattedOnce /= formattedTwice - then pleaseReport "Nixfmt is not idempotent." + then flip first (pleaseReport "Nixfmt is not idempotent.") $ \x -> (x <> "\nAfter one formatting:\n" <> unpack formattedOnce <> "\nAfter two:\n" <> unpack formattedTwice) else Right formattedOnce where parse = first errorBundlePretty . Megaparsec.parse file path From 5a8eb618eb9ae64a07a129a8b9a2b7985ca414e5 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 8 Jun 2023 15:58:12 +0200 Subject: [PATCH 041/125] Improve layouting algorithm - Introduced the concept of "priority" groups - If a group does not fit into one line but contains a priority group, try to expand that first and see how much fits into the line. - Some whitespaces in groups are not automatically moved out anymore. - This allows us to drop the two boolean attributes on Group which previously controlled the move-in behavior. - This required some small fixes around existing code, who worked under the previous assumption of this not making any difference - To reduce error potential, groups are forbidden to start or end with whitespace. group' needs to be used as an opt-in instead. - Refactored nesting indentation handling - This fixes the issue that indentation might be wrong if the indentation block ends with some newline whitespace. In that case, the token following it would get the indentation of the block, despite being outside of it. - This is solved by not applying indentation on newlines right away. Instead, that is deferred until actually writing the first token in that line. That way, we are guaranteed to use the correct indentation for that token. - Those changes made the `moveLinesIn` method redundant, as the layouting algorithm now is powerful enough to properly work without that normalization step. Performance impact has not been evaluated. --- src/Nixfmt/Predoc.hs | 227 ++++++++++++++++++++++---------- src/Nixfmt/Pretty.hs | 51 +++---- test/diff/idioms_pkgs_4/in.nix | 170 ++++++++++++++++++++++++ test/diff/idioms_pkgs_4/out.nix | 216 ++++++++++++++++++++++++++++++ 4 files changed, 570 insertions(+), 94 deletions(-) create mode 100644 test/diff/idioms_pkgs_4/in.nix create mode 100644 test/diff/idioms_pkgs_4/out.nix diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 4258830f..aa8536a3 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -33,7 +33,14 @@ module Nixfmt.Predoc ) where import Data.List (intersperse) +import Data.Function ((&)) +import Data.Functor ((<&>)) +import Data.Maybe (isNothing, fromMaybe) import Data.Text as Text (Text, concat, length, pack, replicate, strip) +import GHC.Stack (HasCallStack) +-- import Debug.Trace (traceShow) +import Control.Monad (guard) +import Control.Applicative ((<|>)) -- | Sequential Spacings are reduced to a single Spacing by taking the maximum. -- This means that e.g. a Space followed by an Emptyline results in just an @@ -63,11 +70,16 @@ data DocAnn -- in docs should be converted to line breaks. This does not affect softlines, -- those will be expanded only as necessary and with a lower priority. -- - -- The boolean arguments determine how to handle whitespace directly before/after the - -- group or at the start/end of the group. By default (False), it gets pulled out the - -- group, which is what you want in most cases. If set to True, - -- whitespace before/after the group will be pulled in instead. - = Group Bool Bool + -- The boolean argument makes a group a "high priority" group. You should almost + -- never need this (it was introduced purely to accomodate for some Application special + -- handling). Groups containing priority groups are treated as having three segments: + -- pre, prio and post. + -- If any group contains a priority group, the following happens: + -- If it entirely fits on one line, render on one line (as usual). + -- If it does not fit on one line, but pre does, but prio doesn't, then only expand prio + -- In all other cases, including when only pre and prio fit into one line, fully expand the group. + -- Groups containing multiple priority groups are not supported at the momen. + = Group Bool -- | Node (Nest n) doc indicates all line starts in doc should be indented -- by n more spaces than the surrounding Base. | Nest Int @@ -107,25 +119,37 @@ text "" = [] text t = [Text t] -- | Group document elements together (see Node Group documentation) --- Any whitespace at the start of the group will get pulled out in front of it. -group :: Pretty a => a -> Doc -group = pure . Node (Group False False) . pretty +-- 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 . Node (Group False) $ + 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 + p + where p = pretty x -- | Group document elements together (see Node Group documentation) --- Any whitespace directly before and/or after the group will be pulled into it. +-- Is allowed to start or end with any kind of whitespace. -- Use with caution, and only in situations where you control the surroundings of -- that group. Especially, never use as a top-level element of a `pretty` instance, -- or you'll get some *very* confusing bugs … -group' :: Pretty a => Bool -> Bool -> a -> Doc -group' pre post = pure . Node (Group pre post) . pretty +-- +-- Also allows to create priority groups (see Node Group documentation) +group' :: Pretty a => Bool -> a -> Doc +group' prio = pure . Node (Group prio) . pretty -- | @nest n doc@ sets the indentation for lines in @doc@ to @n@ more than the -- indentation of the part before it. This is based on the actual indentation of -- the line, rather than the indentation it should have used: If multiple -- indentation levels start on the same line, only the last indentation level -- will be applied on the next line. This prevents unnecessary nesting. -nest :: Int -> Doc -> Doc -nest level = pure . Node (Nest level) +nest :: HasCallStack => Int -> Doc -> Doc +nest level x = pure . Node (Nest level) $ + if x /= [] && (isSoftSpacing (head x) || isSoftSpacing (last x)) then + error $ "nest should not start or end with whitespace; " <> show x + else + x base :: Doc -> Doc base = pure . Node Base @@ -168,28 +192,39 @@ sepBy separator = mconcat . intersperse separator . map pretty hcat :: Pretty a => [a] -> Doc hcat = mconcat . map pretty -isSpacing :: DocE -> Bool -isSpacing (Spacing _) = True -isSpacing _ = False +-- Everything that may change representation depending on grouping +isSoftSpacing :: DocE -> Bool +isSoftSpacing (Spacing Softbreak) = True +isSoftSpacing (Spacing Break) = True +isSoftSpacing (Spacing Softspace) = True +isSoftSpacing (Spacing Space) = True +isSoftSpacing _ = False + +-- Everything else +isHardSpacing :: DocE -> Bool +isHardSpacing (Spacing Hardspace) = True +isHardSpacing (Spacing Hardline) = True +isHardSpacing (Spacing Emptyline) = True +isHardSpacing (Spacing (Newlines _)) = True +isHardSpacing _ = False spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) spanEnd p = fmap reverse . span p . reverse -- | Fix up a Doc in multiple stages: --- - First, all spacings are moved out of Groups and Nests and empty Groups and +-- - First, some spacings are moved out of Groups and Nests and empty Groups and -- Nests are removed. --- - Now, all consecutive Spacings are ensured to be in the same list, so each --- sequence of Spacings can be merged into a single one. --- - Finally, Spacings right before a Nest should be moved inside in order to --- get the right indentation. +-- - Merge consecutive spacings. When merging across group/nest boundaries, the merged +-- spacing will be on the "inside" (part of the group). +-- - This may move hard spacing in, so we need to move them out again fixup :: Doc -> Doc -fixup = moveLinesIn . mergeLines . concatMap moveLinesOut +fixup = concatMap moveLinesOut . mergeLines' . mergeLines . concatMap moveLinesOut moveLinesOut :: DocE -> Doc moveLinesOut (Node ann xs) = let movedOut = concatMap moveLinesOut xs - (pre, rest) = span isSpacing movedOut - (post, body) = spanEnd isSpacing rest + (pre, rest) = span isHardSpacing movedOut + (post, body) = spanEnd isHardSpacing rest in case body of [] -> pre ++ post _ -> pre ++ (Node ann body : post) @@ -207,6 +242,8 @@ mergeSpacings Hardspace (Newlines x) = Newlines x mergeSpacings _ (Newlines x) = Newlines (x + 1) mergeSpacings _ y = y +-- Merge whitespace and text elements across the document, but not across Node boundaries. +-- After running, any nodes are guaranteed to start/end with at most one whitespace element respectively. mergeLines :: Doc -> Doc mergeLines [] = [] mergeLines (Spacing a : Spacing b : xs) = mergeLines $ Spacing (mergeSpacings a b) : xs @@ -214,22 +251,31 @@ mergeLines (Text a : Text b : xs) = mergeLines $ Text (a <> b) : xs mergeLines (Node ann xs : ys) = Node ann (mergeLines xs) : mergeLines ys mergeLines (x : xs) = x : mergeLines xs -moveLinesIn :: Doc -> Doc -moveLinesIn [] = [] --- Move space before Nest in -moveLinesIn (Spacing l : Node (Nest level) xs : ys) = - moveLinesIn ((Node (Nest level) (Spacing l : xs)) : ys) --- Move space before (Group True _) in -moveLinesIn (Spacing l : Node ann@(Group True _) xs : ys) = - moveLinesIn ((Node ann (Spacing l : xs)) : ys) --- Move space after (Group _ True) in -moveLinesIn (Node ann@(Group _ True) xs : Spacing l : ys) = - moveLinesIn ((Node ann (xs ++ [Spacing l])) : ys) - -moveLinesIn (Node ann xs : ys) = - Node ann (moveLinesIn xs) : moveLinesIn ys - -moveLinesIn (x : xs) = x : moveLinesIn xs +startsWithWhitespace :: Doc -> Bool +startsWithWhitespace (s : _) | isSoftSpacing s = True +startsWithWhitespace ((Node _ inner) : _) = startsWithWhitespace inner +startsWithWhitespace _ = False + +endsWithWhitespace :: Doc -> Bool +endsWithWhitespace (s : []) | isSoftSpacing s = True +endsWithWhitespace ((Node _ inner) : []) = endsWithWhitespace inner +endsWithWhitespace (_ : xs) = endsWithWhitespace xs +endsWithWhitespace _ = False + +-- Merge whitespace across group borders +mergeLines' :: Doc -> Doc +mergeLines' [] = [] +-- Merge things that got moved together +mergeLines' (Spacing a : Spacing b : xs) = mergeLines' $ Spacing (mergeSpacings a b) : xs +-- Move spacing in front of groups in if they can be merged +mergeLines' (Spacing a : Node ann (xs) : ys) | startsWithWhitespace xs = + mergeLines' $ Node ann (Spacing a : xs) : ys +-- Merge spacings after groups in if they can be merged +mergeLines' (Node ann xs : Spacing a : ys) | endsWithWhitespace xs = + mergeLines' $ Node ann (xs ++ [Spacing a]) : ys +mergeLines' (Node ann xs : ys) = + Node ann (mergeLines' xs) : mergeLines' ys +mergeLines' (x : xs) = x : mergeLines' xs layout :: Pretty a => Int -> a -> Text layout w = (<>"\n") . Text.strip . layoutGreedy w . fixup . pretty @@ -240,6 +286,10 @@ layout w = (<>"\n") . Text.strip . layoutGreedy w . fixup . pretty -- 4. For each Group, if it fits on a single line, render it that way. -- 5. If not, convert lines to hardlines and unwrap the group +isPriorityGroup :: DocE -> Bool +isPriorityGroup (Node (Group True) _) = True +isPriorityGroup _ = False + -- | To support i18n, this function needs to be patched. textWidth :: Text -> Int textWidth = Text.length @@ -269,7 +319,7 @@ firstLineWidth (Spacing Hardspace : xs) = 1 + firstLineWidth xs firstLineWidth (Spacing _ : _) = 0 firstLineWidth (Node _ xs : ys) = firstLineWidth (xs ++ ys) --- | Check if the first line in a list of documents fits a target width given +-- | Check if the first line in a document fits a target width given -- a maximum width, without breaking up groups. firstLineFits :: Int -> Int -> Doc -> Bool firstLineFits targetWidth maxWidth docs = go maxWidth docs @@ -278,19 +328,29 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs go c (Text t : xs) = go (c - textWidth t) xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth - go c (Node (Group _ _) ys : xs) = + go c (Node (Group _) ys : xs) = case fits (c - firstLineWidth xs) ys of Nothing -> go c (ys ++ xs) Just t -> go (c - textWidth t) xs go c (Node _ ys : xs) = go c (ys ++ xs) +-- Calculate the amount of indentation until the first token +firstLineIndent :: Doc -> Int +firstLineIndent ((Node (Nest n) xs) : _) = n + firstLineIndent xs +firstLineIndent ((Node _ xs) : _) = firstLineIndent xs +firstLineIndent _ = 0 + -- | A document element with target indentation data Chunk = Chunk Int DocE --- | Create `n` newlines and `i` spaces -indent :: Int -> Int -> Text -indent n i = Text.replicate n "\n" <> Text.replicate i " " +-- | Create `n` newlines +newlines :: Int -> Text +newlines n = Text.replicate n "\n" + +-- | Create `n` spaces +indent :: Int -> Text +indent n = Text.replicate n " " unChunk :: Chunk -> DocE unChunk (Chunk _ doc) = doc @@ -303,37 +363,66 @@ unChunk (Chunk _ doc) = doc -- Only for the tokens starting on the next line the current -- indentation will match the target indentation. layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False False) doc] +layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] where go :: Int -> Int -> [Chunk] -> [Text] go _ _ [] = [] - go cc ci (Chunk ti x : xs) = case x of - Text t -> t : go (cc + textWidth t) ci xs + go cc ci (Chunk ti x : xs) = + let + needsIndent = (cc == 0) + -- next column, if we print some non-whitespace characters + nc = if needsIndent then ti else cc + -- Start of line indentation, if necessary + lineStart = if needsIndent then indent ti else "" + in + case x of + Text t -> lineStart : t : go (nc + textWidth t) ci xs -- This code treats whitespace as "expanded" - Spacing Break -> indent 1 ti : go ti ti xs - Spacing Space -> indent 1 ti : go ti ti xs - Spacing Hardspace -> " " : go (cc + 1) ci xs - Spacing Hardline -> indent 1 ti : go ti ti xs - Spacing Emptyline -> indent 2 ti : go ti ti xs - Spacing (Newlines n) -> indent n ti : go ti ti xs + -- A new line resets the column counter and sets the target indentation as current indentation + Spacing Break -> newlines 1 : go 0 ti xs + Spacing Space -> newlines 1 : go 0 ti xs + Spacing Hardspace -> " " : go (cc + 1) ci xs + Spacing Hardline -> newlines 1 : go 0 ti xs + Spacing Emptyline -> newlines 2 : go 0 ti xs + Spacing (Newlines n) -> newlines n : go 0 ti xs Spacing Softbreak - | firstLineFits (tw - cc) (tw - ti) (map unChunk xs) - -> go cc ci xs - | otherwise -> indent 1 ti : go ti ti xs + | firstLineFits (tw - nc) (tw - ti) (map unChunk xs) + -> go cc ci xs + | otherwise -> newlines 1 : go 0 ti xs Spacing Softspace - | firstLineFits (tw - cc - 1) (tw - ti) (map unChunk xs) - -> " " : go (cc + 1) ci xs - | otherwise -> indent 1 ti : go ti ti xs + | firstLineFits (tw - nc - 1) (tw - ti) (map unChunk xs) + -> " " : go (cc + 1) ci xs + | otherwise -> newlines 1 : go 0 ti xs - Node (Nest l) ys -> go cc ci $ map (Chunk (ti + l)) ys ++ xs + Node (Nest l) ys -> go cc (if needsIndent then ti + l else ci) $ map (Chunk (ti + l)) ys ++ xs Node Base ys -> go cc ci $ map (Chunk ci) ys ++ xs - Node (Group _ _) ys -> - -- Does the group (plus whatever comes after it on that line) fit in one line? - -- This is where treating whitespace as "compact" happens - case fits (tw - cc - firstLineWidth (map unChunk xs)) ys of - -- Dissolve the group by mapping its members to the target indentation - -- This also implies that whitespace in there will now be rendered "expanded" - Nothing -> go cc ci $ map (Chunk ti) ys ++ xs - Just t -> t : go (cc + textWidth t) ci xs + Node (Group _) ys -> + let + -- Does the group (plus whatever comes after it on that line) fit in one line? + -- This is where treating whitespace as "compact" happens + handleGroup :: Doc -> [Chunk] -> Maybe [Text] + handleGroup pre post = + if needsIndent then + let i = ti + firstLineIndent pre in + fits (tw - i - firstLineWidth (map unChunk post)) pre + <&> \t -> indent i : t : go (i + textWidth t) ci post + else + fits (tw - cc - firstLineWidth (map unChunk post)) pre + <&> \t -> t : go (cc + textWidth t) ci post + in + -- Try to fit the entire group first + handleGroup ys xs + -- If that fails, check whether the group contains any priority groups as its children and try to expand them first + <|> do + -- Split up on the first priority group + (pre, prio : post) <- Just (break isPriorityGroup ys) + -- Make sure to exclude the case where pre and prio fit onto the line but not post. + -- This would look weird and also not be true to the intended semantics for priority groups. + guard . isNothing $ handleGroup (pre ++ [prio]) (Chunk ti (Node (Group False) post) : xs) + -- Try to fit pre onto one line (with prio expanded, also need to re-group post) + handleGroup pre ([Chunk ti prio, Chunk ti (Node (Group False) post)] ++ xs) + -- Otherwise, dissolve the group by mapping its members to the target indentation + -- This also implies that whitespace in there will now be rendered "expanded" + & fromMaybe (go cc ci $ map (Chunk ti) ys ++ xs) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 769fdb7e..d4fd811a 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -26,6 +26,7 @@ import Nixfmt.Types StringPart(..), Term(..), Token(..), TrailingComment(..), Trivia, Trivium(..), Whole(..), tokenText, mapFirstToken') import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) +import GHC.Stack (HasCallStack) prettyCommentLine :: Text -> Doc prettyCommentLine l @@ -39,7 +40,7 @@ toLineComment c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c -- leading comments. This will render both arguments as a group, but -- if the first argument has some leading comments they will be put before -- the group -groupWithStart :: Pretty a => Ann a -> Doc -> Doc +groupWithStart :: HasCallStack => Pretty a => Ann a -> Doc -> Doc groupWithStart (Ann leading a trailing) b = pretty leading <> group (pretty a <> pretty trailing <> b) @@ -90,7 +91,7 @@ instance Pretty Selector where pretty (Selector dot sel (Just (kw, def))) = base $ pretty dot <> pretty sel - <> nest 2 (softline <> pretty kw <> hardspace <> pretty def) + <> softline <> nest 2 (pretty kw <> hardspace <> pretty def) -- in attrsets and let bindings instance Pretty Binder where @@ -101,16 +102,16 @@ instance Pretty Binder where -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) - = base $ group (pretty inherit <> hardspace <> nest 2 ( - (group' True False (line <> pretty source)) <> line + = base $ group (pretty inherit <> nest 2 ( + (group' False (line <> pretty source)) <> line <> sepBy line ids <> line' <> pretty semicolon )) -- `foo = bar` pretty (Assignment selectors assign expr semicolon) - = base $ group $ hcat selectors <> hardspace - <> nest 2 (pretty assign <> inner) + = base $ group $ hcat selectors + <> nest 2 (hardspace <> pretty assign <> inner) where inner = case expr of @@ -118,18 +119,18 @@ instance Pretty Binder where (Term t) | isAbsorbable t -> hardspace <> group expr <> pretty semicolon -- Non-absorbable term -- If it is multi-line, force it to start on a new line with indentation - (Term _) -> group' True False (line <> pretty expr) <> pretty semicolon + (Term _) -> group' False (line <> pretty expr) <> pretty semicolon -- Function calls and with expressions -- Try to absorb and keep the semicolon attached, spread otherwise - (Application _ _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) - (With _ _ _ _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) + (Application _ _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) + (With _ _ _ _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) -- Special case `//` operator to treat like an absorbable term - (Operation _ (Ann _ TUpdate _) _) -> group (softline <> pretty expr <> softline' <> pretty semicolon) + (Operation _ (Ann _ TUpdate _) _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) -- 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) -- Otherwise, start on new line, expand fully (including the semicolon) - _ -> group (line <> pretty expr <> line' <> pretty semicolon) + _ -> line <> group (pretty expr <> line' <> pretty semicolon) -- | Pretty print a term without wrapping it in a group. prettyTerm :: Term -> Doc @@ -155,7 +156,7 @@ prettyTerm (List (Ann leading paropen Nothing) (Items [CommentedItem [] item]) ( <> (if isAbsorbable item then (hardspace <> pretty item <> hardspace) else - (nest 2 (line <> pretty item <> line)) + (line <> nest 2 (pretty item) <> line) ) <> pretty parclose <> pretty trailing -- General list (len >= 2) @@ -170,7 +171,7 @@ prettyTerm (List (Ann [] paropen trailing) items parclose) prettyTerm (List paropen items parclose) = base $ groupWithStart paropen $ line - <> nest 2 (prettyItems line items) <> line + <> nest 2 (prettyItems hardline items) <> line <> pretty parclose -- Empty, non-recursive attribute set @@ -186,13 +187,13 @@ prettyTerm (Set krec paropen binders parclose) -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = base $ groupWithStart paropen (nest 2 (lineL <> group expr <> lineR) <> pretty parclose) + = base $ groupWithStart paropen (lineL <> nest 2 (group expr) <> lineR <> pretty parclose) where (lineL, lineR) = case expr of -- Start on the same line for these (Term t) | isAbsorbable t -> (mempty, mempty) - -- Also absorb function calls (even though this rarely looks weird) + -- Also absorb function calls (even though this occasionally looks weird) (Application _ _) -> (mempty, mempty) -- Absorb function declarations but only those with simple parameter(s) (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> (mempty, mempty) @@ -229,13 +230,13 @@ instance Pretty ParamAttr where -- Simple parameter -- Still need to handle missing trailing comma here, because the special cases above are not exhaustive pretty (ParamAttr name Nothing maybeComma) - = pretty name <> (fromMaybe (text ",") (fmap pretty maybeComma)) <> softline + = pretty name <> (fromMaybe (text ",") (fmap pretty maybeComma)) -- With ? default pretty (ParamAttr name (Just (qmark, def)) maybeComma) = group (pretty name <> hardspace <> pretty qmark <> absorb softline mempty (Just 2) def) - <> (fromMaybe (text ",") (fmap pretty maybeComma)) <> softline + <> (fromMaybe (text ",") (fmap pretty maybeComma)) -- `...` pretty (ParamEllipsis ellipsis) @@ -296,7 +297,7 @@ absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) -- Using hardline here is okay because it will only apply to nested ifs, which should not be inline anyways. - = hardspace <> (group (pretty if_ <> nest 2 (line <> pretty cond <> line) <> pretty then_)) + = hardspace <> (group (pretty if_ <> line <> nest 2 (pretty cond) <> line <> pretty then_)) <> hardline <> nest 2 (group expr0) <> hardline <> pretty else_ <> absorbElse expr1 absorbElse x @@ -349,7 +350,7 @@ instance Pretty Expression where pretty (If if_ cond then_ expr0 else_ expr1) = base $ group $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - (groupWithStart if_ (nest 2 (line <> pretty cond <> line) <> pretty then_)) + (groupWithStart if_ (line <> nest 2 (pretty cond) <> line <> pretty then_)) <> line <> nest 2 (group expr0) <> line <> pretty else_ <> absorbElse expr1 @@ -390,7 +391,7 @@ instance Pretty Expression where (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f in pretty comment <> (group $ - (group' False True $ absorbApp fWithoutComment <> line) <> absorbLast a) + (group' False $ absorbApp fWithoutComment <> line) <> absorbLast a) -- '//' operator pretty (Operation a op@(Ann _ TUpdate _) b) @@ -409,19 +410,19 @@ instance Pretty Expression where 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) + -- Called on every operand except the first one (a.k.a. RHS) absorbOperation :: Expression -> Doc - absorbOperation (Term t) | isAbsorbable t = pretty t + absorbOperation (Term t) | isAbsorbable t = hardspace <> pretty t -- Force nested operations to start on a new line - absorbOperation x@(Operation _ _ _) = group' True False $ line <> nest 2 (pretty x) - absorbOperation x = nest 2 (pretty x) + absorbOperation x@(Operation _ _ _) = group' False $ line <> nest 2 (pretty x) + absorbOperation x = nest 2 (hardspace <> pretty x) prettyOperation :: (Maybe Leaf, Expression) -> Doc -- First element prettyOperation (Nothing, expr) = pretty expr -- The others -- TODO when expr contains a comment or op' has a trailing comment, move them before op' - prettyOperation ((Just op'), expr) = line <> pretty op' <> hardspace <> absorbOperation expr + prettyOperation ((Just op'), expr) = line <> pretty op' <> absorbOperation expr -- Extract comment before the first operand and move it out, to prevent force-expanding the expression (operationWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) operation diff --git a/test/diff/idioms_pkgs_4/in.nix b/test/diff/idioms_pkgs_4/in.nix new file mode 100644 index 00000000..bae4ff2c --- /dev/null +++ b/test/diff/idioms_pkgs_4/in.nix @@ -0,0 +1,170 @@ +{ lib +, localSystem, crossSystem, config, overlays, crossOverlays ? [] +}: + +assert crossSystem == localSystem; + +let + inherit (localSystem) system; + + shell = + if system == "i686-freebsd" || system == "x86_64-freebsd" then "/usr/local/bin/bash" + else "/bin/bash"; + + path = + (lib.optionals (system == "i686-solaris") [ "/usr/gnu" ]) ++ + (lib.optionals (system == "i686-netbsd") [ "/usr/pkg" ]) ++ + (lib.optionals (system == "x86_64-solaris") [ "/opt/local/gnu" ]) ++ + ["/" "/usr" "/usr/local"]; + + prehookBase = '' + # Disable purity tests; it's allowed (even needed) to link to + # libraries outside the Nix store (like the C library). + export NIX_ENFORCE_PURITY= + export NIX_ENFORCE_NO_NATIVE="''${NIX_ENFORCE_NO_NATIVE-1}" + ''; + + prehookFreeBSD = '' + ${prehookBase} + + alias make=gmake + alias tar=gtar + alias sed=gsed + export MAKE=gmake + shopt -s expand_aliases + ''; + + prehookOpenBSD = '' + ${prehookBase} + + alias make=gmake + alias grep=ggrep + alias mv=gmv + alias ln=gln + alias sed=gsed + alias tar=gtar + + export MAKE=gmake + shopt -s expand_aliases + ''; + + prehookNetBSD = '' + ${prehookBase} + + alias make=gmake + alias sed=gsed + alias tar=gtar + export MAKE=gmake + shopt -s expand_aliases + ''; + + # prevent libtool from failing to find dynamic libraries + prehookCygwin = '' + ${prehookBase} + + shopt -s expand_aliases + export lt_cv_deplibs_check_method=pass_all + ''; + + extraNativeBuildInputsCygwin = [ + ../cygwin/all-buildinputs-as-runtimedep.sh + ../cygwin/wrap-exes-to-find-dlls.sh + ] ++ (if system == "i686-cygwin" then [ + ../cygwin/rebase-i686.sh + ] else if system == "x86_64-cygwin" then [ + ../cygwin/rebase-x86_64.sh + ] else []); + + # A function that builds a "native" stdenv (one that uses tools in + # /usr etc.). + makeStdenv = + { cc, fetchurl, extraPath ? [], overrides ? (self: super: { }), extraNativeBuildInputs ? [] }: + + import ../generic { + buildPlatform = localSystem; + hostPlatform = localSystem; + targetPlatform = localSystem; + + preHook = + if system == "i686-freebsd" then prehookFreeBSD else + if system == "x86_64-freebsd" then prehookFreeBSD else + if system == "i686-openbsd" then prehookOpenBSD else + if system == "i686-netbsd" then prehookNetBSD else + if system == "i686-cygwin" then prehookCygwin else + if system == "x86_64-cygwin" then prehookCygwin else + prehookBase; + + extraNativeBuildInputs = extraNativeBuildInputs ++ + (if system == "i686-cygwin" then extraNativeBuildInputsCygwin else + if system == "x86_64-cygwin" then extraNativeBuildInputsCygwin else + []); + + initialPath = extraPath ++ path; + + fetchurlBoot = fetchurl; + + inherit shell cc overrides config; + }; + +in + +[ + + ({}: rec { + __raw = true; + + stdenv = makeStdenv { + cc = null; + fetchurl = null; + }; + stdenvNoCC = stdenv; + + cc = let + nativePrefix = { # switch + i686-solaris = "/usr/gnu"; + x86_64-solaris = "/opt/local/gcc47"; + }.${system} or "/usr"; + in + import ../../build-support/cc-wrapper { + name = "cc-native"; + nativeTools = true; + nativeLibc = true; + inherit lib nativePrefix; + bintools = import ../../build-support/bintools-wrapper { + name = "bintools"; + inherit lib stdenvNoCC nativePrefix; + nativeTools = true; + nativeLibc = true; + }; + inherit stdenvNoCC; + }; + + fetchurl = import ../../build-support/fetchurl { + inherit lib stdenvNoCC; + # Curl should be in /usr/bin or so. + curl = null; + }; + + }) + + # First build a stdenv based only on tools outside the store. + (prevStage: { + inherit config overlays; + stdenv = makeStdenv { + inherit (prevStage) cc fetchurl; + } // { inherit (prevStage) fetchurl; }; + }) + + # Using that, build a stdenv that adds the ‘xz’ command (which most systems + # don't have, so we mustn't rely on the native environment providing it). + (prevStage: { + inherit config overlays; + stdenv = makeStdenv { + inherit (prevStage.stdenv) cc fetchurl; + extraPath = [ prevStage.xz ]; + overrides = self: super: { inherit (prevStage) xz; }; + extraNativeBuildInputs = if localSystem.isLinux then [ prevStage.patchelf ] else []; + }; + }) + +] diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix new file mode 100644 index 00000000..21da7714 --- /dev/null +++ b/test/diff/idioms_pkgs_4/out.nix @@ -0,0 +1,216 @@ +{ + lib, + localSystem, + crossSystem, + config, + overlays, + crossOverlays ? [ ], +}: + +assert crossSystem == localSystem; + +let + inherit (localSystem) system; + + shell = + if system == "i686-freebsd" || system == "x86_64-freebsd" then + "/usr/local/bin/bash" + else + "/bin/bash" + ; + + path = + (lib.optionals (system == "i686-solaris") [ "/usr/gnu" ]) + ++ (lib.optionals (system == "i686-netbsd") [ "/usr/pkg" ]) + ++ (lib.optionals (system == "x86_64-solaris") [ "/opt/local/gnu" ]) + ++ [ + "/" + "/usr" + "/usr/local" + ] + ; + + prehookBase = '' + # Disable purity tests; it's allowed (even needed) to link to + # libraries outside the Nix store (like the C library). + export NIX_ENFORCE_PURITY= + export NIX_ENFORCE_NO_NATIVE="''${NIX_ENFORCE_NO_NATIVE-1}" + ''; + + prehookFreeBSD = '' + ${prehookBase} + + alias make=gmake + alias tar=gtar + alias sed=gsed + export MAKE=gmake + shopt -s expand_aliases + ''; + + prehookOpenBSD = '' + ${prehookBase} + + alias make=gmake + alias grep=ggrep + alias mv=gmv + alias ln=gln + alias sed=gsed + alias tar=gtar + + export MAKE=gmake + shopt -s expand_aliases + ''; + + prehookNetBSD = '' + ${prehookBase} + + alias make=gmake + alias sed=gsed + alias tar=gtar + export MAKE=gmake + shopt -s expand_aliases + ''; + + # prevent libtool from failing to find dynamic libraries + prehookCygwin = '' + ${prehookBase} + + shopt -s expand_aliases + export lt_cv_deplibs_check_method=pass_all + ''; + + extraNativeBuildInputsCygwin = + [ + ../cygwin/all-buildinputs-as-runtimedep.sh + ../cygwin/wrap-exes-to-find-dlls.sh + ] + ++ ( + if system == "i686-cygwin" then + [ ../cygwin/rebase-i686.sh ] + else if system == "x86_64-cygwin" then + [ ../cygwin/rebase-x86_64.sh ] + else + [ ] + ) + ; + + # A function that builds a "native" stdenv (one that uses tools in + # /usr etc.). + makeStdenv = + { + cc, + fetchurl, + extraPath ? [ ], + overrides ? (self: super: { }), + extraNativeBuildInputs ? [ ], + }: + + import ../generic { + buildPlatform = localSystem; + hostPlatform = localSystem; + targetPlatform = localSystem; + + preHook = + if system == "i686-freebsd" then + prehookFreeBSD + else if system == "x86_64-freebsd" then + prehookFreeBSD + else if system == "i686-openbsd" then + prehookOpenBSD + else if system == "i686-netbsd" then + prehookNetBSD + else if system == "i686-cygwin" then + prehookCygwin + else if system == "x86_64-cygwin" then + prehookCygwin + else + prehookBase + ; + + extraNativeBuildInputs = + extraNativeBuildInputs + ++ ( + if system == "i686-cygwin" then + extraNativeBuildInputsCygwin + else if system == "x86_64-cygwin" then + extraNativeBuildInputsCygwin + else + [ ] + ) + ; + + initialPath = extraPath ++ path; + + fetchurlBoot = fetchurl; + + inherit shell cc overrides config; + } + ; +in + +[ + + ( + { }: + rec { + __raw = true; + + stdenv = makeStdenv { + cc = null; + fetchurl = null; + }; + stdenvNoCC = stdenv; + + cc = + let + nativePrefix = + { # switch + i686-solaris = "/usr/gnu"; + x86_64-solaris = "/opt/local/gcc47"; + } + .${system} or "/usr"; + in + import ../../build-support/cc-wrapper { + name = "cc-native"; + nativeTools = true; + nativeLibc = true; + inherit lib nativePrefix; + bintools = import ../../build-support/bintools-wrapper { + name = "bintools"; + inherit lib stdenvNoCC nativePrefix; + nativeTools = true; + nativeLibc = true; + }; + inherit stdenvNoCC; + } + ; + + fetchurl = import ../../build-support/fetchurl { + inherit lib stdenvNoCC; + # Curl should be in /usr/bin or so. + curl = null; + }; + } + ) + + # First build a stdenv based only on tools outside the store. + (prevStage: { + inherit config overlays; + stdenv = makeStdenv { inherit (prevStage) cc fetchurl; } // { + inherit (prevStage) fetchurl; + }; + }) + + # Using that, build a stdenv that adds the ‘xz’ command (which most systems + # don't have, so we mustn't rely on the native environment providing it). + (prevStage: { + inherit config overlays; + stdenv = makeStdenv { + inherit (prevStage.stdenv) cc fetchurl; + extraPath = [ prevStage.xz ]; + overrides = self: super: { inherit (prevStage) xz; }; + extraNativeBuildInputs = + if localSystem.isLinux then [ prevStage.patchelf ] else [ ]; + }; + }) +] From eeb25346eded82857ef87b42cfdb2c9ea0714f04 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 8 Jun 2023 16:19:37 +0200 Subject: [PATCH 042/125] Factor out function application code This is a no-op, but will make tracking changes of coming refactorings easier --- src/Nixfmt/Pretty.hs | 61 ++++++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 28 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index d4fd811a..3b2ac079 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -268,6 +268,38 @@ instance Pretty Parameter where pretty (ContextParameter param1 at param2) = pretty param1 <> pretty at <> pretty param2 + +-- Function application +-- Some example mapping of Nix code to Doc (using brackets as groups, but omitting the outermost group +-- and groups around the expressions for conciseness): +-- `f a` -> [f line*] a +-- `f g a` -> [f line g line*] a +-- `f g h a` -> [[f line g] line h line*] a +-- `f g h i a` -> [[[f line g] line h] line i line*] a +-- As you can see, it separates the elements by `line` whitespace. However, there are two tricks to make it look good: +-- Firstly, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion +-- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining +-- ones on a separate line each. +-- Secondly, the `line` between the second-to-last and last argument (marked with asterisk above) is moved into its preceding +-- group. This allows the last argument to be multi-line without forcing the preceding arguments to be multiline. +prettyApp :: Expression -> Expression -> Doc +prettyApp f a + = let + absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (group a') + absorbApp expr = pretty expr + + absorbLast (Term t) | isAbsorbable t + = prettyTerm t + absorbLast (Term (Parenthesized open expr close)) + = base $ group $ pretty open <> line' <> nest 2 (group expr) <> line' <> pretty close + absorbLast arg = group arg + + -- Extract comment before the first function and move it out, to prevent functions being force-expanded + (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f + in + pretty comment <> (group $ + (group' False $ absorbApp fWithoutComment <> line) <> absorbLast a) + isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts @@ -363,35 +395,8 @@ instance Pretty Expression where pretty (Abstraction param colon body) = pretty param <> pretty colon <> absorbSet body - -- Function application - -- Some example mapping of Nix code to Doc (using brackets as groups, but omitting the outermost group - -- and groups around the expressions for conciseness): - -- `f a` -> [f line*] a - -- `f g a` -> [f line g line*] a - -- `f g h a` -> [[f line g] line h line*] a - -- `f g h i a` -> [[[f line g] line h] line i line*] a - -- As you can see, it separates the elements by `line` whitespace. However, there are two tricks to make it look good: - -- Firstly, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion - -- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining - -- ones on a separate line each. - -- Secondly, the `line` between the second-to-last and last argument (marked with asterisk above) is moved into its preceding - -- group. This allows the last argument to be multi-line without forcing the preceding arguments to be multiline. pretty (Application f a) - = let - absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (group a') - absorbApp expr = pretty expr - - absorbLast (Term t) | isAbsorbable t - = prettyTerm t - absorbLast (Term (Parenthesized open expr close)) - = base $ group $ pretty open <> line' <> nest 2 (group expr) <> line' <> pretty close - absorbLast arg = group arg - - -- Extract comment before the first function and move it out, to prevent functions being force-expanded - (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f - in - pretty comment <> (group $ - (group' False $ absorbApp fWithoutComment <> line) <> absorbLast a) + = prettyApp f a -- '//' operator pretty (Operation a op@(Ann _ TUpdate _) b) From 792c4059b668e464a585b5256e49fdfc4a501e8e Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 9 Jun 2023 02:28:35 +0200 Subject: [PATCH 043/125] Infinisil style function application --- src/Nixfmt/Pretty.hs | 45 +++-- test/diff/apply/out.nix | 213 +++++++++++--------- test/diff/attr_set/out.nix | 20 +- test/diff/idioms_lib_2/out.nix | 20 +- test/diff/idioms_lib_3/out.nix | 98 +++++----- test/diff/idioms_nixos_1/out.nix | 128 +++++++------ test/diff/idioms_nixos_2/out.nix | 232 +++++++++++----------- test/diff/idioms_pkgs_2/out.nix | 10 +- test/diff/idioms_pkgs_3/out.nix | 48 ++--- test/diff/key_value/out.nix | 4 +- test/diff/monsters_1/out.nix | 320 ++++++++++++++++--------------- test/diff/monsters_4/out.nix | 210 ++++++++++---------- test/diff/monsters_5/out.nix | 239 ++++++++++++----------- test/diff/paren/out.nix | 144 +++++++------- 14 files changed, 902 insertions(+), 829 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 3b2ac079..15ec080f 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -120,9 +120,10 @@ instance Pretty Binder where -- Non-absorbable term -- If it is multi-line, force it to start on a new line with indentation (Term _) -> group' False (line <> pretty expr) <> pretty semicolon - -- Function calls and with expressions - -- Try to absorb and keep the semicolon attached, spread otherwise - (Application _ _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) + -- Function call + -- Absorb if all arguments except the last fit into the line, start on new line otherwise + (Application f a) -> group $ prettyApp line line' f a <> pretty semicolon + -- With expression: Try to absorb and keep the semicolon attached, spread otherwise (With _ _ _ _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) -- Special case `//` operator to treat like an absorbable term (Operation _ (Ann _ TUpdate _) _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) @@ -185,6 +186,10 @@ prettyTerm (Set krec paropen binders parclose) <> nest 2 (prettyItems hardline binders) <> line <> pretty parclose +-- Parenthesized application +prettyTerm (Parenthesized paropen (Application f a) parclose) + = base $ groupWithStart paropen $ nest 2 (prettyApp line' line' f a) <> pretty parclose + -- Parentheses prettyTerm (Parenthesized paropen expr parclose) = base $ groupWithStart paropen (lineL <> nest 2 (group expr) <> lineR <> pretty parclose) @@ -272,20 +277,24 @@ instance Pretty Parameter where -- Function application -- Some example mapping of Nix code to Doc (using brackets as groups, but omitting the outermost group -- and groups around the expressions for conciseness): --- `f a` -> [f line*] a --- `f g a` -> [f line g line*] a --- `f g h a` -> [[f line g] line h line*] a --- `f g h i a` -> [[[f line g] line h] line i line*] a --- As you can see, it separates the elements by `line` whitespace. However, there are two tricks to make it look good: --- Firstly, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion +-- `f a` -> pre f line a post +-- `f g a` -> pre [f line g] line a post +-- `f g h a` -> pre [[f line g] line h] line a post +-- `f g h i a` -> pre [[[f line g] line h] line i] line a post +-- As you can see, it separates the elements by `line` whitespace. However, there are three tricks to make it look good: +-- First, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion -- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining -- ones on a separate line each. --- Secondly, the `line` between the second-to-last and last argument (marked with asterisk above) is moved into its preceding --- group. This allows the last argument to be multi-line without forcing the preceding arguments to be multiline. -prettyApp :: Expression -> Expression -> Doc -prettyApp f a +-- Second, the last argument is declared as "priority" group, meaning that the layouting algorithm will try to expand +-- it first when things do not fit onto one line. This allows the last argument to be multi-line without forcing the +-- preceding arguments to be multiline. +-- Third, callers may inject `pre` and `post` tokens (mostly newlines) into the inside of the group. +-- This means that callers can say "try to be compact first, but if more than the last argument does not fit onto the line, +-- then start on a new line instead". +prettyApp :: Doc -> Doc -> Expression -> Expression -> Doc +prettyApp pre post f a = let - absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (group a') + absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest 2 (group a')) absorbApp expr = pretty expr absorbLast (Term t) | isAbsorbable t @@ -297,8 +306,8 @@ prettyApp f a -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f in - pretty comment <> (group $ - (group' False $ absorbApp fWithoutComment <> line) <> absorbLast a) + pretty comment <> (group' False $ + pre <> group (absorbApp fWithoutComment) <> line <> group' True ((nest 2 (absorbLast a))) <> post) isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) @@ -396,7 +405,7 @@ instance Pretty Expression where = pretty param <> pretty colon <> absorbSet body pretty (Application f a) - = prettyApp f a + = prettyApp mempty mempty f a -- '//' operator pretty (Operation a op@(Ann _ TUpdate _) b) @@ -420,6 +429,8 @@ instance Pretty Expression where absorbOperation (Term t) | isAbsorbable t = hardspace <> pretty t -- Force nested operations to start on a new line absorbOperation x@(Operation _ _ _) = group' False $ line <> nest 2 (pretty x) + -- Force applications to start on a new line if more than the last argument is multiline + absorbOperation (Application f a) = group $ nest 2 $ hardspace <> prettyApp line mempty f a absorbOperation x = nest 2 (hardspace <> pretty x) prettyOperation :: (Maybe Leaf, Expression) -> Doc diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index d9b454d3..a43e3484 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -5,41 +5,47 @@ # Function call with comment (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) [ - (mapAttrsToStringsSep - [ - force - long - ] - "\n" - mkSection - attrsOfAttrs) + ( + mapAttrsToStringsSep + [ + force + long + ] + "\n" + mkSection + attrsOfAttrs + ) ] (a b) - ((a b) (a b) - (a # b - c) - ( # a - b # c - d # e - )) + ( + (a b) (a b) + ( + a # b + c + ) + ( # a + b # c + d # e + ) + ) '' otherModules=${ pkgs.writeText "other-modules.json" ( l.toJSON ( l.mapAttrs - ( - pname: subOutputs: - let - pkg = subOutputs.packages."${pname}".overrideAttrs ( - old: { - buildScript = "true"; - installMethod = "copy"; - } - ); - in - "${pkg}/lib/node_modules/${pname}/node_modules" - ) - outputs.subPackages + ( + pname: subOutputs: + let + pkg = subOutputs.packages."${pname}".overrideAttrs ( + old: { + buildScript = "true"; + installMethod = "copy"; + } + ); + in + "${pkg}/lib/node_modules/${pname}/node_modules" + ) + outputs.subPackages ) ) } @@ -54,50 +60,62 @@ { name1 = function arg { asdf = 1; }; - name2 = function arg - { - asdf = 1; - # multiline - } - argument; + name2 = + function arg + { + asdf = 1; + # multiline + } + argument + ; - name3 = function arg - { - asdf = 1; - # multiline - } - { qwer = 12345; } - argument; + name3 = + function arg + { + asdf = 1; + # multiline + } + { qwer = 12345; } + argument + ; } { - name4 = function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - argument; + name4 = + function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + argument + ; } { - option1 = function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - lastArg; + option1 = + function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + lastArg + ; - option2 = function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - lastArg; + option2 = + function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + lastArg + ; - option3 = function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - lastArg; + option3 = + function arg { asdf = 1; } + { + qwer = 12345; + qwer2 = 54321; + } + lastArg + ; } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { @@ -115,35 +133,42 @@ ''"'' "\${" ]; - escapeMultiline = libStr.replaceStrings - [ - "\${" - "''" - ] - [ - "''\${" - "'''" - ]; - test = foo - [ # multiline - 1 - 2 - 3 - ] - [ ] - { } - [ ] - [ - 1 - 2 - 3 # multiline - ]; + escapeMultiline = + libStr.replaceStrings + [ + "\${" + "''" + ] + [ + "''\${" + "'''" + ] + ; + test = + foo + [ # multiline + 1 + 2 + 3 + ] + [ ] + { } + [ ] + [ + 1 + 2 + 3 # multiline + ] + ; looooooooong = - (toINI - { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } - sections); - looooooooong' = toINI - { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } - sections; + ( + toINI + { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + sections + ); + looooooooong' = + toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + sections + ; } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index b45be0e7..04181992 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -91,15 +91,17 @@ # multiline } .${x}; - z = functionCall - { - # multi - #line - } - [ - # several - items - ]; + z = + functionCall + { + # multi + #line + } + [ + # several + items + ] + ; a = [ some diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 85390b12..88e56ed7 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -226,9 +226,11 @@ rec { default ; - nixpkgsVersion = builtins.trace - "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" - version; + nixpkgsVersion = + builtins.trace + "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" + version + ; /* Determine whether the function is being called from inside a Nix shell. @@ -357,7 +359,7 @@ rec { msg: builtins.trace "warning: ${msg}" ( abort - "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors." + "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors." ) else msg: builtins.trace "warning: ${msg}" @@ -405,10 +407,12 @@ rec { unexpected = lib.subtractLists valid given; in lib.throwIfNot (unexpected == [ ]) "${msg}: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) - } unexpected; valid ones: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString valid) - }" + builtins.concatStringsSep ", " ( + builtins.map builtins.toString unexpected + ) + } unexpected; valid ones: ${ + builtins.concatStringsSep ", " (builtins.map builtins.toString valid) + }" ; info = msg: builtins.trace "INFO: ${msg}"; diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index c869bd76..1c72739c 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -142,11 +142,11 @@ rec { mkSectionName ? ( name: libStr.escape - [ - "[" - "]" - ] - name + [ + "[" + "]" + ] + name ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", @@ -208,11 +208,11 @@ rec { mkSectionName ? ( name: libStr.escape - [ - "[" - "]" - ] - name + [ + "[" + "]" + ] + name ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", @@ -230,9 +230,10 @@ rec { (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" ) - + (toINI - { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } - sections) + + ( + toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } + sections + ) ; # Generate a git-config file from an attrset. @@ -286,9 +287,8 @@ rec { recurse = path: value: if isAttrs value && !lib.isDerivation value then - lib.mapAttrsToList - (name: value: recurse ([ name ] ++ path) value) - value + lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) + value else if length path > 1 then { ${concatStringsSep "." (lib.reverseList (tail path))}.${ @@ -342,8 +342,8 @@ rec { if depthLimit != null && depth > depthLimit then if throwOnDepthLimit then throw "Exceeded maximum eval-depth limit of ${ - toString depthLimit - } while trying to evaluate with `generators.withRecursion'!" + toString depthLimit + } while trying to evaluate with `generators.withRecursion'!" else const "" else @@ -420,15 +420,17 @@ rec { ''"'' "\${" ]; - escapeMultiline = libStr.replaceStrings - [ - "\${" - "''" - ] - [ - "''\${" - "'''" - ]; + escapeMultiline = + libStr.replaceStrings + [ + "\${" + "''" + ] + [ + "''\${" + "'''" + ] + ; singlelineResult = ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) @@ -474,8 +476,8 @@ rec { fna = lib.functionArgs v; showFnas = concatStringsSep ", " ( libAttr.mapAttrsToList - (name: hasDefVal: if hasDefVal then name + "?" else name) - fna + (name: hasDefVal: if hasDefVal then name + "?" else name) + fna ); in if fna == { } then "" else "" @@ -492,15 +494,15 @@ rec { + introSpace + libStr.concatStringsSep introSpace ( libAttr.mapAttrsToList - ( - name: value: - "${libStr.escapeNixIdentifier name} = ${ - builtins.addErrorContext - "while evaluating an attribute `${name}`" - (go (indent + " ") value) - };" - ) - v + ( + name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext + "while evaluating an attribute `${name}`" + (go (indent + " ") value) + };" + ) + v ) + outroSpace + "}" @@ -576,14 +578,14 @@ rec { libStr.concatStringsSep "\n" ( lib.flatten ( lib.mapAttrsToList - ( - name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ] - ) - x + ( + name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ] + ) + x ) ) ; @@ -610,8 +612,8 @@ rec { "{ ${ concatItems ( lib.attrsets.mapAttrsToList - (key: value: "${key} = ${toDhall args value}") - v + (key: value: "${key} = ${toDhall args value}") + v ) } }" else if isList v then diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index ba290362..b39bfcd4 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -222,63 +222,67 @@ in config = mkMerge [ (mkIf config.boot.initrd.enable { boot.initrd.availableKernelModules = - optionals config.boot.initrd.includeDefaultModules ( - [ - # Note: most of these (especially the SATA/PATA modules) - # shouldn't be included by default since nixos-generate-config - # detects them, but I'm keeping them for now for backwards - # compatibility. - - # Some SATA/PATA stuff. - "ahci" - "sata_nv" - "sata_via" - "sata_sis" - "sata_uli" - "ata_piix" - "pata_marvell" - - # Standard SCSI stuff. - "sd_mod" - "sr_mod" - - # SD cards and internal eMMC drives. - "mmc_block" - - # Support USB keyboards, in case the boot fails and we only have - # a USB keyboard, or for LUKS passphrase prompt. - "uhci_hcd" - "ehci_hcd" - "ehci_pci" - "ohci_hcd" - "ohci_pci" - "xhci_hcd" - "xhci_pci" - "usbhid" - "hid_generic" - "hid_lenovo" - "hid_apple" - "hid_roccat" - "hid_logitech_hidpp" - "hid_logitech_dj" - "hid_microsoft" - ] - ++ optionals pkgs.stdenv.hostPlatform.isx86 [ - # Misc. x86 keyboard stuff. - "pcips2" - "atkbd" - "i8042" - - # x86 RTC needed by the stage 2 init script. - "rtc_cmos" - ] - ); + optionals config.boot.initrd.includeDefaultModules + ( + [ + # Note: most of these (especially the SATA/PATA modules) + # shouldn't be included by default since nixos-generate-config + # detects them, but I'm keeping them for now for backwards + # compatibility. + + # Some SATA/PATA stuff. + "ahci" + "sata_nv" + "sata_via" + "sata_sis" + "sata_uli" + "ata_piix" + "pata_marvell" + + # Standard SCSI stuff. + "sd_mod" + "sr_mod" + + # SD cards and internal eMMC drives. + "mmc_block" + + # Support USB keyboards, in case the boot fails and we only have + # a USB keyboard, or for LUKS passphrase prompt. + "uhci_hcd" + "ehci_hcd" + "ehci_pci" + "ohci_hcd" + "ohci_pci" + "xhci_hcd" + "xhci_pci" + "usbhid" + "hid_generic" + "hid_lenovo" + "hid_apple" + "hid_roccat" + "hid_logitech_hidpp" + "hid_logitech_dj" + "hid_microsoft" + ] + ++ optionals pkgs.stdenv.hostPlatform.isx86 [ + # Misc. x86 keyboard stuff. + "pcips2" + "atkbd" + "i8042" + + # x86 RTC needed by the stage 2 init script. + "rtc_cmos" + ] + ) + ; boot.initrd.kernelModules = - optionals config.boot.initrd.includeDefaultModules [ - # For LVM. - "dm_mod" - ]; + optionals config.boot.initrd.includeDefaultModules + [ + # For LVM. + "dm_mod" + ] + ; }) (mkIf (!config.boot.isContainer) { @@ -297,7 +301,9 @@ in ; boot.kernel.sysctl."kernel.printk" = - mkDefault config.boot.consoleLogLevel; + mkDefault + config.boot.consoleLogLevel + ; boot.kernelModules = [ "loop" @@ -387,11 +393,11 @@ in cfg = config.boot.kernelPackages.kernel.config; in map - (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) - config.system.requiredKernelConfig + (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) + config.system.requiredKernelConfig ; }) ]; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 0e58bba7..682a2d11 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -74,54 +74,62 @@ in { imports = [ - (mkRemovedOptionModule - [ - "services" - "nextcloud" - "config" - "adminpass" - ] - '' - Please use `services.nextcloud.config.adminpassFile' instead! - '') - (mkRemovedOptionModule - [ - "services" - "nextcloud" - "config" - "dbpass" - ] - '' - Please use `services.nextcloud.config.dbpassFile' instead! - '') - (mkRemovedOptionModule - [ - "services" - "nextcloud" - "nginx" - "enable" - ] - '' - The nextcloud module supports `nginx` as reverse-proxy by default and doesn't - support other reverse-proxies officially. - - However it's possible to use an alternative reverse-proxy by - - * disabling nginx - * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value - - Further details about this can be found in the `Nextcloud`-section of the NixOS-manual - (which can be opened e.g. by running `nixos-help`). - '') - (mkRemovedOptionModule - [ - "services" - "nextcloud" - "disableImagemagick" - ] - '' - Use services.nextcloud.enableImagemagick instead. - '') + ( + mkRemovedOptionModule + [ + "services" + "nextcloud" + "config" + "adminpass" + ] + '' + Please use `services.nextcloud.config.adminpassFile' instead! + '' + ) + ( + mkRemovedOptionModule + [ + "services" + "nextcloud" + "config" + "dbpass" + ] + '' + Please use `services.nextcloud.config.dbpassFile' instead! + '' + ) + ( + mkRemovedOptionModule + [ + "services" + "nextcloud" + "nginx" + "enable" + ] + '' + The nextcloud module supports `nginx` as reverse-proxy by default and doesn't + support other reverse-proxies officially. + + However it's possible to use an alternative reverse-proxy by + + * disabling nginx + * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value + + Further details about this can be found in the `Nextcloud`-section of the NixOS-manual + (which can be opened e.g. by running `nixos-help`). + '' + ) + ( + mkRemovedOptionModule + [ + "services" + "nextcloud" + "disableImagemagick" + ] + '' + Use services.nextcloud.enableImagemagick instead. + '' + ) ]; options.services.nextcloud = { @@ -130,8 +138,8 @@ in enableBrokenCiphersForSSE = mkOption { type = types.bool; default = versionOlder stateVersion "22.11"; - defaultText = - literalExpression ''versionOlder system.stateVersion "22.11"''; + defaultText = literalExpression '' + versionOlder system.stateVersion "22.11"''; description = lib.mdDoc '' This option enables using the OpenSSL PHP extension linked against OpenSSL 1.1 rather than latest OpenSSL (≥ 3), this is not recommended unless you need @@ -228,7 +236,9 @@ in type = types.ints.between 0 4; default = 2; description = - lib.mdDoc "Log level value between 0 (DEBUG) and 4 (FATAL)."; + lib.mdDoc + "Log level value between 0 (DEBUG) and 4 (FATAL)." + ; }; logType = mkOption { type = types.enum [ @@ -252,7 +262,9 @@ in package = mkOption { type = types.package; description = - lib.mdDoc "Which package to use for the Nextcloud instance."; + lib.mdDoc + "Which package to use for the Nextcloud instance." + ; relatedPackages = [ "nextcloud24" "nextcloud25" @@ -731,7 +743,9 @@ in type = types.bool; default = true; description = - lib.mdDoc "Enable additional recommended HTTP response headers"; + lib.mdDoc + "Enable additional recommended HTTP response headers" + ; }; hstsMaxAge = mkOption { type = types.ints.positive; @@ -879,26 +893,23 @@ in 'key' => '${s3.key}', 'secret' => nix_read_secret('${s3.secretFile}'), ${ - optionalString - (s3.hostname != null) - "'hostname' => '${s3.hostname}'," + optionalString (s3.hostname != null) + "'hostname' => '${s3.hostname}'," } ${ optionalString (s3.port != null) "'port' => ${ - toString s3.port - }," + toString s3.port + }," } 'use_ssl' => ${boolToString s3.useSsl}, ${ - optionalString - (s3.region != null) - "'region' => '${s3.region}'," + optionalString (s3.region != null) + "'region' => '${s3.region}'," } 'use_path_style' => ${boolToString s3.usePathStyle}, ${ - optionalString - (s3.sseCKeyFile != null) - "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," + optionalString (s3.sseCKeyFile != null) + "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," } ], ] @@ -946,56 +957,48 @@ in $CONFIG = [ 'apps_paths' => [ ${ - optionalString - (cfg.extraApps != { }) - "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," + optionalString (cfg.extraApps != { }) + "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," } [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], ], ${ - optionalString - (showAppStoreSetting) - "'appstoreenabled' => ${renderedAppStoreSetting}," + optionalString (showAppStoreSetting) + "'appstoreenabled' => ${renderedAppStoreSetting}," } 'datadirectory' => '${datadir}/data', 'skeletondirectory' => '${cfg.skeletonDirectory}', ${ - optionalString - cfg.caching.apcu - "'memcache.local' => '\\OC\\Memcache\\APCu'," + optionalString cfg.caching.apcu + "'memcache.local' => '\\OC\\Memcache\\APCu'," } 'log_type' => '${cfg.logType}', 'loglevel' => '${builtins.toString cfg.logLevel}', ${ - optionalString - (c.overwriteProtocol != null) - "'overwriteprotocol' => '${c.overwriteProtocol}'," + optionalString (c.overwriteProtocol != null) + "'overwriteprotocol' => '${c.overwriteProtocol}'," } ${ - optionalString - (c.dbname != null) - "'dbname' => '${c.dbname}'," + optionalString (c.dbname != null) + "'dbname' => '${c.dbname}'," } ${ - optionalString - (c.dbhost != null) - "'dbhost' => '${c.dbhost}'," + optionalString (c.dbhost != null) + "'dbhost' => '${c.dbhost}'," } ${ optionalString (c.dbport != null) "'dbport' => '${ - toString c.dbport - }'," + toString c.dbport + }'," } ${ - optionalString - (c.dbuser != null) - "'dbuser' => '${c.dbuser}'," + optionalString (c.dbuser != null) + "'dbuser' => '${c.dbuser}'," } ${ - optionalString - (c.dbtableprefix != null) - "'dbtableprefix' => '${toString c.dbtableprefix}'," + optionalString (c.dbtableprefix != null) + "'dbtableprefix' => '${toString c.dbtableprefix}'," } ${ optionalString (c.dbpassFile != null) '' @@ -1010,23 +1013,20 @@ in }, 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, ${ - optionalString - (c.defaultPhoneRegion != null) - "'default_phone_region' => '${c.defaultPhoneRegion}'," + optionalString (c.defaultPhoneRegion != null) + "'default_phone_region' => '${c.defaultPhoneRegion}'," } ${ - optionalString - (nextcloudGreaterOrEqualThan "23") - "'profile.enabled' => ${boolToString cfg.globalProfiles}," + optionalString (nextcloudGreaterOrEqualThan "23") + "'profile.enabled' => ${boolToString cfg.globalProfiles}," } ${objectstoreConfig} ]; $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( "${ - jsonFormat.generate - "nextcloud-extraOptions.json" - cfg.extraOptions + jsonFormat.generate "nextcloud-extraOptions.json" + cfg.extraOptions }", "impossible: this should never happen (decoding generated extraOptions file %s failed)" )); @@ -1090,11 +1090,11 @@ in ; occSetTrustedDomainsCmd = concatStringsSep "\n" ( imap0 - (i: v: '' - ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ - ${toString i} --value="${toString v}" - '') - ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) + (i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '') + ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) ); in { @@ -1127,9 +1127,8 @@ in ln -sfT \ ${ pkgs.linkFarm "nix-apps" ( - mapAttrsToList - (name: path: { inherit name path; }) - cfg.extraApps + mapAttrsToList (name: path: { inherit name path; }) + cfg.extraApps ) } \ ${cfg.home}/nix-apps @@ -1155,14 +1154,13 @@ in ${occ}/bin/nextcloud-occ config:system:delete trusted_domains - ${optionalString - (cfg.extraAppsEnable && cfg.extraApps != { }) - '' - # Try to enable apps - ${occ}/bin/nextcloud-occ app:enable ${ - concatStringsSep " " (attrNames cfg.extraApps) - } - ''} + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) + '' + # Try to enable apps + ${occ}/bin/nextcloud-occ app:enable ${ + concatStringsSep " " (attrNames cfg.extraApps) + } + ''} ${occSetTrustedDomainsCmd} ''; @@ -1171,7 +1169,9 @@ in # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent # an automatic creation of the database user. environment.NC_setup_create_db_user = - lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; + lib.mkIf (nextcloudGreaterOrEqualThan "26") + "false" + ; } ; nextcloud-cron = { diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index 536de41e..ceb3617a 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -22,10 +22,12 @@ stdenv.mkDerivation rec { passthru.tests = { version = testVersion { package = hello; }; - invariant-under-noXlibs = testEqualDerivation - "hello must not be rebuilt when environment.noXlibs is set." - hello - (nixos { environment.noXlibs = true; }).pkgs.hello; + invariant-under-noXlibs = + testEqualDerivation + "hello must not be rebuilt when environment.noXlibs is set." + hello + (nixos { environment.noXlibs = true; }).pkgs.hello + ; }; meta = with lib; { diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index bdd2e8bd..487593a8 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -155,8 +155,9 @@ assert stdenv.cc.libc or null != null; assert pipewireSupport -> !waylandSupport || !webrtcSupport - -> throw - "${pname}: pipewireSupport requires both wayland and webrtc support."; + -> + throw + "${pname}: pipewireSupport requires both wayland and webrtc support."; let inherit (lib) enableFeature; @@ -226,11 +227,11 @@ let defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" ( lib.concatStringsSep "\n" ( lib.mapAttrsToList - (key: value: '' - // ${value.reason} - pref("${key}", ${builtins.toJSON value.value}); - '') - defaultPrefs + (key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '') + defaultPrefs ) ); in @@ -260,15 +261,15 @@ buildStdenv.mkDerivation ({ hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; }) ] - ++ lib.optional - (lib.versionOlder version "111") - ./env_var_for_system_dir-ff86.patch - ++ lib.optional - (lib.versionAtLeast version "111") - ./env_var_for_system_dir-ff111.patch - ++ lib.optional - (lib.versionAtLeast version "96") - ./no-buildconfig-ffx96.patch + ++ + lib.optional (lib.versionOlder version "111") + ./env_var_for_system_dir-ff86.patch + ++ + lib.optional (lib.versionAtLeast version "111") + ./env_var_for_system_dir-ff111.patch + ++ + lib.optional (lib.versionAtLeast version "96") + ./no-buildconfig-ffx96.patch ++ extraPatches ; @@ -427,12 +428,15 @@ buildStdenv.mkDerivation ({ ] # elf-hack is broken when using clang+lld: # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 - ++ lib.optional - ( - ltoSupport - && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64) - ) - "--disable-elf-hack" + ++ + lib.optional + ( + ltoSupport + && ( + buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64 + ) + ) + "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ (enableFeature alsaSupport "alsa") diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index cd3aeb21..36acdef9 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -77,5 +77,7 @@ rec { ; p = - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a; + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } + a + ; } diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index 952d18b1..b47a004b 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -65,206 +65,208 @@ }: # foo stdenv.mkDerivation -# foo -rec -# foo -{ # foo - pname - # foo - = - # foo - "contrast"; + rec # foo - version + { # foo - = + pname + # foo + = + # foo + "contrast"; # foo - "0.0.5"; - # foo - src + version + # foo + = + # foo + "0.0.5"; # foo - = + src + # foo + = + # foo + fetchFromGitLab + # foo + { + # foo + domain + # foo + = + # foo + "gitlab.gnome.org"; + # foo + group + # foo + = + # foo + "World"; + # foo + owner + # foo + = + # foo + "design"; + # foo + repo + # foo + = + # foo + "contrast"; + # foo + rev + # foo + = + # foo + version; + # foo + sha256 + # foo + = + # foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; + # foo + } + ; # foo - fetchFromGitLab + cargoDeps + # foo + = + # foo + rustPlatform.fetchCargoTarball + # foo + { + # foo + inherit + # foo + src + ; + # foo + name + # foo + = + # foo + "${pname}-${version}"; + # foo + hash + # foo + = + # foo + "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; + # foo + } + ; # foo - { + nativeBuildInputs + # foo + = # foo - domain + [ # foo - = + desktop-file-utils # foo - "gitlab.gnome.org"; - # foo - group + gettext # foo - = + meson # foo - "World"; - # foo - owner + ninja # foo - = + pkg-config # foo - "design"; - # foo - repo + python3 # foo - = + rustPlatform.rust.cargo # foo - "contrast"; - # foo - rev + rustPlatform.cargoSetupHook # foo - = + rustPlatform.rust.rustc # foo - version; - # foo - sha256 + wrapGAppsHook4 # foo - = + glib # foo - "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; - # foo - }; - # foo - cargoDeps - # foo - = - # foo - rustPlatform.fetchCargoTarball + # for glib-compile-resources + + # foo + ]; # foo - { + buildInputs # foo - inherit - # foo - src - ; + = # foo - name + [ # foo - = + cairo # foo - "${pname}-${version}"; - # foo - hash + glib # foo - = + gtk4 # foo - "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; - # foo - }; - # foo - nativeBuildInputs - # foo - = - # foo - [ - # foo - desktop-file-utils - # foo - gettext - # foo - meson - # foo - ninja - # foo - pkg-config - # foo - python3 - # foo - rustPlatform.rust.cargo - # foo - rustPlatform.cargoSetupHook - # foo - rustPlatform.rust.rustc - # foo - wrapGAppsHook4 - # foo - glib - # foo - # for glib-compile-resources - - # foo - ]; - # foo - buildInputs - # foo - = + libadwaita + # foo + pango + # foo + ]; # foo - [ + postPatch # foo - cairo + = # foo - glib - # foo - gtk4 - # foo - libadwaita - # foo - pango - # foo - ]; - # foo - postPatch + '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; # foo - = - # foo - '' - patchShebangs build-aux/meson_post_install.py - # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 - substituteInPlace build-aux/meson_post_install.py \ - --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" - ''; - # foo - meta - # foo - = - # foo - with + meta # foo - lib; - # foo - { + = # foo - description - # foo - = + with # foo - "Checks whether the contrast between two colors meet the WCAG requirements"; + lib; # foo - homepage - # foo - = + { # foo - "https://gitlab.gnome.org/World/design/contrast"; - # foo - license - # foo - = - # foo - licenses.gpl3Plus; - # foo - maintainers + description + # foo + = + # foo + "Checks whether the contrast between two colors meet the WCAG requirements"; # foo - = + homepage + # foo + = + # foo + "https://gitlab.gnome.org/World/design/contrast"; # foo - with + license # foo - maintainers; + = + # foo + licenses.gpl3Plus; # foo - [ + maintainers # foo - jtojnar + = # foo - ]; - # foo - platforms + with + # foo + maintainers; + # foo + [ + # foo + jtojnar + # foo + ]; # foo - = + platforms + # foo + = + # foo + platforms.unix; # foo - platforms.unix; - # foo - }; - # foo -} + }; + # foo + } diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 05784c95..e5e7c993 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -32,107 +32,109 @@ wrapGAppsHook4, # Foo }: # Foo stdenv.mkDerivation # Foo -rec # Foo -{ # Foo - pname # Foo - = # Foo - "contrast"; # Foo - version # Foo - = # Foo - "0.0.5"; # Foo - src # Foo - = # Foo - fetchFromGitLab # Foo - { # Foo - domain # Foo - = # Foo - "gitlab.gnome.org"; # Foo - group # Foo - = # Foo - "World"; # Foo - owner # Foo - = # Foo - "design"; # Foo - repo # Foo - = # Foo - "contrast"; # Foo - rev # Foo - = # Foo - version; # Foo - sha256 # Foo - = # Foo - "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo - }; # Foo - cargoDeps # Foo - = # Foo - rustPlatform.fetchCargoTarball # Foo - { # Foo - inherit # Foo - src - ; # Foo - name # Foo - = # Foo - "${pname}-${version}"; # Foo - hash # Foo - = # Foo - "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo - }; # Foo - nativeBuildInputs # Foo - = # Foo - [ # Foo - desktop-file-utils # Foo - gettext # Foo - meson # Foo - ninja # Foo - pkg-config # Foo - python3 # Foo - rustPlatform.rust.cargo # Foo - rustPlatform.cargoSetupHook # Foo - rustPlatform.rust.rustc # Foo - wrapGAppsHook4 # Foo - glib # Foo for glib-compile-resources - # Foo - ]; # Foo - buildInputs # Foo - = # Foo - [ # Foo - cairo # Foo - glib # Foo - gtk4 # Foo - libadwaita # Foo - pango # Foo - ]; # Foo - postPatch # Foo - = # Foo - '' - patchShebangs build-aux/meson_post_install.py - # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 - substituteInPlace build-aux/meson_post_install.py \ - --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" - ''; # Foo - meta # Foo - = # Foo - with # Foo - lib; # Foo - { # Foo - description # Foo - = # Foo - "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo - homepage # Foo - = # Foo - "https://gitlab.gnome.org/World/design/contrast"; # Foo - license # Foo - = # Foo - licenses.gpl3Plus; # Foo - maintainers # Foo - = # Foo - with # Foo - maintainers; # Foo - [ # Foo - jtojnar # Foo - ]; # Foo - platforms # Foo - = # Foo - platforms.unix; # Foo - }; # Foo -} + rec # Foo + { # Foo + pname # Foo + = # Foo + "contrast"; # Foo + version # Foo + = # Foo + "0.0.5"; # Foo + src # Foo + = # Foo + fetchFromGitLab # Foo + { # Foo + domain # Foo + = # Foo + "gitlab.gnome.org"; # Foo + group # Foo + = # Foo + "World"; # Foo + owner # Foo + = # Foo + "design"; # Foo + repo # Foo + = # Foo + "contrast"; # Foo + rev # Foo + = # Foo + version; # Foo + sha256 # Foo + = # Foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo + } + ; # Foo + cargoDeps # Foo + = # Foo + rustPlatform.fetchCargoTarball # Foo + { # Foo + inherit # Foo + src + ; # Foo + name # Foo + = # Foo + "${pname}-${version}"; # Foo + hash # Foo + = # Foo + "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo + } + ; # Foo + nativeBuildInputs # Foo + = # Foo + [ # Foo + desktop-file-utils # Foo + gettext # Foo + meson # Foo + ninja # Foo + pkg-config # Foo + python3 # Foo + rustPlatform.rust.cargo # Foo + rustPlatform.cargoSetupHook # Foo + rustPlatform.rust.rustc # Foo + wrapGAppsHook4 # Foo + glib # Foo for glib-compile-resources + # Foo + ]; # Foo + buildInputs # Foo + = # Foo + [ # Foo + cairo # Foo + glib # Foo + gtk4 # Foo + libadwaita # Foo + pango # Foo + ]; # Foo + postPatch # Foo + = # Foo + '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; # Foo + meta # Foo + = # Foo + with # Foo + lib; # Foo + { # Foo + description # Foo + = # Foo + "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo + homepage # Foo + = # Foo + "https://gitlab.gnome.org/World/design/contrast"; # Foo + license # Foo + = # Foo + licenses.gpl3Plus; # Foo + maintainers # Foo + = # Foo + with # Foo + maintainers; # Foo + [ # Foo + jtojnar # Foo + ]; # Foo + platforms # Foo + = # Foo + platforms.unix; # Foo + }; # Foo + } diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 156ea2f3..48531134 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -45,11 +45,12 @@ let pkgs.writeText - "nixos.conf" + "nixos.conf" - '' - ${concatStringsSep "\n" config.boot.kernelModules} - ''; + '' + ${concatStringsSep "\n" config.boot.kernelModules} + '' + ; in { @@ -68,41 +69,42 @@ in mkOption - { + { - default + default - = + = - { - }; + { }; - example + example - = + = - literalExpression + literalExpression - "{debug= true;}"; + "{debug= true;}" + ; - internal + internal - = + = - true; + true; - description + description - = + = - '' - This option allows to enable or disable certain kernel features. - It's not API, because it's about kernel feature sets, that - make sense for specific use cases. Mostly along with programs, - which would have separate nixos options. - `grep features pkgs/os-specific/linux/kernel/common-config.nix` - ''; - }; + '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + } + ; boot.kernelPackages @@ -110,129 +112,134 @@ in mkOption - { + { - default + default - = + = - pkgs.linuxPackages; + pkgs.linuxPackages; - type + type - = + = - types.unspecified + types.unspecified - // + // - { + { - merge + merge - = + = - mergeEqualOption; - }; + mergeEqualOption; + }; - apply + apply - = + = - kernelPackages: + kernelPackages: - kernelPackages.extend + kernelPackages.extend - ( - self: + ( + self: - super: + super: - { + { - kernel + kernel - = + = - super.kernel.override + super.kernel.override - ( - originalArgs: + ( + originalArgs: - { + { - inherit + inherit - randstructSeed - ; + randstructSeed + ; - kernelPatches + kernelPatches - = + = - (originalArgs.kernelPatches + (originalArgs.kernelPatches - or + or - [ ] - ) + [ ] + ) - ++ + ++ - kernelPatches - ; + kernelPatches + ; - features + features - = + = - lib.recursiveUpdate + lib.recursiveUpdate - super.kernel.features + super.kernel.features - features; - } - ); - } - ) - ; + features + ; + } + ) + ; + } + ) + ; - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. - defaultText + defaultText - = + = - literalExpression + literalExpression - "pkgs.linuxPackages"; + "pkgs.linuxPackages" + ; - example + example - = + = - literalExpression + literalExpression - "pkgs.linuxKernel.packages.linux_5_10"; + "pkgs.linuxKernel.packages.linux_5_10" + ; - description + description - = + = - '' - This option allows you to override the Linux kernel used by - NixOS. Since things like external kernel module packages are - tied to the kernel you're using, it also overrides those. - This option is a function that takes Nixpkgs as an argument - (as a convenience), and returns an attribute set containing at - the very least an attribute kernel. - Additional attributes may be needed depending on your - configuration. For instance, if you use the NVIDIA X driver, - then it also needs to contain an attribute - nvidia_x11. - ''; - }; + '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + } + ; boot.kernelPatches @@ -240,30 +247,34 @@ in mkOption - { + { - type + type - = + = - types.listOf + types.listOf - types.attrs; + types.attrs + ; - default + default - = + = - [ ]; + [ ]; - example + example - = + = - literalExpression + literalExpression - "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; - description = "A list of additional patches to apply to the kernel."; - }; + "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]" + ; + description = + "A list of additional patches to apply to the kernel."; + } + ; }; } diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index efecdb6a..8ea5a24b 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -7,78 +7,78 @@ } ] ) ] -( - ( # test - a # test - ) - ((c)) - ( - (c) # e - ) - ( - ( - c # d - ) - ) - ( - ( - c # d - ) # e - ) - ( - ( # b - c - ) - ) - ( - ( # b - c - ) # e - ) ( - ( # b - c # d + ( # test + a # test ) + ((c)) + ( + (c) # e + ) + ( + ( + c # d + ) + ) + ( + ( + c # d + ) # e + ) + ( + ( # b + c + ) + ) + ( + ( # b + c + ) # e + ) + ( + ( # b + c # d + ) + ) + ( + ( # b + c # d + ) # e + ) + ( # a + (c) + ) + ( # a + (c) # e + ) + ( # a + ( + c # d + ) + ) + ( # a + ( + c # d + ) # e + ) + ( # a + ( # b + c + ) + ) + ( # a + ( # b + c + ) # e + ) + ( # a + ( # b + c # d + ) + ) + ( # a + ( # b + c # d + ) # e + ) ) - ( - ( # b - c # d - ) # e - ) - ( # a - (c) - ) - ( # a - (c) # e - ) - ( # a - ( - c # d - ) - ) - ( # a - ( - c # d - ) # e - ) - ( # a - ( # b - c - ) - ) - ( # a - ( # b - c - ) # e - ) - ( # a - ( # b - c # d - ) - ) - ( # a - ( # b - c # d - ) # e - ) -) From b7daac9fca8fe2241391c934f0c7aa36cab45ece Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 10 Jun 2023 16:13:02 +0200 Subject: [PATCH 044/125] Improve comment handling - Parenthesized function applications with comments - Operations with comments on the operator --- src/Nixfmt/Pretty.hs | 52 +++++++++++++++---------- test/diff/apply/in.nix | 59 ++++++++++++++++++++++++++++ test/diff/apply/out.nix | 78 ++++++++++++++++++++++++++++++++++++- test/diff/operation/in.nix | 22 +++++++++++ test/diff/operation/out.nix | 25 +++++++++++- test/diff/paren/out.nix | 3 +- 6 files changed, 214 insertions(+), 25 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 15ec080f..3873064a 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -36,6 +36,11 @@ prettyCommentLine l toLineComment :: Text -> Trivium toLineComment c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c +-- If the token has some trailing comment after it, move that in front of the token +moveTrailingCommentUp :: Ann a -> Ann a +moveTrailingCommentUp (Ann pre a (Just (TrailingComment post))) = Ann (pre ++ [LineComment (" " <> post)]) a Nothing +moveTrailingCommentUp a = a + -- Make sure a group is not expanded because the token that starts it has -- leading comments. This will render both arguments as a group, but -- if the first argument has some leading comments they will be put before @@ -122,7 +127,7 @@ instance Pretty Binder where (Term _) -> group' False (line <> pretty expr) <> pretty semicolon -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise - (Application f a) -> group $ prettyApp line line' f a <> pretty semicolon + (Application f a) -> group $ prettyApp hardline line line' mempty f a <> pretty semicolon -- With expression: Try to absorb and keep the semicolon attached, spread otherwise (With _ _ _ _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) -- Special case `//` operator to treat like an absorbable term @@ -187,8 +192,13 @@ prettyTerm (Set krec paropen binders parclose) <> pretty parclose -- Parenthesized application -prettyTerm (Parenthesized paropen (Application f a) parclose) - = base $ groupWithStart paropen $ nest 2 (prettyApp line' line' f a) <> pretty parclose +prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) + = base $ groupWithStart (Ann pre paropen Nothing) $ nest 2 ( + -- Move comment trailing on '(' to next line, combine with comment from application + case pretty post of { [] -> []; c -> hardline <> c } + <> prettyApp hardline line' line' hardline f a + <> case pretty post of { [] -> mempty; _ -> hardline } + ) <> pretty parclose -- Parentheses prettyTerm (Parenthesized paropen expr parclose) @@ -198,7 +208,7 @@ prettyTerm (Parenthesized paropen expr parclose) case expr of -- Start on the same line for these (Term t) | isAbsorbable t -> (mempty, mempty) - -- Also absorb function calls (even though this occasionally looks weird) + -- unreachable (Application _ _) -> (mempty, mempty) -- Absorb function declarations but only those with simple parameter(s) (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> (mempty, mempty) @@ -216,10 +226,6 @@ instance Pretty Term where pretty l@List{} = group $ prettyTerm l pretty x = prettyTerm x -toLeading :: Maybe TrailingComment -> Trivia -toLeading Nothing = [] -toLeading (Just (TrailingComment c)) = [LineComment (" " <> c)] - instance Pretty ParamAttr where -- Simple parameter, move comment around -- Move comments around when switching from leading comma to trailing comma style: @@ -291,23 +297,29 @@ instance Pretty Parameter where -- Third, callers may inject `pre` and `post` tokens (mostly newlines) into the inside of the group. -- This means that callers can say "try to be compact first, but if more than the last argument does not fit onto the line, -- then start on a new line instead". -prettyApp :: Doc -> Doc -> Expression -> Expression -> Doc -prettyApp pre post f a +-- Out of necessity, callers may also inject `commentPre` and `commentPost`, which will be added before/after the entire +-- thing if the function has a comment associated with its first token +prettyApp :: Doc -> Doc -> Doc -> Doc -> Expression -> Expression -> Doc +prettyApp commentPre pre post commentPost f a = let absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest 2 (group a')) absorbApp expr = pretty expr absorbLast (Term t) | isAbsorbable t = prettyTerm t - absorbLast (Term (Parenthesized open expr close)) - = base $ group $ pretty open <> line' <> nest 2 (group expr) <> line' <> pretty close + absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) + = base $ group $ pretty (Ann pre' open Nothing) <> line' + <> nest 2 (pretty post' <> group expr) + <> line' <> pretty close absorbLast arg = group arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f in - pretty comment <> (group' False $ + (if null comment then mempty else commentPre) + <> pretty comment <> (group' False $ pre <> group (absorbApp fWithoutComment) <> line <> group' True ((nest 2 (absorbLast a))) <> post) + <> (if null comment then mempty else commentPost) isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) @@ -405,7 +417,7 @@ instance Pretty Expression where = pretty param <> pretty colon <> absorbSet body pretty (Application f a) - = prettyApp mempty mempty f a + = prettyApp mempty mempty mempty mempty f a -- '//' operator pretty (Operation a op@(Ann _ TUpdate _) b) @@ -426,19 +438,19 @@ instance Pretty Expression where -- 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 <> (base $ pretty t) -- Force nested operations to start on a new line - absorbOperation x@(Operation _ _ _) = group' False $ line <> nest 2 (pretty x) + absorbOperation x@(Operation _ _ _) = group' False $ line <> pretty x -- Force applications to start on a new line if more than the last argument is multiline - absorbOperation (Application f a) = group $ nest 2 $ hardspace <> prettyApp line mempty f a - absorbOperation x = nest 2 (hardspace <> pretty x) + absorbOperation (Application f a) = group $ hardspace <> prettyApp hardline line mempty mempty f a + absorbOperation x = hardspace <> pretty x prettyOperation :: (Maybe Leaf, Expression) -> Doc -- First element prettyOperation (Nothing, expr) = pretty expr -- The others - -- TODO when expr contains a comment or op' has a trailing comment, move them before op' - prettyOperation ((Just op'), expr) = line <> pretty op' <> absorbOperation expr + prettyOperation ((Just op'), expr) = + line <> pretty (moveTrailingCommentUp op') <> nest 2 (absorbOperation expr) -- Extract comment before the first operand and move it out, to prevent force-expanding the expression (operationWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) operation diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index 578b1549..4a18508f 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -5,6 +5,65 @@ ) # Function call with comment (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + ( # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + + # Same song again, but within function application + + ( + foo bar baz ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + ( + foo bar baz + # Function call with comment + (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + ) + ( + foo bar baz ( # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + + # And again, but with wide function application + + ( + foo + [ 1 2 # multiline + ] + baz ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + ( + foo + [ 1 2 # multiline + ] + bar baz + # Function call with comment + (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + ) + ( + foo + [ 1 2 # multiline + ] + bar baz ( # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + + # Now in attribute set position + { + a = + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + b = # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + } [ (mapAttrsToStringsSep [force long] "\n" mkSection attrsOfAttrs) ] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index a43e3484..0b9777e8 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -1,9 +1,82 @@ [ ( # Function call with comment - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) # Function call with comment (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) + ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + + # Same song again, but within function application + + (foo bar baz ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + )) + ( + foo bar baz + # Function call with comment + ( + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + (foo bar baz ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + )) + + # And again, but with wide function application + + ( + foo + [ + 1 + 2 # multiline + ] + baz + ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + ( + foo + [ + 1 + 2 # multiline + ] + bar + baz + # Function call with comment + ( + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + ( + foo + [ + 1 + 2 # multiline + ] + bar + baz + ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + + # Now in attribute set position + { + a = + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + b = # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; + } [ ( mapAttrsToStringsSep @@ -23,7 +96,8 @@ a # b c ) - ( # a + ( + # a b # c d # e ) diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix index e0c30b9c..6ad3b415 100644 --- a/test/diff/operation/in.nix +++ b/test/diff/operation/in.nix @@ -21,14 +21,36 @@ || # fifth comment baseName == "tests.nix" + || # comment on operator inside + baseName == "tests.nix" + || # comment absorbable term + { } + || # comment absorbable term 2 + { + foo = "bar"; # multiline + } + || # comment on function application + foo bar baz + || # comment on function application 2 + foo bar baz [ + 1 + 2 + ] + || # comment on other + foo ? bar ) # Filter out nix-build result symlinks (type == "symlink" && lib.hasPrefix "result" baseName) ( # Filter out nix-build result symlinks (type == "symlink" && lib.hasPrefix "result" baseName) + # Filter out sockets and other types of files we can't have in the store. + || + (type == "unknown") || # Filter out sockets and other types of files we can't have in the store. (type == "unknown") + || # Filter out sockets and other types of files we can't have in the store. + (type == "unknown") ) ( # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 5f08c0ee..95594917 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -20,8 +20,8 @@ || baseName == "Cargo.nix" || lib.hasSuffix "~" baseName || builtins.match "^\\.sw[a-z]$$" baseName != null - || # a third comment - builtins.match "^\\..*\\.sw[a-z]$$" baseName != null + # a third comment + || builtins.match "^\\..*\\.sw[a-z]$$" baseName != null || lib.hasSuffix ".tmp" baseName || # fourth comment @@ -29,14 +29,35 @@ || # fifth comment baseName == "tests.nix" + # comment on operator inside + || baseName == "tests.nix" + # comment absorbable term + || { } + # comment absorbable term 2 + || { + foo = "bar"; # multiline + } + # comment on function application + || foo bar baz + # comment on function application 2 + || foo bar baz [ + 1 + 2 + ] + # comment on other + || foo ? bar ) # Filter out nix-build result symlinks (type == "symlink" && lib.hasPrefix "result" baseName) ( # Filter out nix-build result symlinks (type == "symlink" && lib.hasPrefix "result" baseName) + # Filter out sockets and other types of files we can't have in the store. + || (type == "unknown") || # Filter out sockets and other types of files we can't have in the store. (type == "unknown") + # Filter out sockets and other types of files we can't have in the store. + || (type == "unknown") ) ( # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 8ea5a24b..0135e50a 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -76,7 +76,8 @@ c # d ) ) - ( # a + ( + # a ( # b c # d ) # e From b86d8ea1a4da5c8fdbae9cead59bd06884a9da20 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 14 Jun 2023 21:33:26 +0200 Subject: [PATCH 045/125] Unindent semicolons again Also apparently empty inherit statements are allowed in Nix and I hate everything about it --- src/Nixfmt/Pretty.hs | 26 ++--- test/diff/apply/out.nix | 20 ++-- test/diff/attr_set/out.nix | 4 +- test/diff/idioms_lib_1/out.nix | 2 +- test/diff/idioms_lib_2/out.nix | 38 +++---- test/diff/idioms_lib_3/out.nix | 62 +++++------ test/diff/idioms_nixos_1/out.nix | 22 ++-- test/diff/idioms_nixos_2/out.nix | 30 +++--- test/diff/idioms_pkgs_2/out.nix | 2 +- test/diff/idioms_pkgs_3/out.nix | 18 ++-- test/diff/inherit/in.nix | 2 + test/diff/inherit/out.nix | 18 ++-- test/diff/inherit_blank_trailing/out.nix | 10 +- test/diff/inherit_comment/out.nix | 4 +- test/diff/inherit_from/in.nix | 2 + test/diff/inherit_from/out.nix | 132 ++++++++++++----------- test/diff/key_value/out.nix | 22 ++-- test/diff/let_in/out.nix | 20 ++-- test/diff/monsters_1/out.nix | 6 +- test/diff/monsters_4/out.nix | 6 +- test/diff/monsters_5/out.nix | 34 +++--- 21 files changed, 244 insertions(+), 236 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 3873064a..29954024 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -102,41 +102,41 @@ instance Pretty Selector where instance Pretty Binder where -- `inherit bar` statement pretty (Inherit inherit Nothing ids semicolon) - = base $ group (pretty inherit <> line - <> nest 2 (sepBy line ids <> line' <> pretty semicolon)) + = base $ group (pretty inherit + <> (if null ids then mempty else line <> nest 2 (sepBy line ids) <> line') + <> pretty semicolon) -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) = base $ group (pretty inherit <> nest 2 ( - (group' False (line <> pretty source)) <> line - <> sepBy line ids - <> line' <> pretty semicolon - )) + (group' False (line <> pretty source)) + <> if null ids then mempty else line <> sepBy line ids + ) <> line' <> pretty semicolon) -- `foo = bar` pretty (Assignment selectors assign expr semicolon) = base $ group $ hcat selectors - <> nest 2 (hardspace <> pretty assign <> inner) + <> nest 2 (hardspace <> pretty assign <> inner) <> pretty semicolon where inner = case expr of -- Absorbable term. Always start on the same line, keep semicolon attatched - (Term t) | isAbsorbable t -> hardspace <> group expr <> pretty semicolon + (Term t) | isAbsorbable t -> hardspace <> group expr -- Non-absorbable term -- If it is multi-line, force it to start on a new line with indentation - (Term _) -> group' False (line <> pretty expr) <> pretty semicolon + (Term _) -> group' False (line <> pretty expr) -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise - (Application f a) -> group $ prettyApp hardline line line' mempty f a <> pretty semicolon + (Application f a) -> group $ prettyApp hardline line line' mempty f a -- With expression: Try to absorb and keep the semicolon attached, spread otherwise - (With _ _ _ _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) + (With _ _ _ _) -> softline <> group' False (pretty expr <> softline') -- Special case `//` operator to treat like an absorbable term - (Operation _ (Ann _ TUpdate _) _) -> softline <> group (pretty expr <> softline' <> pretty semicolon) + (Operation _ (Ann _ TUpdate _) _) -> softline <> group' False (pretty expr <> softline') -- 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) -- Otherwise, start on new line, expand fully (including the semicolon) - _ -> line <> group (pretty expr <> line' <> pretty semicolon) + _ -> line <> group' False (pretty expr <> line') -- | Pretty print a term without wrapping it in a group. prettyTerm :: Term -> Doc diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 0b9777e8..d75c321b 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -141,7 +141,7 @@ # multiline } argument - ; + ; name3 = function arg @@ -151,7 +151,7 @@ } { qwer = 12345; } argument - ; + ; } { name4 = @@ -161,7 +161,7 @@ qwer2 = 54321; } argument - ; + ; } { option1 = @@ -171,7 +171,7 @@ qwer2 = 54321; } lastArg - ; + ; option2 = function arg { asdf = 1; } @@ -180,7 +180,7 @@ qwer2 = 54321; } lastArg - ; + ; option3 = function arg { asdf = 1; } @@ -189,7 +189,7 @@ qwer2 = 54321; } lastArg - ; + ; } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { @@ -199,7 +199,7 @@ }: # For each supported platform, utils.lib.eachDefaultSystem (system: { }) - ; + ; } { escapeSingleline = libStr.escape [ @@ -217,7 +217,7 @@ "''\${" "'''" ] - ; + ; test = foo [ # multiline @@ -233,7 +233,7 @@ 2 3 # multiline ] - ; + ; looooooooong = ( toINI @@ -243,6 +243,6 @@ looooooooong' = toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } sections - ; + ; } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 04181992..354f6f51 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -101,7 +101,7 @@ # several items ] - ; + ; a = [ some @@ -118,7 +118,7 @@ more items ]) - ; + ; b = with pkgs; [ a lot diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix index 48fde2de..c1013cf2 100644 --- a/test/diff/idioms_lib_1/out.nix +++ b/test/diff/idioms_lib_1/out.nix @@ -7,5 +7,5 @@ # Value to return x: if pred then trace msg x else x - ; + ; } diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 88e56ed7..be05b775 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -15,7 +15,7 @@ rec { # The value to return x: x - ; + ; /* The constant function @@ -33,7 +33,7 @@ rec { # Value to ignore y: x - ; + ; /* Pipes a value through a list of functions, left to right. @@ -70,7 +70,7 @@ rec { reverseApply = x: f: f x; in builtins.foldl' reverseApply val functions - ; + ; # note please don’t add a function like `compose = flip pipe`. # This would confuse users, because the order of the functions @@ -137,7 +137,7 @@ rec { # Right attribute set (higher precedence for equal keys) y: x // y - ; + ; /* Flip the order of the arguments of a binary function. @@ -163,7 +163,7 @@ rec { # Argument to check for null before passing it to `f` a: if a == null then a else f a - ; + ; # Pull in some builtins not included elsewhere. inherit (builtins) @@ -178,7 +178,7 @@ rec { seq deepSeq genericClosure - ; + ; ## nixpkgs version strings @@ -204,7 +204,7 @@ rec { lib.strings.fileContents suffixFile else "pre-git" - ; + ; /* Attempts to return the the current revision of nixpkgs and returns the supplied default value otherwise. @@ -224,13 +224,13 @@ rec { lib.fileContents revisionFile else default - ; + ; nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version - ; + ; /* Determine whether the function is being called from inside a Nix shell. @@ -273,7 +273,7 @@ rec { 1 else 0 - ; + ; /* Split type into two subtypes by predicate `p`, take all elements of the first subtype to be less than all the elements of the @@ -310,7 +310,7 @@ rec { 1 else no a b - ; + ; /* Reads a JSON file. @@ -363,7 +363,7 @@ rec { ) else msg: builtins.trace "warning: ${msg}" - ; + ; /* Like warn, but only warn when the first argument is `true`. @@ -413,7 +413,7 @@ rec { } unexpected; valid ones: ${ builtins.concatStringsSep ", " (builtins.map builtins.toString valid) }" - ; + ; info = msg: builtins.trace "INFO: ${msg}"; @@ -436,7 +436,7 @@ rec { __functor = self: f; __functionArgs = args; } - ; + ; /* Extract the expected function arguments from a function. This works both with nix-native { a, b ? foo, ... }: style @@ -450,7 +450,7 @@ rec { f.__functionArgs or (lib.functionArgs (f.__functor f)) else builtins.functionArgs f - ; + ; /* Check whether something is a function or something annotated with function args. @@ -484,10 +484,10 @@ rec { "15" = "F"; } .${toString d} - ; + ; in lib.concatMapStrings toHexDigit (toBaseDigits 16 i) - ; + ; /* `toBaseDigits base i` converts the positive integer i to a list of its digits in the given base. For example: @@ -511,10 +511,10 @@ rec { q = (i - r) / base; in [ r ] ++ go q - ; + ; in assert (base >= 2); assert (i >= 0); lib.reverseList (go i) - ; + ; } diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 1c72739c..46fc2881 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -40,7 +40,7 @@ rec { "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}" ) - ; + ; in if isInt v then toString v @@ -74,7 +74,7 @@ rec { libStr.floatToString v else err "this value is" (toString v) - ; + ; # Generate a line of key k and value v, separated by # character sep. If sep appears in k, it is escaped. @@ -90,7 +90,7 @@ rec { }: sep: k: v: "${libStr.escape [ sep ] k}${sep}${mkValueString v}" - ; + ; ## -- FILE FORMAT GENERATORS -- @@ -109,13 +109,13 @@ rec { k: v: map (mkLine k) (if lib.isList v then v else [ v ]) else k: v: [ (mkLine k v) ] - ; + ; in attrs: libStr.concatStrings ( lib.concatLists (libAttr.mapAttrsToList mkLines attrs) ) - ; + ; # Generate an INI-style config file from an # attrset of sections to an attrset of key-value pairs. @@ -159,18 +159,18 @@ rec { mapAttrsToStringsSep = sep: mapFn: attrs: libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs) - ; + ; mkSection = sectName: sectValues: '' [${mkSectionName sectName}] '' + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues - ; + ; in # map input to ini sections mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ; + ; # Generate an INI-style config file from an attrset # specifying the global section (no header), and an @@ -234,7 +234,7 @@ rec { toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections ) - ; + ; # Generate a git-config file from an attrset. # @@ -270,7 +270,7 @@ rec { name else ''${section} "${subsection}"'' - ; + ; # generation for multiple ini values mkKeyValue = @@ -279,7 +279,7 @@ rec { mkKeyValue = mkKeyValueDefault { } " = " k; in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)) - ; + ; # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI gitFlattenAttrs = @@ -297,16 +297,16 @@ rec { } else { ${head path} = value; } - ; + ; in attrs: lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) - ; + ; toINI_ = toINI { inherit mkKeyValue mkSectionName; }; in toINI_ (gitFlattenAttrs attrs) - ; + ; # Generates JSON from an arbitrary (non-function) value. # For more information see the documentation of the builtin. @@ -336,7 +336,7 @@ rec { stepIntoAttr = evalNext: name: if builtins.elem name specialAttrs then id else evalNext - ; + ; transform = depth: if depthLimit != null && depth > depthLimit then @@ -348,7 +348,7 @@ rec { const "" else id - ; + ; mapAny = with builtins; depth: v: let @@ -360,10 +360,10 @@ rec { map evalNext v else transform (depth + 1) v - ; + ; in mapAny 0 - ; + ; # Pretty print a value, akin to `builtins.trace`. # Should probably be a builtin as well. @@ -395,7 +395,7 @@ rec { ${indent} '' else " " - ; + ; outroSpace = if multiline then '' @@ -403,7 +403,7 @@ rec { ${indent}'' else " " - ; + ; in if isInt v then toString v @@ -430,12 +430,12 @@ rec { "''\${" "'''" ] - ; + ; singlelineResult = ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + ''"'' - ; + ; multilineResult = let escapedLines = map escapeMultiline lines; @@ -448,7 +448,7 @@ rec { + concatStringsSep introSpace (lib.init escapedLines) + (if lastLine == "" then outroSpace else introSpace + lastLine) + "''" - ; + ; in if multiline && length lines > 1 then multilineResult @@ -508,10 +508,10 @@ rec { + "}" else abort "generators.toPretty: should never happen (v = ${v})" - ; + ; in go indent - ; + ; # PLIST handling toPlist = @@ -538,7 +538,7 @@ rec { float ind x else abort "generators.toPlist: should never happen (v = ${v})" - ; + ; literal = ind: x: ind + x; @@ -559,7 +559,7 @@ rec { (item ind x) (literal ind "") ] - ; + ; attrs = ind: x: @@ -568,7 +568,7 @@ rec { (attr ind x) (literal ind "") ] - ; + ; attr = let @@ -588,7 +588,7 @@ rec { x ) ) - ; + ; in '' @@ -596,7 +596,7 @@ rec { ${expr "" v} '' - ; + ; # Translate a simple Nix expression to Dhall notation. # Note that integers are translated to Integer and never @@ -628,5 +628,5 @@ rec { abort "generators.toDhall: cannot convert a null to Dhall" else builtins.toJSON v - ; + ; } diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index b39bfcd4..89a7fb58 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -54,7 +54,7 @@ in ); } ) - ; + ; # We don't want to evaluate all of linuxPackages for the manual # - some of it might not even evaluate correctly. defaultText = literalExpression "pkgs.linuxPackages"; @@ -274,7 +274,7 @@ in "rtc_cmos" ] ) - ; + ; boot.initrd.kernelModules = optionals config.boot.initrd.includeDefaultModules @@ -282,7 +282,7 @@ in # For LVM. "dm_mod" ] - ; + ; }) (mkIf (!config.boot.isContainer) { @@ -298,12 +298,12 @@ in "vga=0x317" "nomodeset" ] - ; + ; boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel - ; + ; boot.kernelModules = [ "loop" @@ -337,7 +337,7 @@ in message = "CONFIG_${option} is not yes!"; configLine = "CONFIG_${option}=y"; } - ; + ; isNo = option: { @@ -345,7 +345,7 @@ in message = "CONFIG_${option} is not no!"; configLine = "CONFIG_${option}=n"; } - ; + ; isModule = option: { @@ -353,7 +353,7 @@ in message = "CONFIG_${option} is not built as a module!"; configLine = "CONFIG_${option}=m"; } - ; + ; ### Usually you will just want to use these two # True if yes or module @@ -363,7 +363,7 @@ in message = "CONFIG_${option} is not enabled!"; configLine = "CONFIG_${option}=y"; } - ; + ; # True if no or omitted isDisabled = @@ -372,7 +372,7 @@ in message = "CONFIG_${option} is not disabled!"; configLine = "CONFIG_${option}=n"; } - ; + ; }; # The config options that all modules can depend upon @@ -398,7 +398,7 @@ in inherit (attrs) message; }) config.system.requiredKernelConfig - ; + ; }) ]; } diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 682a2d11..913a1764 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -41,7 +41,7 @@ let ++ optional cfg.caching.memcached memcached ) ++ cfg.phpExtraExtensions all - ; # Enabled by user + ; # Enabled by user extraConfig = toKeyValue phpOptions; }; @@ -238,7 +238,7 @@ in description = lib.mdDoc "Log level value between 0 (DEBUG) and 4 (FATAL)." - ; + ; }; logType = mkOption { type = types.enum [ @@ -264,7 +264,7 @@ in description = lib.mdDoc "Which package to use for the Nextcloud instance." - ; + ; relatedPackages = [ "nextcloud24" "nextcloud25" @@ -745,7 +745,7 @@ in description = lib.mdDoc "Enable additional recommended HTTP response headers" - ; + ; }; hstsMaxAge = mkOption { type = types.ints.positive; @@ -784,7 +784,7 @@ in The package can be upgraded by explicitly declaring the service-option `services.nextcloud.package`. '' - ; + ; in (optional (cfg.poolConfig != null) '' Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. @@ -819,7 +819,7 @@ in For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 '') - ; + ; services.nextcloud.package = with pkgs; mkDefault ( @@ -842,7 +842,7 @@ in pkgs.php81 else pkgs.php82 - ; + ; } { @@ -877,7 +877,7 @@ in writePhpArray = a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]" - ; + ; requiresReadSecretFunction = c.dbpassFile != null || c.objectstore.s3.enable; objectstoreConfig = @@ -914,7 +914,7 @@ in ], ] '' - ; + ; showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; @@ -923,7 +923,7 @@ in x = cfg.appstoreEnable; in if x == null then "false" else boolToString x - ; + ; nextcloudGreaterOrEqualThan = req: versionAtLeast cfg.package.version req; @@ -1046,7 +1046,7 @@ in value, }: "export ${arg}=${value}" - ; + ; dbpass = { arg = "DBPASS"; value = @@ -1054,7 +1054,7 @@ in ''"$(<"${toString c.dbpassFile}")"'' else ''""'' - ; + ; }; adminpass = { arg = "ADMINPASS"; @@ -1087,7 +1087,7 @@ in ${occ}/bin/nextcloud-occ maintenance:install \ ${installFlags} '' - ; + ; occSetTrustedDomainsCmd = concatStringsSep "\n" ( imap0 (i: v: '' @@ -1171,9 +1171,9 @@ in environment.NC_setup_create_db_user = lib.mkIf (nextcloudGreaterOrEqualThan "26") "false" - ; + ; } - ; + ; nextcloud-cron = { after = [ "nextcloud-setup.service" ]; environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index ceb3617a..8f11dc26 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -27,7 +27,7 @@ stdenv.mkDerivation rec { "hello must not be rebuilt when environment.noXlibs is set." hello (nixos { environment.noXlibs = true; }).pkgs.hello - ; + ; }; meta = with lib; { diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 487593a8..e9578888 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -184,7 +184,7 @@ let buildPackages.rustc.llvmPackages.bintools else stdenv.cc.bintools - ; + ; } ); @@ -271,7 +271,7 @@ buildStdenv.mkDerivation ({ lib.optional (lib.versionAtLeast version "96") ./no-buildconfig-ffx96.patch ++ extraPatches - ; + ; postPatch = '' @@ -279,7 +279,7 @@ buildStdenv.mkDerivation ({ patchShebangs mach build '' + extraPostPatch - ; + ; # Ignore trivial whitespace changes in patches, this fixes compatibility of # ./env_var_for_system_dir.patch with Firefox >=65 without having to track @@ -317,7 +317,7 @@ buildStdenv.mkDerivation ({ ] ++ lib.optionals pgoSupport [ xvfb-run ] ++ extraNativeBuildInputs - ; + ; setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. @@ -390,7 +390,7 @@ buildStdenv.mkDerivation ({ + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' export MOZILLA_OFFICIAL=1 '' - ; + ; # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags configurePlatforms = [ ]; @@ -463,7 +463,7 @@ buildStdenv.mkDerivation ({ ++ lib.optional enableOfficialBranding "--enable-official-branding" ++ lib.optional (branding != null) "--with-branding=${branding}" ++ extraConfigureFlags - ; + ; buildInputs = [ @@ -515,7 +515,7 @@ buildStdenv.mkDerivation ({ ] ++ lib.optional jemallocSupport jemalloc ++ extraBuildInputs - ; + ; profilingPhase = lib.optionalString pgoSupport '' # Package up Firefox for profiling @@ -564,7 +564,7 @@ buildStdenv.mkDerivation ({ + '' cd mozobj '' - ; + ; postInstall = '' @@ -580,7 +580,7 @@ buildStdenv.mkDerivation ({ # Needed to find Mozilla runtime gappsWrapperArgs+=(--argv0 "$out/bin/.${binaryName}-wrapped") '' - ; + ; postFixup = lib.optionalString crashreporterSupport '' patchelf --add-rpath "${ diff --git a/test/diff/inherit/in.nix b/test/diff/inherit/in.nix index 84dfa140..121118ac 100644 --- a/test/diff/inherit/in.nix +++ b/test/diff/inherit/in.nix @@ -1,5 +1,7 @@ [ { + # empty inherit o.O + inherit; inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index 31f53916..9acff392 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -1,5 +1,7 @@ [ { + # empty inherit o.O + inherit; inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } { @@ -10,43 +12,43 @@ inherit b d # e - ; + ; } { inherit b # c d - ; + ; } { inherit b # c d # e - ; + ; } { inherit # a b d - ; + ; } { inherit # a b d # e - ; + ; } { inherit # a b # c d - ; + ; } { inherit # a b # c d # e - ; + ; } { inherit # test @@ -61,6 +63,6 @@ g h - ; + ; } ] diff --git a/test/diff/inherit_blank_trailing/out.nix b/test/diff/inherit_blank_trailing/out.nix index 7e8b2469..4d4419e3 100644 --- a/test/diff/inherit_blank_trailing/out.nix +++ b/test/diff/inherit_blank_trailing/out.nix @@ -12,7 +12,7 @@ g h - ; + ; } { inherit @@ -25,9 +25,9 @@ b # multiple newlines c # multiple comments - # comment 1 - # comment 2 - # comment 3 - ; + # comment 1 + # comment 2 + # comment 3 + ; } ] diff --git a/test/diff/inherit_comment/out.nix b/test/diff/inherit_comment/out.nix index 45c2bb99..b86a255c 100644 --- a/test/diff/inherit_comment/out.nix +++ b/test/diff/inherit_comment/out.nix @@ -3,7 +3,7 @@ a # b c - ; + ; # https://github.com/kamadorueda/alejandra/issues/372 inherit (pkgs.haskell.lib) @@ -14,5 +14,5 @@ # override deps of a package # see what can be overriden - https://github.com/NixOS/nixpkgs/blob/0ba44a03f620806a2558a699dba143e6cf9858db/pkgs/development/haskell-modules/generic-builder.nix#L13 overrideCabal - ; + ; } diff --git a/test/diff/inherit_from/in.nix b/test/diff/inherit_from/in.nix index d1175b68..fee7dbcd 100644 --- a/test/diff/inherit_from/in.nix +++ b/test/diff/inherit_from/in.nix @@ -1,5 +1,7 @@ [ { + # empty inherit o.O + inherit (geany.meta) ; inherit (builtins) pathExists readFile isBool isInt isFloat add sub lessThan diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index c04c21b9..9cb0e90d 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -1,5 +1,7 @@ [ { + # empty inherit o.O + inherit (geany.meta); inherit (builtins) pathExists readFile @@ -12,7 +14,7 @@ seq deepSeq genericClosure - ; + ; } { inherit @@ -22,50 +24,50 @@ }) foo bar - ; + ; } { inherit (c) f h; } { inherit (c) f h # i - ; + ; } { inherit (c) f # g h - ; + ; } { inherit (c) f # g h # i - ; + ; } { inherit (c) # e f h - ; + ; } { inherit (c) # e f h # i - ; + ; } { inherit (c) # e f # g h - ; + ; } { inherit (c) # e f # g h # i - ; + ; } { inherit @@ -74,7 +76,7 @@ ) f h - ; + ; } { inherit @@ -83,7 +85,7 @@ ) f h # i - ; + ; } { inherit @@ -92,7 +94,7 @@ ) f # g h - ; + ; } { inherit @@ -101,7 +103,7 @@ ) f # g h # i - ; + ; } { inherit @@ -110,7 +112,7 @@ ) # e f h - ; + ; } { inherit @@ -119,7 +121,7 @@ ) # e f h # i - ; + ; } { inherit @@ -128,7 +130,7 @@ ) # e f # g h - ; + ; } { inherit @@ -137,7 +139,7 @@ ) # e f # g h # i - ; + ; } { inherit @@ -146,7 +148,7 @@ ) f h - ; + ; } { inherit @@ -155,7 +157,7 @@ ) f h # i - ; + ; } { inherit @@ -164,7 +166,7 @@ ) f # g h - ; + ; } { inherit @@ -173,7 +175,7 @@ ) f # g h # i - ; + ; } { inherit @@ -182,7 +184,7 @@ ) # e f h - ; + ; } { inherit @@ -191,7 +193,7 @@ ) # e f h # i - ; + ; } { inherit @@ -200,7 +202,7 @@ ) # e f # g h - ; + ; } { inherit @@ -209,7 +211,7 @@ ) # e f # g h # i - ; + ; } { inherit @@ -218,7 +220,7 @@ ) f h - ; + ; } { inherit @@ -227,7 +229,7 @@ ) f h # i - ; + ; } { inherit @@ -236,7 +238,7 @@ ) f # g h - ; + ; } { inherit @@ -245,7 +247,7 @@ ) f # g h # i - ; + ; } { inherit @@ -254,7 +256,7 @@ ) # e f h - ; + ; } { inherit @@ -263,7 +265,7 @@ ) # e f h # i - ; + ; } { inherit @@ -272,7 +274,7 @@ ) # e f # g h - ; + ; } { inherit @@ -281,63 +283,63 @@ ) # e f # g h # i - ; + ; } { inherit # a (c) f h - ; + ; } { inherit # a (c) f h # i - ; + ; } { inherit # a (c) f # g h - ; + ; } { inherit # a (c) f # g h # i - ; + ; } { inherit # a (c) # e f h - ; + ; } { inherit # a (c) # e f h # i - ; + ; } { inherit # a (c) # e f # g h - ; + ; } { inherit # a (c) # e f # g h # i - ; + ; } { inherit # a @@ -346,7 +348,7 @@ ) f h - ; + ; } { inherit # a @@ -355,7 +357,7 @@ ) f h # i - ; + ; } { inherit # a @@ -364,7 +366,7 @@ ) f # g h - ; + ; } { inherit # a @@ -373,7 +375,7 @@ ) f # g h # i - ; + ; } { inherit # a @@ -382,7 +384,7 @@ ) # e f h - ; + ; } { inherit # a @@ -391,7 +393,7 @@ ) # e f h # i - ; + ; } { inherit # a @@ -400,7 +402,7 @@ ) # e f # g h - ; + ; } { inherit # a @@ -409,7 +411,7 @@ ) # e f # g h # i - ; + ; } { inherit # a @@ -418,7 +420,7 @@ ) f h - ; + ; } { inherit # a @@ -427,7 +429,7 @@ ) f h # i - ; + ; } { inherit # a @@ -436,7 +438,7 @@ ) f # g h - ; + ; } { inherit # a @@ -445,7 +447,7 @@ ) f # g h # i - ; + ; } { inherit # a @@ -454,7 +456,7 @@ ) # e f h - ; + ; } { inherit # a @@ -463,7 +465,7 @@ ) # e f h # i - ; + ; } { inherit # a @@ -472,7 +474,7 @@ ) # e f # g h - ; + ; } { inherit # a @@ -481,7 +483,7 @@ ) # e f # g h # i - ; + ; } { inherit # a @@ -490,7 +492,7 @@ ) f h - ; + ; } { inherit # a @@ -499,7 +501,7 @@ ) f h # i - ; + ; } { inherit # a @@ -508,7 +510,7 @@ ) f # g h - ; + ; } { inherit # a @@ -517,7 +519,7 @@ ) f # g h # i - ; + ; } { inherit # a @@ -526,7 +528,7 @@ ) # e f h - ; + ; } { inherit # a @@ -535,7 +537,7 @@ ) # e f h # i - ; + ; } { inherit # a @@ -544,7 +546,7 @@ ) # e f # g h - ; + ; } { inherit # a @@ -553,6 +555,6 @@ ) # e f # g h # i - ; + ; } ] diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 36acdef9..8972cece 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -7,7 +7,7 @@ rec { b = { a = 1 # d - ; + ; }; c = { @@ -17,7 +17,7 @@ rec { d = { a = # c 1 # d - ; + ; }; e = { a # b @@ -26,7 +26,7 @@ rec { f = { a # b = 1 # d - ; + ; }; h = { a # b @@ -37,7 +37,7 @@ rec { a # b = # c 1 # d - ; + ; }; j = a: { b = 1; }; k = @@ -45,20 +45,20 @@ rec { b = 1; c = 2; } - ; + ; l = a: # b { b = 1; } - ; + ; m = a: # b { b = 1; c = 2; } - ; + ; n = pkgs: { }; o = { @@ -66,18 +66,18 @@ rec { ... }: { } - ; + ; a # b = # c 1 - # d - ; + # d + ; p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a - ; + ; } diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index 8b0f8f30..e9a4b377 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -6,13 +6,13 @@ let c = 3; in d - ; + ; a = let c = 1; in f - ; + ; a = let @@ -20,13 +20,13 @@ let in # e f - ; + ; a = let c = 1; # d in f - ; + ; a = let @@ -34,33 +34,33 @@ let in # e f - ; + ; a = let # b c = 1; in f - ; + ; a = let # b c = 1; in # e f - ; + ; a = let # b c = 1; # d in f - ; + ; a = let # b c = 1; # d in # e f - ; + ; a = let @@ -69,7 +69,7 @@ let 1 2 ] - ; + ; in a diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index b47a004b..2e38f998 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -127,7 +127,7 @@ stdenv.mkDerivation "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # foo } - ; + ; # foo cargoDeps # foo @@ -140,7 +140,7 @@ stdenv.mkDerivation inherit # foo src - ; + ; # foo name # foo @@ -155,7 +155,7 @@ stdenv.mkDerivation "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # foo } - ; + ; # foo nativeBuildInputs # foo diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index e5e7c993..fcfcbe44 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -63,14 +63,14 @@ stdenv.mkDerivation # Foo = # Foo "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo } - ; # Foo + ; # Foo cargoDeps # Foo = # Foo rustPlatform.fetchCargoTarball # Foo { # Foo inherit # Foo src - ; # Foo + ; # Foo name # Foo = # Foo "${pname}-${version}"; # Foo @@ -78,7 +78,7 @@ stdenv.mkDerivation # Foo = # Foo "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo } - ; # Foo + ; # Foo nativeBuildInputs # Foo = # Foo [ # Foo diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 48531134..5f2d8e9d 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -21,7 +21,7 @@ let (config.boot) kernelPatches - ; + ; inherit @@ -30,14 +30,14 @@ let features randstructSeed - ; + ; inherit (config.boot.kernelPackages) kernel - ; + ; kernelModulesConf @@ -50,7 +50,7 @@ let '' ${concatStringsSep "\n" config.boot.kernelModules} '' - ; + ; in { @@ -84,7 +84,7 @@ in literalExpression "{debug= true;}" - ; + ; internal @@ -104,7 +104,7 @@ in `grep features pkgs/os-specific/linux/kernel/common-config.nix` ''; } - ; + ; boot.kernelPackages @@ -166,7 +166,7 @@ in inherit randstructSeed - ; + ; kernelPatches @@ -182,7 +182,7 @@ in ++ kernelPatches - ; + ; features @@ -193,13 +193,13 @@ in super.kernel.features features - ; + ; } ) - ; + ; } ) - ; + ; # We don't want to evaluate all of linuxPackages for the manual # - some of it might not even evaluate correctly. @@ -211,7 +211,7 @@ in literalExpression "pkgs.linuxPackages" - ; + ; example @@ -220,7 +220,7 @@ in literalExpression "pkgs.linuxKernel.packages.linux_5_10" - ; + ; description @@ -239,7 +239,7 @@ in nvidia_x11. ''; } - ; + ; boot.kernelPatches @@ -256,7 +256,7 @@ in types.listOf types.attrs - ; + ; default @@ -271,10 +271,10 @@ in literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]" - ; + ; description = "A list of additional patches to apply to the kernel."; } - ; + ; }; } From 9a6cc7f46cf82f677d4b7d852bf0463f5a5473c6 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 14 Jun 2023 21:37:15 +0200 Subject: [PATCH 046/125] Don't absorb lambda body --- src/Nixfmt/Pretty.hs | 2 +- test/diff/lambda/out.nix | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 29954024..8d8f0ca1 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -414,7 +414,7 @@ instance Pretty Expression where absorbAbs x = absorbSet x pretty (Abstraction param colon body) - = pretty param <> pretty colon <> absorbSet body + = pretty param <> pretty colon <> line <> pretty body pretty (Application f a) = prettyApp mempty mempty mempty mempty f a diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 64d7b912..832611a0 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -46,7 +46,8 @@ { pkgs, ... - }: { + }: + { # Stuff } ) From 3da135dcd4e423cced02479343b7ebe179816ee8 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 14 Jun 2023 23:33:22 +0200 Subject: [PATCH 047/125] Absorb parenthesized function calls again --- src/Nixfmt/Pretty.hs | 2 +- test/diff/apply/out.nix | 121 ++++++++++++++----------------- test/diff/idioms_lib_3/out.nix | 5 +- test/diff/idioms_nixos_2/out.nix | 94 ++++++++++++------------ 4 files changed, 104 insertions(+), 118 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 8d8f0ca1..569d383e 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -196,7 +196,7 @@ prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) = base $ groupWithStart (Ann pre paropen Nothing) $ nest 2 ( -- Move comment trailing on '(' to next line, combine with comment from application case pretty post of { [] -> []; c -> hardline <> c } - <> prettyApp hardline line' line' hardline f a + <> base (prettyApp hardline mempty line' hardline f a) <> case pretty post of { [] -> mempty; _ -> hardline } ) <> pretty parclose diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index d75c321b..f36ad6eb 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -16,12 +16,11 @@ # Function call with comment mapAttrsToStringsSep "\n" mkSection attrsOfAttrs )) - ( - foo bar baz - # Function call with comment - ( - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ) + (foo bar baz + # Function call with comment + ( + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) ) (foo bar baz ( # Function call with comment @@ -30,43 +29,40 @@ # And again, but with wide function application - ( - foo - [ - 1 - 2 # multiline - ] - baz - ( - # Function call with comment - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ) - ) - ( - foo - [ - 1 - 2 # multiline - ] - bar - baz + (foo + [ + 1 + 2 # multiline + ] + baz + ( # Function call with comment - ( - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ) + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) ) - ( - foo - [ - 1 - 2 # multiline - ] - bar - baz - ( - # Function call with comment - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ) + (foo + [ + 1 + 2 # multiline + ] + bar + baz + # Function call with comment + ( + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) + ) + (foo + [ + 1 + 2 # multiline + ] + bar + baz + ( + # Function call with comment + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs + ) ) # Now in attribute set position @@ -78,29 +74,26 @@ mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; } [ - ( - mapAttrsToStringsSep - [ - force - long - ] - "\n" - mkSection - attrsOfAttrs + (mapAttrsToStringsSep + [ + force + long + ] + "\n" + mkSection + attrsOfAttrs ) ] (a b) - ( - (a b) (a b) - ( - a # b - c - ) - ( - # a - b # c - d # e - ) + ((a b) (a b) + (a # b + c + ) + ( + # a + b # c + d # e + ) ) '' otherModules=${ @@ -235,10 +228,8 @@ ] ; looooooooong = - ( - toINI - { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } - sections + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + sections ); looooooooong' = toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 46fc2881..5c2b4460 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -230,9 +230,8 @@ rec { (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" ) - + ( - toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } - sections + + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } + sections ) ; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 913a1764..6a5bdc80 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -74,61 +74,57 @@ in { imports = [ - ( - mkRemovedOptionModule - [ - "services" - "nextcloud" - "config" - "adminpass" - ] - '' - Please use `services.nextcloud.config.adminpassFile' instead! - '' + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "config" + "adminpass" + ] + '' + Please use `services.nextcloud.config.adminpassFile' instead! + '' ) - ( - mkRemovedOptionModule - [ - "services" - "nextcloud" - "config" - "dbpass" - ] - '' - Please use `services.nextcloud.config.dbpassFile' instead! - '' + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "config" + "dbpass" + ] + '' + Please use `services.nextcloud.config.dbpassFile' instead! + '' ) - ( - mkRemovedOptionModule - [ - "services" - "nextcloud" - "nginx" - "enable" - ] - '' - The nextcloud module supports `nginx` as reverse-proxy by default and doesn't - support other reverse-proxies officially. + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "nginx" + "enable" + ] + '' + The nextcloud module supports `nginx` as reverse-proxy by default and doesn't + support other reverse-proxies officially. - However it's possible to use an alternative reverse-proxy by + However it's possible to use an alternative reverse-proxy by - * disabling nginx - * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value + * disabling nginx + * setting `listen.owner` & `listen.group` in the phpfpm-pool to a different value - Further details about this can be found in the `Nextcloud`-section of the NixOS-manual - (which can be opened e.g. by running `nixos-help`). - '' + Further details about this can be found in the `Nextcloud`-section of the NixOS-manual + (which can be opened e.g. by running `nixos-help`). + '' ) - ( - mkRemovedOptionModule - [ - "services" - "nextcloud" - "disableImagemagick" - ] - '' - Use services.nextcloud.enableImagemagick instead. - '' + (mkRemovedOptionModule + [ + "services" + "nextcloud" + "disableImagemagick" + ] + '' + Use services.nextcloud.enableImagemagick instead. + '' ) ]; From 66b67122c81bf96ee1cc0638dc785699d8c46772 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 22 Jun 2023 15:01:37 +0200 Subject: [PATCH 048/125] Binder with with: absorb less --- src/Nixfmt/Pretty.hs | 4 ++-- test/diff/idioms_lib_3/out.nix | 3 ++- test/diff/idioms_nixos_1/out.nix | 6 ++++-- test/diff/idioms_nixos_2/out.nix | 12 ++++++++---- test/diff/monsters_4/out.nix | 3 ++- test/diff/with/out.nix | 12 ++++++++---- 6 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 569d383e..0a74ca3f 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -128,8 +128,8 @@ instance Pretty Binder where -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise (Application f a) -> group $ prettyApp hardline line line' mempty f a - -- With expression: Try to absorb and keep the semicolon attached, spread otherwise - (With _ _ _ _) -> softline <> group' False (pretty expr <> softline') + -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise + (With _ _ _ (Term t)) | isAbsorbable t -> softline <> group' False (pretty expr <> softline') -- Special case `//` operator to treat like an absorbable term (Operation _ (Ann _ TUpdate _) _) -> softline <> group' False (pretty expr <> softline') -- Everything else: diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 5c2b4460..01fc4a82 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -348,7 +348,8 @@ rec { else id ; - mapAny = with builtins; + mapAny = + with builtins; depth: v: let evalNext = x: mapAny (depth + 1) (transform (depth + 1) x); diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 89a7fb58..0963a2dd 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -376,13 +376,15 @@ in }; # The config options that all modules can depend upon - system.requiredKernelConfig = with config.lib.kernelConfig; + system.requiredKernelConfig = + with config.lib.kernelConfig; [ # !!! Should this really be needed? (isYes "MODULES") (isYes "BINFMT_ELF") ] - ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); + ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")) + ; # nixpkgs kernels are assumed to have all required features assertions = diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 6a5bdc80..8952ef0a 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -344,14 +344,16 @@ in }; poolSettings = mkOption { - type = with types; + type = + with types; attrsOf ( oneOf [ str int bool ] - ); + ) + ; default = { "pm" = "dynamic"; "pm.max_children" = "32"; @@ -817,7 +819,8 @@ in '') ; - services.nextcloud.package = with pkgs; + services.nextcloud.package = + with pkgs; mkDefault ( if pkgs ? nextcloud then throw '' @@ -831,7 +834,8 @@ in nextcloud25 else nextcloud26 - ); + ) + ; services.nextcloud.phpPackage = if versionOlder cfg.package.version "26" then diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index fcfcbe44..aaad8f16 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -132,7 +132,8 @@ stdenv.mkDerivation # Foo maintainers; # Foo [ # Foo jtojnar # Foo - ]; # Foo + ] + ; # Foo platforms # Foo = # Foo platforms.unix; # Foo diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 62205285..f2ca1004 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -27,9 +27,11 @@ }; } { - a = with b; + a = + with b; # comment - 1; + 1 + ; } { a = with b; 1; @@ -54,10 +56,12 @@ ) { a = with b; with b; with b; 1; } { - binPath = with pkgs; + binPath = + with pkgs; makeBinPath ([ rsync util-linux - ]); + ]) + ; } ] From 5bb06398e0e0c9852ce90ea819faf4a100854aa9 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 23 Jun 2023 18:44:42 +0200 Subject: [PATCH 049/125] Rework sets and lists Mainly try to be smarter about comments around their start --- src/Nixfmt/Predoc.hs | 6 +++ src/Nixfmt/Pretty.hs | 72 ++++++++++++++++---------------- test/diff/apply/out.nix | 3 +- test/diff/attr_set/out.nix | 21 ++++++---- test/diff/comment/out.nix | 6 ++- test/diff/idioms_lib_2/out.nix | 3 +- test/diff/idioms_nixos_1/out.nix | 3 +- test/diff/idioms_pkgs_4/out.nix | 3 +- test/diff/lists/out.nix | 12 ++++-- test/diff/monsters_4/out.nix | 21 ++++++---- 10 files changed, 91 insertions(+), 59 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index aa8536a3..c80e25f8 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -114,6 +114,12 @@ instance Pretty a => Pretty (Maybe a) where pretty Nothing = mempty pretty (Just x) = pretty x +instance (Pretty a, Pretty b) => Pretty (a, b) where + pretty (a, b) = pretty a <> pretty b + +instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where + pretty (a, b, c) = pretty a <> pretty b <> pretty c + text :: Text -> Doc text "" = [] text t = [Text t] diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 0a74ca3f..42e2f009 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes, TupleSections #-} module Nixfmt.Pretty where @@ -33,12 +33,16 @@ prettyCommentLine l | Text.null l = emptyline | otherwise = text l <> hardline -toLineComment :: Text -> Trivium -toLineComment c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c +toLineComment :: TrailingComment -> Trivium +toLineComment (TrailingComment c) = LineComment $ " " <> c + +-- The prime variant also strips leading * prefix +toLineComment' :: Text -> Trivium +toLineComment' c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c -- If the token has some trailing comment after it, move that in front of the token moveTrailingCommentUp :: Ann a -> Ann a -moveTrailingCommentUp (Ann pre a (Just (TrailingComment post))) = Ann (pre ++ [LineComment (" " <> post)]) a Nothing +moveTrailingCommentUp (Ann pre a (Just post)) = Ann (pre ++ [toLineComment post]) a Nothing moveTrailingCommentUp a = a -- Make sure a group is not expanded because the token that starts it has @@ -57,24 +61,27 @@ instance Pretty Trivium where pretty EmptyLine = emptyline pretty (LineComment c) = text "#" <> pretty c <> hardline pretty (BlockComment c) - | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment c) + | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment' c) | otherwise = base $ text "/*" <> hardspace <> nest 3 (hcat (map prettyCommentLine c)) <> text "*/" <> hardline +instance Pretty a => Pretty (Item a) where + pretty (DetachedComments trivia) = pretty trivia + pretty (CommentedItem trivia x) = pretty trivia <> group x + -- For lists, attribute sets and let bindings prettyItems :: Pretty a => Doc -> Items a -> Doc prettyItems sep = prettyItems' . unItems where prettyItems' :: Pretty a => [Item a] -> Doc prettyItems' [] = mempty - prettyItems' [DetachedComments trivia] = pretty trivia - prettyItems' [CommentedItem trivia x] = pretty trivia <> group x - prettyItems' (DetachedComments trivia : xs) - = pretty trivia <> emptyline <> prettyItems' xs - prettyItems' (CommentedItem trivia x : xs) - = pretty trivia <> group x <> sep <> prettyItems' xs + prettyItems' [item] = pretty item + prettyItems' (item : xs) + = pretty item + <> case item of { CommentedItem _ _ -> sep; DetachedComments _ -> emptyline } + <> prettyItems' xs instance Pretty [Trivium] where pretty [] = mempty @@ -157,38 +164,33 @@ prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trail -- Singleton list -- Expand unless absorbable term or single line -prettyTerm (List (Ann leading paropen Nothing) (Items [CommentedItem [] item]) (Ann [] parclose trailing)) - = base $ pretty leading <> pretty paropen - <> (if isAbsorbable item then - (hardspace <> pretty item <> hardspace) - else - (line <> nest 2 (pretty item) <> line) - ) <> pretty parclose <> pretty trailing +prettyTerm (List paropen@(Ann _ _ Nothing) (Items [item@(CommentedItem iComment item')]) parclose@(Ann [] _ _)) + = base $ groupWithStart paropen $ + (if isAbsorbable item' && null iComment then + (hardspace <> pretty item' <> hardspace) + else + (line <> nest 2 (pretty item) <> line) + ) + <> pretty parclose -- General list (len >= 2) -- Always expand -prettyTerm (List (Ann [] paropen trailing) items parclose) - = base $ pretty paropen <> pretty trailing <> hardline - <> nest 2 (prettyItems hardline items) <> hardline - <> pretty parclose - --- Lists with leading comments get their own group so the comments don't always --- force the list to be split over multiple lines. -prettyTerm (List paropen items parclose) - = base $ groupWithStart paropen $ - line - <> nest 2 (prettyItems hardline items) <> line - <> pretty parclose +prettyTerm (List (Ann pre paropen post) items parclose) = + base $ pretty (Ann pre paropen Nothing) <> hardline + <> nest 2 ((pretty post) <> prettyItems hardline items) <> hardline + <> pretty parclose -- Empty, non-recursive attribute set -prettyTerm (Set Nothing (Ann [] paropen Nothing) (Items []) parclose) +prettyTerm (Set Nothing (Ann [] paropen Nothing) (Items []) parclose@(Ann [] _ _)) = pretty paropen <> hardspace <> pretty parclose -- General set -prettyTerm (Set krec paropen binders parclose) - = base $ pretty (fmap ((<>hardspace) . pretty) krec) - <> pretty paropen <> line - <> nest 2 (prettyItems hardline binders) <> line +-- Singleton sets are allowed to fit onto one line, +-- but apart from that always expand. +prettyTerm (Set krec (Ann pre paropen post) binders parclose) + = base $ pretty (fmap (, hardspace) krec) <> + pretty (Ann pre paropen Nothing) <> line + <> nest 2 (pretty post <> prettyItems hardline binders) <> line <> pretty parclose -- Parenthesized application diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index f36ad6eb..31839c6e 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -213,7 +213,8 @@ ; test = foo - [ # multiline + [ + # multiline 1 2 3 diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 354f6f51..6766a483 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -1,6 +1,7 @@ [ { } - { # a + { + # a } { a = 1; } { a = 1; } @@ -9,10 +10,12 @@ { b = 1; # c } - { # a + { + # a b = 1; } - { # a + { + # a b = 1; # c } @@ -20,10 +23,12 @@ rec { c = 1; # d } - rec { # b + rec { + # b c = 1; } - rec { # b + rec { + # b c = 1; # d } rec # a @@ -35,11 +40,13 @@ c = 1; # d } rec # a - { # b + { + # b c = 1; } rec # a - { # b + { + # b c = 1; # d } diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index e86b3079..d3f0cf3d 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -30,7 +30,8 @@ # test # test - [ # 1 + [ + # 1 #2 a # 3 b @@ -47,7 +48,8 @@ a = 123; # comment } - { # 1 + { + # 1 #2 a = 1; # 3 b = 1; diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index be05b775..4008d17a 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -432,7 +432,8 @@ rec { like callPackage expect to be able to query expected arguments. */ setFunctionArgs = - f: args: { # TODO: Should we add call-time "type" checking like built in? + f: args: { + # TODO: Should we add call-time "type" checking like built in? __functor = self: f; __functionArgs = args; } diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 0963a2dd..ae93f764 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -322,7 +322,8 @@ in systemd.services.systemd-modules-load = { wantedBy = [ "multi-user.target" ]; restartTriggers = [ kernelModulesConf ]; - serviceConfig = { # Ignore failed module loads. Typically some of the + serviceConfig = { + # Ignore failed module loads. Typically some of the # modules in ‘boot.kernelModules’ are "nice to have but # not required" (e.g. acpi-cpufreq), so we don't want to # barf on those. diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index 21da7714..4d739952 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -164,7 +164,8 @@ in cc = let nativePrefix = - { # switch + { + # switch i686-solaris = "/usr/gnu"; x86_64-solaris = "/opt/local/gcc47"; } diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 79c3448a..b8dec391 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -32,19 +32,23 @@ b # c d # e ] - [ # a + [ + # a b d ] - [ # a + [ + # a b d # e ] - [ # a + [ + # a b # c d ] - [ # a + [ + # a b # c d # e ] diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index aaad8f16..e8d6cedc 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -33,7 +33,8 @@ }: # Foo stdenv.mkDerivation # Foo rec # Foo - { # Foo + { + # Foo pname # Foo = # Foo "contrast"; # Foo @@ -43,7 +44,8 @@ stdenv.mkDerivation # Foo src # Foo = # Foo fetchFromGitLab # Foo - { # Foo + { + # Foo domain # Foo = # Foo "gitlab.gnome.org"; # Foo @@ -67,7 +69,8 @@ stdenv.mkDerivation # Foo cargoDeps # Foo = # Foo rustPlatform.fetchCargoTarball # Foo - { # Foo + { + # Foo inherit # Foo src ; # Foo @@ -81,7 +84,8 @@ stdenv.mkDerivation # Foo ; # Foo nativeBuildInputs # Foo = # Foo - [ # Foo + [ + # Foo desktop-file-utils # Foo gettext # Foo meson # Foo @@ -97,7 +101,8 @@ stdenv.mkDerivation # Foo ]; # Foo buildInputs # Foo = # Foo - [ # Foo + [ + # Foo cairo # Foo glib # Foo gtk4 # Foo @@ -116,7 +121,8 @@ stdenv.mkDerivation # Foo = # Foo with # Foo lib; # Foo - { # Foo + { + # Foo description # Foo = # Foo "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo @@ -130,7 +136,8 @@ stdenv.mkDerivation # Foo = # Foo with # Foo maintainers; # Foo - [ # Foo + [ + # Foo jtojnar # Foo ] ; # Foo From f7cf76fe4f36836b4dd51444557914b3d5f639c3 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 23 Jun 2023 23:20:52 +0200 Subject: [PATCH 050/125] Force-spread inherit with more than three items even if all items would fit onto one line. We already do so for lists and attribute sets with more than one element, so this is only consistent. The motivation is to keep the line length and contraction at bay even with large maximum line sizes. The limit of 3 was chosen imperically. --- src/Nixfmt/Pretty.hs | 5 +++-- test/diff/apply/out.nix | 20 ++++++++++++++++++-- test/diff/idioms_pkgs_4/out.nix | 7 ++++++- test/diff/inherit/in.nix | 1 + test/diff/inherit/out.nix | 14 ++++++++++++++ test/diff/inherit_from/in.nix | 1 + test/diff/inherit_from/out.nix | 14 ++++++++++++++ 7 files changed, 57 insertions(+), 5 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 42e2f009..eebd7f54 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -110,14 +110,15 @@ instance Pretty Binder where -- `inherit bar` statement pretty (Inherit inherit Nothing ids semicolon) = base $ group (pretty inherit - <> (if null ids then mempty else line <> nest 2 (sepBy line ids) <> line') + <> (if null ids then mempty else line <> nest 2 (sepBy (if length ids < 4 then line else hardline) ids) <> line') <> pretty semicolon) -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) = base $ group (pretty inherit <> nest 2 ( (group' False (line <> pretty source)) - <> if null ids then mempty else line <> sepBy line ids + <> if null ids then mempty else line + <> sepBy (if length ids < 4 then line else hardline) ids ) <> line' <> pretty semicolon) -- `foo = bar` diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 31839c6e..5e72ca30 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -229,11 +229,27 @@ ] ; looooooooong = - (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + (toINI + { + inherit + mkSectionName + mkKeyValue + listsAsDuplicateKeys + aaaaaaaa + ; + } sections ); looooooooong' = - toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } + toINI + { + inherit + mkSectionName + mkKeyValue + listsAsDuplicateKeys + aaaaaaaa + ; + } sections ; } diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index 4d739952..95551743 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -143,7 +143,12 @@ let fetchurlBoot = fetchurl; - inherit shell cc overrides config; + inherit + shell + cc + overrides + config + ; } ; in diff --git a/test/diff/inherit/in.nix b/test/diff/inherit/in.nix index 121118ac..a66fc107 100644 --- a/test/diff/inherit/in.nix +++ b/test/diff/inherit/in.nix @@ -3,6 +3,7 @@ # empty inherit o.O inherit; inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } + { inherit a b c d e f g h i j; } { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } { inherit b d ; } diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index 9acff392..048ea567 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -4,6 +4,20 @@ inherit; inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } + { + inherit + a + b + c + d + e + f + g + h + i + j + ; + } { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } diff --git a/test/diff/inherit_from/in.nix b/test/diff/inherit_from/in.nix index fee7dbcd..6b375f1c 100644 --- a/test/diff/inherit_from/in.nix +++ b/test/diff/inherit_from/in.nix @@ -10,6 +10,7 @@ { inherit ({ foo = "1"; bar = "2"; /* force multiline */}) foo bar; } + { inherit (a) b c d e f g h i j k; } { inherit ( c ) f h ; } { inherit ( c ) f h /*i*/; } { inherit ( c ) f /*g*/ h ; } diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 9cb0e90d..dd768e04 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -26,6 +26,20 @@ bar ; } + { + inherit (a) + b + c + d + e + f + g + h + i + j + k + ; + } { inherit (c) f h; } { inherit (c) From a7dc8bbadac7941c58ad6b2ab66b6eed80d35bf0 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 23 Jun 2023 23:28:34 +0200 Subject: [PATCH 051/125] Binder: Always absorb strings and paths --- src/Nixfmt/Pretty.hs | 5 +++++ test/diff/idioms_nixos_2/out.nix | 32 ++++++++++++++++---------------- test/diff/idioms_pkgs_2/out.nix | 3 +-- test/diff/idioms_pkgs_3/out.nix | 9 +++------ test/diff/monsters_3/out.nix | 3 +-- test/diff/monsters_5/out.nix | 3 +-- 6 files changed, 27 insertions(+), 28 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index eebd7f54..64151e75 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -130,6 +130,11 @@ instance Pretty Binder where case expr of -- Absorbable term. Always start on the same line, keep semicolon attatched (Term t) | isAbsorbable t -> hardspace <> group expr + -- Not all strings are absorbably, but in this case we always want to keep them attached. + -- Because there's nothing to gain from having them start on a new line. + (Term (String _)) -> hardspace <> group expr + -- Same for path + (Term (Path _)) -> hardspace <> group expr -- Non-absorbable term -- If it is multi-line, force it to start on a new line with indentation (Term _) -> group' False (line <> pretty expr) diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 8952ef0a..36f78b1c 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -849,8 +849,7 @@ in assertions = [ { assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; - message = - "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; + message = "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; } ]; } @@ -1066,14 +1065,18 @@ in # The following attributes are optional depending on the type of # database. Those that evaluate to null on the left hand side # will be omitted. - ${if c.dbname != null then "--database-name" else null} = - ''"${c.dbname}"''; - ${if c.dbhost != null then "--database-host" else null} = - ''"${c.dbhost}"''; - ${if c.dbport != null then "--database-port" else null} = - ''"${toString c.dbport}"''; - ${if c.dbuser != null then "--database-user" else null} = - ''"${c.dbuser}"''; + ${ + if c.dbname != null then "--database-name" else null + } = ''"${c.dbname}"''; + ${ + if c.dbhost != null then "--database-host" else null + } = ''"${c.dbhost}"''; + ${ + if c.dbport != null then "--database-port" else null + } = ''"${toString c.dbport}"''; + ${ + if c.dbuser != null then "--database-user" else null + } = ''"${c.dbuser}"''; "--database-pass" = ''"''$${dbpass.arg}"''; "--admin-user" = ''"${c.adminuser}"''; "--admin-pass" = ''"''$${adminpass.arg}"''; @@ -1179,14 +1182,12 @@ in environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; serviceConfig.Type = "oneshot"; serviceConfig.User = "nextcloud"; - serviceConfig.ExecStart = - "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; + serviceConfig.ExecStart = "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; }; nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { after = [ "nextcloud-setup.service" ]; serviceConfig.Type = "oneshot"; - serviceConfig.ExecStart = - "${occ}/bin/nextcloud-occ app:update --all"; + serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; serviceConfig.User = "nextcloud"; startAt = cfg.autoUpdateApps.startAt; }; @@ -1199,8 +1200,7 @@ in phpPackage = phpPackage; phpEnv = { NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; - PATH = - "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; + PATH = "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; }; settings = mapAttrs (name: mkDefault) { "listen.owner" = config.services.nginx.user; diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index 8f11dc26..b3e78e50 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -37,8 +37,7 @@ stdenv.mkDerivation rec { It is fully customizable. ''; homepage = "https://www.gnu.org/software/hello/manual/"; - changelog = - "https://git.savannah.gnu.org/cgit/hello.git/plain/NEWS?h=v${version}"; + changelog = "https://git.savannah.gnu.org/cgit/hello.git/plain/NEWS?h=v${version}"; license = licenses.gpl3Plus; maintainers = [ maintainers.eelco ]; platforms = platforms.all; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index e9578888..a359301e 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -217,10 +217,8 @@ let defaultPrefs = { "geo.provider.network.url" = { - value = - "https://location.services.mozilla.com/v1/geolocate?key=%MOZILLA_API_KEY%"; - reason = - "Use MLS by default for geolocation, since our Google API Keys are not working"; + value = "https://location.services.mozilla.com/v1/geolocate?key=%MOZILLA_API_KEY%"; + reason = "Use MLS by default for geolocation, since our Google API Keys are not working"; }; }; @@ -256,8 +254,7 @@ buildStdenv.mkDerivation ({ (fetchpatch { # https://bugzilla.mozilla.org/show_bug.cgi?id=1773259 name = "rust-cbindgen-0.24.2-compat.patch"; - url = - "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; + url = "https://raw.githubusercontent.com/canonical/firefox-snap/5622734942524846fb0eb7108918c8cd8557fde3/patches/fix-ftbfs-newer-cbindgen.patch"; hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; }) ] diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index 0f66f531..063dc219 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -59,8 +59,7 @@ stdenv.mkDerivation rec { --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" ''; meta = with lib; { - description = - "Checks whether the contrast between two colors meet the WCAG requirements"; + description = "Checks whether the contrast between two colors meet the WCAG requirements"; homepage = "https://gitlab.gnome.org/World/design/contrast"; license = licenses.gpl3Plus; maintainers = with maintainers; [ jtojnar ]; diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 5f2d8e9d..c105b678 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -272,8 +272,7 @@ in "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]" ; - description = - "A list of additional patches to apply to the kernel."; + description = "A list of additional patches to apply to the kernel."; } ; }; From 4e1ff44fd9f2c64be8f47b5c0c018101ddfbbd26 Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 24 Jun 2023 00:31:46 +0200 Subject: [PATCH 052/125] Tests: add lib/systems/parse.nix Because it contains some pretty nasty vertical alignment examples, which nixfmt does not deal with well currently. --- test/diff/idioms_lib_4/in.nix | 503 ++++++++++++++++++ test/diff/idioms_lib_4/out.nix | 911 +++++++++++++++++++++++++++++++++ 2 files changed, 1414 insertions(+) create mode 100644 test/diff/idioms_lib_4/in.nix create mode 100644 test/diff/idioms_lib_4/out.nix diff --git a/test/diff/idioms_lib_4/in.nix b/test/diff/idioms_lib_4/in.nix new file mode 100644 index 00000000..6eb4f27c --- /dev/null +++ b/test/diff/idioms_lib_4/in.nix @@ -0,0 +1,503 @@ +# Define the list of system with their properties. +# +# See https://clang.llvm.org/docs/CrossCompilation.html and +# http://llvm.org/docs/doxygen/html/Triple_8cpp_source.html especially +# Triple::normalize. Parsing should essentially act as a more conservative +# version of that last function. +# +# Most of the types below come in "open" and "closed" pairs. The open ones +# specify what information we need to know about systems in general, and the +# closed ones are sub-types representing the whitelist of systems we support in +# practice. +# +# Code in the remainder of nixpkgs shouldn't rely on the closed ones in +# e.g. exhaustive cases. Its more a sanity check to make sure nobody defines +# systems that overlap with existing ones and won't notice something amiss. +# +{ lib }: +with lib.lists; +with lib.types; +with lib.attrsets; +with lib.strings; +with (import ./inspect.nix { inherit lib; }).predicates; + +let + inherit (lib.options) mergeOneOption; + + setTypes = type: + mapAttrs (name: value: + assert type.check value; + setType type.name ({ inherit name; } // value)); + +in + +rec { + + ################################################################################ + + types.openSignificantByte = mkOptionType { + name = "significant-byte"; + description = "Endianness"; + merge = mergeOneOption; + }; + + types.significantByte = enum (attrValues significantBytes); + + significantBytes = setTypes types.openSignificantByte { + bigEndian = {}; + littleEndian = {}; + }; + + ################################################################################ + + # Reasonable power of 2 + types.bitWidth = enum [ 8 16 32 64 128 ]; + + ################################################################################ + + types.openCpuType = mkOptionType { + name = "cpu-type"; + description = "instruction set architecture name and information"; + merge = mergeOneOption; + check = x: types.bitWidth.check x.bits + && (if 8 < x.bits + then types.significantByte.check x.significantByte + else !(x ? significantByte)); + }; + + types.cpuType = enum (attrValues cpuTypes); + + cpuTypes = with significantBytes; setTypes types.openCpuType { + arm = { bits = 32; significantByte = littleEndian; family = "arm"; }; + armv5tel = { bits = 32; significantByte = littleEndian; family = "arm"; version = "5"; arch = "armv5t"; }; + armv6m = { bits = 32; significantByte = littleEndian; family = "arm"; version = "6"; arch = "armv6-m"; }; + armv6l = { bits = 32; significantByte = littleEndian; family = "arm"; version = "6"; arch = "armv6"; }; + armv7a = { bits = 32; significantByte = littleEndian; family = "arm"; version = "7"; arch = "armv7-a"; }; + armv7r = { bits = 32; significantByte = littleEndian; family = "arm"; version = "7"; arch = "armv7-r"; }; + armv7m = { bits = 32; significantByte = littleEndian; family = "arm"; version = "7"; arch = "armv7-m"; }; + armv7l = { bits = 32; significantByte = littleEndian; family = "arm"; version = "7"; arch = "armv7"; }; + armv8a = { bits = 32; significantByte = littleEndian; family = "arm"; version = "8"; arch = "armv8-a"; }; + armv8r = { bits = 32; significantByte = littleEndian; family = "arm"; version = "8"; arch = "armv8-a"; }; + armv8m = { bits = 32; significantByte = littleEndian; family = "arm"; version = "8"; arch = "armv8-m"; }; + aarch64 = { bits = 64; significantByte = littleEndian; family = "arm"; version = "8"; arch = "armv8-a"; }; + aarch64_be = { bits = 64; significantByte = bigEndian; family = "arm"; version = "8"; arch = "armv8-a"; }; + + i386 = { bits = 32; significantByte = littleEndian; family = "x86"; arch = "i386"; }; + i486 = { bits = 32; significantByte = littleEndian; family = "x86"; arch = "i486"; }; + i586 = { bits = 32; significantByte = littleEndian; family = "x86"; arch = "i586"; }; + i686 = { bits = 32; significantByte = littleEndian; family = "x86"; arch = "i686"; }; + x86_64 = { bits = 64; significantByte = littleEndian; family = "x86"; arch = "x86-64"; }; + + microblaze = { bits = 32; significantByte = bigEndian; family = "microblaze"; }; + microblazeel = { bits = 32; significantByte = littleEndian; family = "microblaze"; }; + + mips = { bits = 32; significantByte = bigEndian; family = "mips"; }; + mipsel = { bits = 32; significantByte = littleEndian; family = "mips"; }; + mips64 = { bits = 64; significantByte = bigEndian; family = "mips"; }; + mips64el = { bits = 64; significantByte = littleEndian; family = "mips"; }; + + mmix = { bits = 64; significantByte = bigEndian; family = "mmix"; }; + + m68k = { bits = 32; significantByte = bigEndian; family = "m68k"; }; + + powerpc = { bits = 32; significantByte = bigEndian; family = "power"; }; + powerpc64 = { bits = 64; significantByte = bigEndian; family = "power"; }; + powerpc64le = { bits = 64; significantByte = littleEndian; family = "power"; }; + powerpcle = { bits = 32; significantByte = littleEndian; family = "power"; }; + + riscv32 = { bits = 32; significantByte = littleEndian; family = "riscv"; }; + riscv64 = { bits = 64; significantByte = littleEndian; family = "riscv"; }; + + s390 = { bits = 32; significantByte = bigEndian; family = "s390"; }; + s390x = { bits = 64; significantByte = bigEndian; family = "s390"; }; + + sparc = { bits = 32; significantByte = bigEndian; family = "sparc"; }; + sparc64 = { bits = 64; significantByte = bigEndian; family = "sparc"; }; + + wasm32 = { bits = 32; significantByte = littleEndian; family = "wasm"; }; + wasm64 = { bits = 64; significantByte = littleEndian; family = "wasm"; }; + + alpha = { bits = 64; significantByte = littleEndian; family = "alpha"; }; + + rx = { bits = 32; significantByte = littleEndian; family = "rx"; }; + msp430 = { bits = 16; significantByte = littleEndian; family = "msp430"; }; + avr = { bits = 8; family = "avr"; }; + + vc4 = { bits = 32; significantByte = littleEndian; family = "vc4"; }; + + or1k = { bits = 32; significantByte = bigEndian; family = "or1k"; }; + + loongarch64 = { bits = 64; significantByte = littleEndian; family = "loongarch"; }; + + javascript = { bits = 32; significantByte = littleEndian; family = "javascript"; }; + }; + + # GNU build systems assume that older NetBSD architectures are using a.out. + gnuNetBSDDefaultExecFormat = cpu: + if (cpu.family == "arm" && cpu.bits == 32) || + (cpu.family == "sparc" && cpu.bits == 32) || + (cpu.family == "m68k" && cpu.bits == 32) || + (cpu.family == "x86" && cpu.bits == 32) + then execFormats.aout + else execFormats.elf; + + # Determine when two CPUs are compatible with each other. That is, + # can code built for system B run on system A? For that to happen, + # the programs that system B accepts must be a subset of the + # programs that system A accepts. + # + # We have the following properties of the compatibility relation, + # which must be preserved when adding compatibility information for + # additional CPUs. + # - (reflexivity) + # Every CPU is compatible with itself. + # - (transitivity) + # If A is compatible with B and B is compatible with C then A is compatible with C. + # + # Note: Since 22.11 the archs of a mode switching CPU are no longer considered + # pairwise compatible. Mode switching implies that binaries built for A + # and B respectively can't be executed at the same time. + isCompatible = a: b: with cpuTypes; lib.any lib.id [ + # x86 + (b == i386 && isCompatible a i486) + (b == i486 && isCompatible a i586) + (b == i586 && isCompatible a i686) + + # XXX: Not true in some cases. Like in WSL mode. + (b == i686 && isCompatible a x86_64) + + # ARMv4 + (b == arm && isCompatible a armv5tel) + + # ARMv5 + (b == armv5tel && isCompatible a armv6l) + + # ARMv6 + (b == armv6l && isCompatible a armv6m) + (b == armv6m && isCompatible a armv7l) + + # ARMv7 + (b == armv7l && isCompatible a armv7a) + (b == armv7l && isCompatible a armv7r) + (b == armv7l && isCompatible a armv7m) + + # ARMv8 + (b == aarch64 && a == armv8a) + (b == armv8a && isCompatible a aarch64) + (b == armv8r && isCompatible a armv8a) + (b == armv8m && isCompatible a armv8a) + + # PowerPC + (b == powerpc && isCompatible a powerpc64) + (b == powerpcle && isCompatible a powerpc64le) + + # MIPS + (b == mips && isCompatible a mips64) + (b == mipsel && isCompatible a mips64el) + + # RISCV + (b == riscv32 && isCompatible a riscv64) + + # SPARC + (b == sparc && isCompatible a sparc64) + + # WASM + (b == wasm32 && isCompatible a wasm64) + + # identity + (b == a) + ]; + + ################################################################################ + + types.openVendor = mkOptionType { + name = "vendor"; + description = "vendor for the platform"; + merge = mergeOneOption; + }; + + types.vendor = enum (attrValues vendors); + + vendors = setTypes types.openVendor { + apple = {}; + pc = {}; + # Actually matters, unlocking some MinGW-w64-specific options in GCC. See + # bottom of https://sourceforge.net/p/mingw-w64/wiki2/Unicode%20apps/ + w64 = {}; + + none = {}; + unknown = {}; + }; + + ################################################################################ + + types.openExecFormat = mkOptionType { + name = "exec-format"; + description = "executable container used by the kernel"; + merge = mergeOneOption; + }; + + types.execFormat = enum (attrValues execFormats); + + execFormats = setTypes types.openExecFormat { + aout = {}; # a.out + elf = {}; + macho = {}; + pe = {}; + wasm = {}; + + unknown = {}; + }; + + ################################################################################ + + types.openKernelFamily = mkOptionType { + name = "exec-format"; + description = "executable container used by the kernel"; + merge = mergeOneOption; + }; + + types.kernelFamily = enum (attrValues kernelFamilies); + + kernelFamilies = setTypes types.openKernelFamily { + bsd = {}; + darwin = {}; + }; + + ################################################################################ + + types.openKernel = mkOptionType { + name = "kernel"; + description = "kernel name and information"; + merge = mergeOneOption; + check = x: types.execFormat.check x.execFormat + && all types.kernelFamily.check (attrValues x.families); + }; + + types.kernel = enum (attrValues kernels); + + kernels = with execFormats; with kernelFamilies; setTypes types.openKernel { + # TODO(@Ericson2314): Don't want to mass-rebuild yet to keeping 'darwin' as + # the normalized name for macOS. + macos = { execFormat = macho; families = { inherit darwin; }; name = "darwin"; }; + ios = { execFormat = macho; families = { inherit darwin; }; }; + # A tricky thing about FreeBSD is that there is no stable ABI across + # versions. That means that putting in the version as part of the + # config string is paramount. + freebsd12 = { execFormat = elf; families = { inherit bsd; }; name = "freebsd"; version = 12; }; + freebsd13 = { execFormat = elf; families = { inherit bsd; }; name = "freebsd"; version = 13; }; + linux = { execFormat = elf; families = { }; }; + netbsd = { execFormat = elf; families = { inherit bsd; }; }; + none = { execFormat = unknown; families = { }; }; + openbsd = { execFormat = elf; families = { inherit bsd; }; }; + solaris = { execFormat = elf; families = { }; }; + wasi = { execFormat = wasm; families = { }; }; + redox = { execFormat = elf; families = { }; }; + windows = { execFormat = pe; families = { }; }; + ghcjs = { execFormat = unknown; families = { }; }; + genode = { execFormat = elf; families = { }; }; + mmixware = { execFormat = unknown; families = { }; }; + } // { # aliases + # 'darwin' is the kernel for all of them. We choose macOS by default. + darwin = kernels.macos; + watchos = kernels.ios; + tvos = kernels.ios; + win32 = kernels.windows; + }; + + ################################################################################ + + types.openAbi = mkOptionType { + name = "abi"; + description = "binary interface for compiled code and syscalls"; + merge = mergeOneOption; + }; + + types.abi = enum (attrValues abis); + + abis = setTypes types.openAbi { + cygnus = {}; + msvc = {}; + + # Note: eabi is specific to ARM and PowerPC. + # On PowerPC, this corresponds to PPCEABI. + # On ARM, this corresponds to ARMEABI. + eabi = { float = "soft"; }; + eabihf = { float = "hard"; }; + + # Other architectures should use ELF in embedded situations. + elf = {}; + + androideabi = {}; + android = { + assertions = [ + { assertion = platform: !platform.isAarch32; + message = '' + The "android" ABI is not for 32-bit ARM. Use "androideabi" instead. + ''; + } + ]; + }; + + gnueabi = { float = "soft"; }; + gnueabihf = { float = "hard"; }; + gnu = { + assertions = [ + { assertion = platform: !platform.isAarch32; + message = '' + The "gnu" ABI is ambiguous on 32-bit ARM. Use "gnueabi" or "gnueabihf" instead. + ''; + } + { assertion = platform: with platform; !(isPower64 && isBigEndian); + message = '' + The "gnu" ABI is ambiguous on big-endian 64-bit PowerPC. Use "gnuabielfv2" or "gnuabielfv1" instead. + ''; + } + ]; + }; + gnuabi64 = { abi = "64"; }; + muslabi64 = { abi = "64"; }; + + # NOTE: abi=n32 requires a 64-bit MIPS chip! That is not a typo. + # It is basically the 64-bit abi with 32-bit pointers. Details: + # https://www.linux-mips.org/pub/linux/mips/doc/ABI/MIPS-N32-ABI-Handbook.pdf + gnuabin32 = { abi = "n32"; }; + muslabin32 = { abi = "n32"; }; + + gnuabielfv2 = { abi = "elfv2"; }; + gnuabielfv1 = { abi = "elfv1"; }; + + musleabi = { float = "soft"; }; + musleabihf = { float = "hard"; }; + musl = {}; + + uclibceabi = { float = "soft"; }; + uclibceabihf = { float = "hard"; }; + uclibc = {}; + + unknown = {}; + }; + + ################################################################################ + + types.parsedPlatform = mkOptionType { + name = "system"; + description = "fully parsed representation of llvm- or nix-style platform tuple"; + merge = mergeOneOption; + check = { cpu, vendor, kernel, abi }: + types.cpuType.check cpu + && types.vendor.check vendor + && types.kernel.check kernel + && types.abi.check abi; + }; + + isSystem = isType "system"; + + mkSystem = components: + assert types.parsedPlatform.check components; + setType "system" components; + + mkSkeletonFromList = l: { + "1" = if elemAt l 0 == "avr" + then { cpu = elemAt l 0; kernel = "none"; abi = "unknown"; } + else throw "Target specification with 1 components is ambiguous"; + "2" = # We only do 2-part hacks for things Nix already supports + if elemAt l 1 == "cygwin" + then { cpu = elemAt l 0; kernel = "windows"; abi = "cygnus"; } + # MSVC ought to be the default ABI so this case isn't needed. But then it + # becomes difficult to handle the gnu* variants for Aarch32 correctly for + # minGW. So it's easier to make gnu* the default for the MinGW, but + # hack-in MSVC for the non-MinGW case right here. + else if elemAt l 1 == "windows" + then { cpu = elemAt l 0; kernel = "windows"; abi = "msvc"; } + else if (elemAt l 1) == "elf" + then { cpu = elemAt l 0; vendor = "unknown"; kernel = "none"; abi = elemAt l 1; } + else { cpu = elemAt l 0; kernel = elemAt l 1; }; + "3" = + # cpu-kernel-environment + if elemAt l 1 == "linux" || + elem (elemAt l 2) ["eabi" "eabihf" "elf" "gnu"] + then { + cpu = elemAt l 0; + kernel = elemAt l 1; + abi = elemAt l 2; + vendor = "unknown"; + } + # cpu-vendor-os + else if elemAt l 1 == "apple" || + elem (elemAt l 2) [ "wasi" "redox" "mmixware" "ghcjs" "mingw32" ] || + hasPrefix "freebsd" (elemAt l 2) || + hasPrefix "netbsd" (elemAt l 2) || + hasPrefix "genode" (elemAt l 2) + then { + cpu = elemAt l 0; + vendor = elemAt l 1; + kernel = if elemAt l 2 == "mingw32" + then "windows" # autotools breaks on -gnu for window + else elemAt l 2; + } + else throw "Target specification with 3 components is ambiguous"; + "4" = { cpu = elemAt l 0; vendor = elemAt l 1; kernel = elemAt l 2; abi = elemAt l 3; }; + }.${toString (length l)} + or (throw "system string has invalid number of hyphen-separated components"); + + # This should revert the job done by config.guess from the gcc compiler. + mkSystemFromSkeleton = { cpu + , # Optional, but fallback too complex for here. + # Inferred below instead. + vendor ? assert false; null + , kernel + , # Also inferred below + abi ? assert false; null + } @ args: let + getCpu = name: cpuTypes.${name} or (throw "Unknown CPU type: ${name}"); + getVendor = name: vendors.${name} or (throw "Unknown vendor: ${name}"); + getKernel = name: kernels.${name} or (throw "Unknown kernel: ${name}"); + getAbi = name: abis.${name} or (throw "Unknown ABI: ${name}"); + + parsed = { + cpu = getCpu args.cpu; + vendor = + /**/ if args ? vendor then getVendor args.vendor + else if isDarwin parsed then vendors.apple + else if isWindows parsed then vendors.pc + else vendors.unknown; + kernel = if hasPrefix "darwin" args.kernel then getKernel "darwin" + else if hasPrefix "netbsd" args.kernel then getKernel "netbsd" + else getKernel args.kernel; + abi = + /**/ if args ? abi then getAbi args.abi + else if isLinux parsed || isWindows parsed then + if isAarch32 parsed then + if lib.versionAtLeast (parsed.cpu.version or "0") "6" + then abis.gnueabihf + else abis.gnueabi + # Default ppc64 BE to ELFv2 + else if isPower64 parsed && isBigEndian parsed then abis.gnuabielfv2 + else abis.gnu + else abis.unknown; + }; + + in mkSystem parsed; + + mkSystemFromString = s: mkSystemFromSkeleton (mkSkeletonFromList (lib.splitString "-" s)); + + kernelName = kernel: + kernel.name + toString (kernel.version or ""); + + doubleFromSystem = { cpu, kernel, abi, ... }: + /**/ if abi == abis.cygnus then "${cpu.name}-cygwin" + else if kernel.families ? darwin then "${cpu.name}-darwin" + else "${cpu.name}-${kernelName kernel}"; + + tripleFromSystem = { cpu, vendor, kernel, abi, ... } @ sys: assert isSystem sys; let + optExecFormat = + lib.optionalString (kernel.name == "netbsd" && + gnuNetBSDDefaultExecFormat cpu != kernel.execFormat) + kernel.execFormat.name; + optAbi = lib.optionalString (abi != abis.unknown) "-${abi.name}"; + in "${cpu.name}-${vendor.name}-${kernelName kernel}${optExecFormat}${optAbi}"; + + ################################################################################ + +} diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix new file mode 100644 index 00000000..b2ab7ed2 --- /dev/null +++ b/test/diff/idioms_lib_4/out.nix @@ -0,0 +1,911 @@ +# Define the list of system with their properties. +# +# See https://clang.llvm.org/docs/CrossCompilation.html and +# http://llvm.org/docs/doxygen/html/Triple_8cpp_source.html especially +# Triple::normalize. Parsing should essentially act as a more conservative +# version of that last function. +# +# Most of the types below come in "open" and "closed" pairs. The open ones +# specify what information we need to know about systems in general, and the +# closed ones are sub-types representing the whitelist of systems we support in +# practice. +# +# Code in the remainder of nixpkgs shouldn't rely on the closed ones in +# e.g. exhaustive cases. Its more a sanity check to make sure nobody defines +# systems that overlap with existing ones and won't notice something amiss. +# +{ + lib, +}: +with lib.lists; +with lib.types; +with lib.attrsets; +with lib.strings; +with (import ./inspect.nix { inherit lib; }).predicates; + +let + inherit (lib.options) mergeOneOption; + + setTypes = + type: + mapAttrs ( + name: value: + assert type.check value; + setType type.name ({ inherit name; } // value) + ) + ; +in + +rec { + + ################################################################################ + + types.openSignificantByte = mkOptionType { + name = "significant-byte"; + description = "Endianness"; + merge = mergeOneOption; + }; + + types.significantByte = enum (attrValues significantBytes); + + significantBytes = setTypes types.openSignificantByte { + bigEndian = { }; + littleEndian = { }; + }; + + ################################################################################ + + # Reasonable power of 2 + types.bitWidth = enum [ + 8 + 16 + 32 + 64 + 128 + ]; + + ################################################################################ + + types.openCpuType = mkOptionType { + name = "cpu-type"; + description = "instruction set architecture name and information"; + merge = mergeOneOption; + check = + x: + types.bitWidth.check x.bits + && ( + if 8 < x.bits then + types.significantByte.check x.significantByte + else + !(x ? significantByte) + ) + ; + }; + + types.cpuType = enum (attrValues cpuTypes); + + cpuTypes = + with significantBytes; + setTypes types.openCpuType { + arm = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + }; + armv5tel = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "5"; + arch = "armv5t"; + }; + armv6m = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "6"; + arch = "armv6-m"; + }; + armv6l = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "6"; + arch = "armv6"; + }; + armv7a = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "7"; + arch = "armv7-a"; + }; + armv7r = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "7"; + arch = "armv7-r"; + }; + armv7m = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "7"; + arch = "armv7-m"; + }; + armv7l = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "7"; + arch = "armv7"; + }; + armv8a = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "8"; + arch = "armv8-a"; + }; + armv8r = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "8"; + arch = "armv8-a"; + }; + armv8m = { + bits = 32; + significantByte = littleEndian; + family = "arm"; + version = "8"; + arch = "armv8-m"; + }; + aarch64 = { + bits = 64; + significantByte = littleEndian; + family = "arm"; + version = "8"; + arch = "armv8-a"; + }; + aarch64_be = { + bits = 64; + significantByte = bigEndian; + family = "arm"; + version = "8"; + arch = "armv8-a"; + }; + + i386 = { + bits = 32; + significantByte = littleEndian; + family = "x86"; + arch = "i386"; + }; + i486 = { + bits = 32; + significantByte = littleEndian; + family = "x86"; + arch = "i486"; + }; + i586 = { + bits = 32; + significantByte = littleEndian; + family = "x86"; + arch = "i586"; + }; + i686 = { + bits = 32; + significantByte = littleEndian; + family = "x86"; + arch = "i686"; + }; + x86_64 = { + bits = 64; + significantByte = littleEndian; + family = "x86"; + arch = "x86-64"; + }; + + microblaze = { + bits = 32; + significantByte = bigEndian; + family = "microblaze"; + }; + microblazeel = { + bits = 32; + significantByte = littleEndian; + family = "microblaze"; + }; + + mips = { + bits = 32; + significantByte = bigEndian; + family = "mips"; + }; + mipsel = { + bits = 32; + significantByte = littleEndian; + family = "mips"; + }; + mips64 = { + bits = 64; + significantByte = bigEndian; + family = "mips"; + }; + mips64el = { + bits = 64; + significantByte = littleEndian; + family = "mips"; + }; + + mmix = { + bits = 64; + significantByte = bigEndian; + family = "mmix"; + }; + + m68k = { + bits = 32; + significantByte = bigEndian; + family = "m68k"; + }; + + powerpc = { + bits = 32; + significantByte = bigEndian; + family = "power"; + }; + powerpc64 = { + bits = 64; + significantByte = bigEndian; + family = "power"; + }; + powerpc64le = { + bits = 64; + significantByte = littleEndian; + family = "power"; + }; + powerpcle = { + bits = 32; + significantByte = littleEndian; + family = "power"; + }; + + riscv32 = { + bits = 32; + significantByte = littleEndian; + family = "riscv"; + }; + riscv64 = { + bits = 64; + significantByte = littleEndian; + family = "riscv"; + }; + + s390 = { + bits = 32; + significantByte = bigEndian; + family = "s390"; + }; + s390x = { + bits = 64; + significantByte = bigEndian; + family = "s390"; + }; + + sparc = { + bits = 32; + significantByte = bigEndian; + family = "sparc"; + }; + sparc64 = { + bits = 64; + significantByte = bigEndian; + family = "sparc"; + }; + + wasm32 = { + bits = 32; + significantByte = littleEndian; + family = "wasm"; + }; + wasm64 = { + bits = 64; + significantByte = littleEndian; + family = "wasm"; + }; + + alpha = { + bits = 64; + significantByte = littleEndian; + family = "alpha"; + }; + + rx = { + bits = 32; + significantByte = littleEndian; + family = "rx"; + }; + msp430 = { + bits = 16; + significantByte = littleEndian; + family = "msp430"; + }; + avr = { + bits = 8; + family = "avr"; + }; + + vc4 = { + bits = 32; + significantByte = littleEndian; + family = "vc4"; + }; + + or1k = { + bits = 32; + significantByte = bigEndian; + family = "or1k"; + }; + + loongarch64 = { + bits = 64; + significantByte = littleEndian; + family = "loongarch"; + }; + + javascript = { + bits = 32; + significantByte = littleEndian; + family = "javascript"; + }; + } + ; + + # GNU build systems assume that older NetBSD architectures are using a.out. + gnuNetBSDDefaultExecFormat = + cpu: + if + (cpu.family == "arm" && cpu.bits == 32) + || (cpu.family == "sparc" && cpu.bits == 32) + || (cpu.family == "m68k" && cpu.bits == 32) + || (cpu.family == "x86" && cpu.bits == 32) + then + execFormats.aout + else + execFormats.elf + ; + + # Determine when two CPUs are compatible with each other. That is, + # can code built for system B run on system A? For that to happen, + # the programs that system B accepts must be a subset of the + # programs that system A accepts. + # + # We have the following properties of the compatibility relation, + # which must be preserved when adding compatibility information for + # additional CPUs. + # - (reflexivity) + # Every CPU is compatible with itself. + # - (transitivity) + # If A is compatible with B and B is compatible with C then A is compatible with C. + # + # Note: Since 22.11 the archs of a mode switching CPU are no longer considered + # pairwise compatible. Mode switching implies that binaries built for A + # and B respectively can't be executed at the same time. + isCompatible = + a: b: + with cpuTypes; + lib.any lib.id [ + # x86 + (b == i386 && isCompatible a i486) + (b == i486 && isCompatible a i586) + (b == i586 && isCompatible a i686) + + # XXX: Not true in some cases. Like in WSL mode. + (b == i686 && isCompatible a x86_64) + + # ARMv4 + (b == arm && isCompatible a armv5tel) + + # ARMv5 + (b == armv5tel && isCompatible a armv6l) + + # ARMv6 + (b == armv6l && isCompatible a armv6m) + (b == armv6m && isCompatible a armv7l) + + # ARMv7 + (b == armv7l && isCompatible a armv7a) + (b == armv7l && isCompatible a armv7r) + (b == armv7l && isCompatible a armv7m) + + # ARMv8 + (b == aarch64 && a == armv8a) + (b == armv8a && isCompatible a aarch64) + (b == armv8r && isCompatible a armv8a) + (b == armv8m && isCompatible a armv8a) + + # PowerPC + (b == powerpc && isCompatible a powerpc64) + (b == powerpcle && isCompatible a powerpc64le) + + # MIPS + (b == mips && isCompatible a mips64) + (b == mipsel && isCompatible a mips64el) + + # RISCV + (b == riscv32 && isCompatible a riscv64) + + # SPARC + (b == sparc && isCompatible a sparc64) + + # WASM + (b == wasm32 && isCompatible a wasm64) + + # identity + (b == a) + ] + ; + + ################################################################################ + + types.openVendor = mkOptionType { + name = "vendor"; + description = "vendor for the platform"; + merge = mergeOneOption; + }; + + types.vendor = enum (attrValues vendors); + + vendors = setTypes types.openVendor { + apple = { }; + pc = { }; + # Actually matters, unlocking some MinGW-w64-specific options in GCC. See + # bottom of https://sourceforge.net/p/mingw-w64/wiki2/Unicode%20apps/ + w64 = { }; + + none = { }; + unknown = { }; + }; + + ################################################################################ + + types.openExecFormat = mkOptionType { + name = "exec-format"; + description = "executable container used by the kernel"; + merge = mergeOneOption; + }; + + types.execFormat = enum (attrValues execFormats); + + execFormats = setTypes types.openExecFormat { + aout = { }; # a.out + elf = { }; + macho = { }; + pe = { }; + wasm = { }; + + unknown = { }; + }; + + ################################################################################ + + types.openKernelFamily = mkOptionType { + name = "exec-format"; + description = "executable container used by the kernel"; + merge = mergeOneOption; + }; + + types.kernelFamily = enum (attrValues kernelFamilies); + + kernelFamilies = setTypes types.openKernelFamily { + bsd = { }; + darwin = { }; + }; + + ################################################################################ + + types.openKernel = mkOptionType { + name = "kernel"; + description = "kernel name and information"; + merge = mergeOneOption; + check = + x: + types.execFormat.check x.execFormat + && all types.kernelFamily.check (attrValues x.families) + ; + }; + + types.kernel = enum (attrValues kernels); + + kernels = + with execFormats; + with kernelFamilies; + setTypes types.openKernel { + # TODO(@Ericson2314): Don't want to mass-rebuild yet to keeping 'darwin' as + # the normalized name for macOS. + macos = { + execFormat = macho; + families = { inherit darwin; }; + name = "darwin"; + }; + ios = { + execFormat = macho; + families = { inherit darwin; }; + }; + # A tricky thing about FreeBSD is that there is no stable ABI across + # versions. That means that putting in the version as part of the + # config string is paramount. + freebsd12 = { + execFormat = elf; + families = { inherit bsd; }; + name = "freebsd"; + version = 12; + }; + freebsd13 = { + execFormat = elf; + families = { inherit bsd; }; + name = "freebsd"; + version = 13; + }; + linux = { + execFormat = elf; + families = { }; + }; + netbsd = { + execFormat = elf; + families = { inherit bsd; }; + }; + none = { + execFormat = unknown; + families = { }; + }; + openbsd = { + execFormat = elf; + families = { inherit bsd; }; + }; + solaris = { + execFormat = elf; + families = { }; + }; + wasi = { + execFormat = wasm; + families = { }; + }; + redox = { + execFormat = elf; + families = { }; + }; + windows = { + execFormat = pe; + families = { }; + }; + ghcjs = { + execFormat = unknown; + families = { }; + }; + genode = { + execFormat = elf; + families = { }; + }; + mmixware = { + execFormat = unknown; + families = { }; + }; + } // { + # aliases + # 'darwin' is the kernel for all of them. We choose macOS by default. + darwin = kernels.macos; + watchos = kernels.ios; + tvos = kernels.ios; + win32 = kernels.windows; + } + ; + + ################################################################################ + + types.openAbi = mkOptionType { + name = "abi"; + description = "binary interface for compiled code and syscalls"; + merge = mergeOneOption; + }; + + types.abi = enum (attrValues abis); + + abis = setTypes types.openAbi { + cygnus = { }; + msvc = { }; + + # Note: eabi is specific to ARM and PowerPC. + # On PowerPC, this corresponds to PPCEABI. + # On ARM, this corresponds to ARMEABI. + eabi = { float = "soft"; }; + eabihf = { float = "hard"; }; + + # Other architectures should use ELF in embedded situations. + elf = { }; + + androideabi = { }; + android = { + assertions = [ { + assertion = platform: !platform.isAarch32; + message = '' + The "android" ABI is not for 32-bit ARM. Use "androideabi" instead. + ''; + } ]; + }; + + gnueabi = { float = "soft"; }; + gnueabihf = { float = "hard"; }; + gnu = { + assertions = [ + { + assertion = platform: !platform.isAarch32; + message = '' + The "gnu" ABI is ambiguous on 32-bit ARM. Use "gnueabi" or "gnueabihf" instead. + ''; + } + { + assertion = platform: with platform; !(isPower64 && isBigEndian); + message = '' + The "gnu" ABI is ambiguous on big-endian 64-bit PowerPC. Use "gnuabielfv2" or "gnuabielfv1" instead. + ''; + } + ]; + }; + gnuabi64 = { abi = "64"; }; + muslabi64 = { abi = "64"; }; + + # NOTE: abi=n32 requires a 64-bit MIPS chip! That is not a typo. + # It is basically the 64-bit abi with 32-bit pointers. Details: + # https://www.linux-mips.org/pub/linux/mips/doc/ABI/MIPS-N32-ABI-Handbook.pdf + gnuabin32 = { abi = "n32"; }; + muslabin32 = { abi = "n32"; }; + + gnuabielfv2 = { abi = "elfv2"; }; + gnuabielfv1 = { abi = "elfv1"; }; + + musleabi = { float = "soft"; }; + musleabihf = { float = "hard"; }; + musl = { }; + + uclibceabi = { float = "soft"; }; + uclibceabihf = { float = "hard"; }; + uclibc = { }; + + unknown = { }; + }; + + ################################################################################ + + types.parsedPlatform = mkOptionType { + name = "system"; + description = "fully parsed representation of llvm- or nix-style platform tuple"; + merge = mergeOneOption; + check = + { + cpu, + vendor, + kernel, + abi, + }: + types.cpuType.check cpu + && types.vendor.check vendor + && types.kernel.check kernel + && types.abi.check abi + ; + }; + + isSystem = isType "system"; + + mkSystem = + components: + assert types.parsedPlatform.check components; + setType "system" components + ; + + mkSkeletonFromList = + l: + { + "1" = + if elemAt l 0 == "avr" then + { + cpu = elemAt l 0; + kernel = "none"; + abi = "unknown"; + } + else + throw "Target specification with 1 components is ambiguous" + ; + "2" = # We only do 2-part hacks for things Nix already supports + if elemAt l 1 == "cygwin" then + { + cpu = elemAt l 0; + kernel = "windows"; + abi = "cygnus"; + } + # MSVC ought to be the default ABI so this case isn't needed. But then it + # becomes difficult to handle the gnu* variants for Aarch32 correctly for + # minGW. So it's easier to make gnu* the default for the MinGW, but + # hack-in MSVC for the non-MinGW case right here. + else if elemAt l 1 == "windows" then + { + cpu = elemAt l 0; + kernel = "windows"; + abi = "msvc"; + } + else if (elemAt l 1) == "elf" then + { + cpu = elemAt l 0; + vendor = "unknown"; + kernel = "none"; + abi = elemAt l 1; + } + else + { + cpu = elemAt l 0; + kernel = elemAt l 1; + } + ; + "3" = + # cpu-kernel-environment + if + elemAt l 1 == "linux" + || elem (elemAt l 2) [ + "eabi" + "eabihf" + "elf" + "gnu" + ] + then + { + cpu = elemAt l 0; + kernel = elemAt l 1; + abi = elemAt l 2; + vendor = "unknown"; + } + # cpu-vendor-os + else if + elemAt l 1 == "apple" + || elem (elemAt l 2) [ + "wasi" + "redox" + "mmixware" + "ghcjs" + "mingw32" + ] + || hasPrefix "freebsd" (elemAt l 2) + || hasPrefix "netbsd" (elemAt l 2) + || hasPrefix "genode" (elemAt l 2) + then + { + cpu = elemAt l 0; + vendor = elemAt l 1; + kernel = + if elemAt l 2 == "mingw32" then + "windows" # autotools breaks on -gnu for window + else + elemAt l 2 + ; + } + else + throw "Target specification with 3 components is ambiguous" + ; + "4" = { + cpu = elemAt l 0; + vendor = elemAt l 1; + kernel = elemAt l 2; + abi = elemAt l 3; + }; + } + .${toString (length l)} + or (throw + "system string has invalid number of hyphen-separated components" + ) + ; + + # This should revert the job done by config.guess from the gcc compiler. + mkSystemFromSkeleton = + { + cpu, # Optional, but fallback too complex for here. + # Inferred below instead. + vendor ? assert false; + null, + kernel, # Also inferred below + abi ? assert false; null, + }@args: + let + getCpu = name: cpuTypes.${name} or (throw "Unknown CPU type: ${name}"); + getVendor = name: vendors.${name} or (throw "Unknown vendor: ${name}"); + getKernel = name: kernels.${name} or (throw "Unknown kernel: ${name}"); + getAbi = name: abis.${name} or (throw "Unknown ABI: ${name}"); + + parsed = { + cpu = getCpu args.cpu; + vendor = + if args ? vendor then + getVendor args.vendor + else if isDarwin parsed then + vendors.apple + else if isWindows parsed then + vendors.pc + else + vendors.unknown + ; + kernel = + if hasPrefix "darwin" args.kernel then + getKernel "darwin" + else if hasPrefix "netbsd" args.kernel then + getKernel "netbsd" + else + getKernel args.kernel + ; + abi = + if args ? abi then + getAbi args.abi + else if isLinux parsed || isWindows parsed then + if isAarch32 parsed then + if lib.versionAtLeast (parsed.cpu.version or "0") "6" then + abis.gnueabihf + else + abis.gnueabi + # Default ppc64 BE to ELFv2 + else if isPower64 parsed && isBigEndian parsed then + abis.gnuabielfv2 + else + abis.gnu + else + abis.unknown + ; + }; + in + mkSystem parsed + ; + + mkSystemFromString = + s: mkSystemFromSkeleton (mkSkeletonFromList (lib.splitString "-" s)); + + kernelName = kernel: kernel.name + toString (kernel.version or ""); + + doubleFromSystem = + { + cpu, + kernel, + abi, + ... + }: + if abi == abis.cygnus then + "${cpu.name}-cygwin" + else if kernel.families ? darwin then + "${cpu.name}-darwin" + else + "${cpu.name}-${kernelName kernel}" + ; + + tripleFromSystem = + { + cpu, + vendor, + kernel, + abi, + ... + }@sys: + assert isSystem sys; + let + optExecFormat = + lib.optionalString + ( + kernel.name == "netbsd" + && gnuNetBSDDefaultExecFormat cpu != kernel.execFormat + ) + kernel.execFormat.name + ; + optAbi = lib.optionalString (abi != abis.unknown) "-${abi.name}"; + in + "${cpu.name}-${vendor.name}-${kernelName kernel}${optExecFormat}${optAbi}" + ; + + ################################################################################ +} From c926692f60bd8ee12c282ad55011dc300f77e208 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 22 Jun 2023 23:51:46 +0200 Subject: [PATCH 053/125] Better trailing comment parsing If a supposedly trailing comment is directly followed by a line of same indentation, treat it as part of that instead of as a trailing comment to the previous token. --- src/Nixfmt/Lexer.hs | 38 ++++++++++++++++++++++++---------- test/diff/idioms_lib_4/out.nix | 9 +++++--- test/diff/operation/out.nix | 3 ++- test/diff/paren/out.nix | 3 ++- 4 files changed, 37 insertions(+), 16 deletions(-) diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index 4382e475..9c32763c 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -17,17 +17,19 @@ import Data.Text as Text stripPrefix, stripStart, takeWhile, unwords) import Data.Void (Void) import Text.Megaparsec - (Parsec, SourcePos(..), anySingle, chunk, getSourcePos, hidden, many, + (Parsec, SourcePos(..), Pos, anySingle, chunk, getSourcePos, hidden, many, manyTill, some, try, unPos, (<|>)) import Text.Megaparsec.Char (eol) import Nixfmt.Types (Ann(..), Whole(..), Parser, TrailingComment(..), Trivia, Trivium(..)) import Nixfmt.Util (manyP) +-- import Debug.Trace (traceShow, traceShowId) data ParseTrivium = PTNewlines Int - | PTLineComment Text + -- Track the column where the comment starts + | PTLineComment Text Pos | PTBlockComment [Text] deriving (Show) @@ -53,8 +55,11 @@ fixLines n (h : t) = strip h : map (stripIndentation $ commonIndentationLength n $ filter (/="") t) t lineComment :: Parser ParseTrivium -lineComment = preLexeme $ chunk "#" *> - (PTLineComment <$> manyP (\x -> x /= '\n' && x /= '\r')) +lineComment = preLexeme $ do + SourcePos{sourceColumn = col} <- getSourcePos + _ <- chunk "#" + text <- manyP (\x -> x /= '\n' && x /= '\r') + return (PTLineComment text col) blockComment :: Parser ParseTrivium blockComment = try $ preLexeme $ do @@ -63,9 +68,10 @@ blockComment = try $ preLexeme $ do chars <- manyTill anySingle $ chunk "*/" return $ PTBlockComment $ fixLines (unPos pos) $ splitLines $ pack chars +-- This should be called with zero or one elements, as per `span isTrailing` convertTrailing :: [ParseTrivium] -> Maybe TrailingComment convertTrailing = toMaybe . join . map toText - where toText (PTLineComment c) = strip c + where toText (PTLineComment c _) = strip c toText (PTBlockComment [c]) = strip c toText _ = "" join = Text.unwords . filter (/="") @@ -76,21 +82,28 @@ convertLeading :: [ParseTrivium] -> Trivia convertLeading = concatMap (\case PTNewlines 1 -> [] PTNewlines _ -> [EmptyLine] - PTLineComment c -> [LineComment c] + PTLineComment c _ -> [LineComment c] PTBlockComment [] -> [] PTBlockComment [c] -> [LineComment $ " " <> strip c] PTBlockComment cs -> [BlockComment cs]) isTrailing :: ParseTrivium -> Bool -isTrailing (PTLineComment _) = True +isTrailing (PTLineComment _ _) = True isTrailing (PTBlockComment []) = True isTrailing (PTBlockComment [_]) = True isTrailing _ = False -convertTrivia :: [ParseTrivium] -> (Maybe TrailingComment, Trivia) -convertTrivia pts = +convertTrivia :: [ParseTrivium] -> Pos -> (Maybe TrailingComment, Trivia) +convertTrivia pts nextCol = let (trailing, leading) = span isTrailing pts - in (convertTrailing trailing, convertLeading leading) + in case (trailing, leading) of + -- Special case: if the trailing comment visually forms a block with the start of the following line, + -- then treat it like part of those comments instead of a distinct trailing comment. + -- 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) + _ -> (convertTrailing trailing, convertLeading leading) trivia :: Parser [ParseTrivium] trivia = many $ hidden $ lineComment <|> blockComment <|> newlines @@ -108,7 +121,10 @@ lexeme :: Parser a -> Parser (Ann a) lexeme p = do lastLeading <- takeTrivia token <- preLexeme p - (trailing, nextLeading) <- convertTrivia <$> trivia + parsedTrivia <- trivia + -- This is the position of the next lexeme after the currently parsed one + SourcePos{sourceColumn = col} <- getSourcePos + let (trailing, nextLeading) = convertTrivia parsedTrivia col pushTrivia nextLeading return $ Ann lastLeading token trailing diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index b2ab7ed2..9e4e9136 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -809,12 +809,15 @@ rec { # This should revert the job done by config.guess from the gcc compiler. mkSystemFromSkeleton = { - cpu, # Optional, but fallback too complex for here. + cpu, + # Optional, but fallback too complex for here. # Inferred below instead. vendor ? assert false; null, - kernel, # Also inferred below - abi ? assert false; null, + kernel, + # Also inferred below + abi ? assert false; + null, }@args: let getCpu = name: cpuTypes.${name} or (throw "Unknown CPU type: ${name}"); diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 95594917..fe8b1c92 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -49,7 +49,8 @@ ) # Filter out nix-build result symlinks (type == "symlink" && lib.hasPrefix "result" baseName) - ( # Filter out nix-build result symlinks + ( + # Filter out nix-build result symlinks (type == "symlink" && lib.hasPrefix "result" baseName) # Filter out sockets and other types of files we can't have in the store. || (type == "unknown") diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 0135e50a..9ddbca23 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -8,7 +8,8 @@ ) ] ( - ( # test + ( + # test a # test ) ((c)) From c2702dfabe7c8aea42ef41c1a616a7d9bc9e8bdd Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Jun 2023 00:35:44 +0200 Subject: [PATCH 054/125] Function application: fix edge case When the function application hit exactly the line length limit, the closing parenthesis or semicolon (depending on context) would be rendered weirdly onto the next line. --- src/Nixfmt/Predoc.hs | 31 +++++++--- src/Nixfmt/Pretty.hs | 10 ++-- test/diff/apply/in.nix | 71 +++++++++++++++++++++++ test/diff/apply/out.nix | 125 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 223 insertions(+), 14 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index c80e25f8..51a1ad23 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -76,9 +76,10 @@ data DocAnn -- pre, prio and post. -- If any group contains a priority group, the following happens: -- If it entirely fits on one line, render on one line (as usual). - -- If it does not fit on one line, but pre does, but prio doesn't, then only expand prio - -- In all other cases, including when only pre and prio fit into one line, fully expand the group. - -- Groups containing multiple priority groups are not supported at the momen. + -- If it does not fit on one line, but pre does, then only expand prio. + -- In all other cases, fully expand the group. + -- Groups containing multiple priority groups are not supported at the moment. + -- Nesting further groups into post is not supported at the moment. = Group Bool -- | Node (Nest n) doc indicates all line starts in doc should be indented -- by n more spaces than the surrounding Base. @@ -214,6 +215,20 @@ isHardSpacing (Spacing Emptyline) = True isHardSpacing (Spacing (Newlines _)) = True isHardSpacing _ = False +-- Manually force a group to its compact layout, by replacing all relevant whitespace. +-- Does not recurse into inner groups (maybe it should though?) +unexpandSpacing :: Doc -> Doc +unexpandSpacing [] = [] +unexpandSpacing ((Spacing s):xs) = maybe [] (pure . Spacing) (unexpandSpacing' s) ++ unexpandSpacing xs +unexpandSpacing (x:xs) = x : unexpandSpacing xs + +unexpandSpacing' :: Spacing -> Maybe Spacing +unexpandSpacing' Space = Just Hardspace +unexpandSpacing' Softspace = Just Hardspace +unexpandSpacing' Break = Nothing +unexpandSpacing' Softbreak = Nothing +unexpandSpacing' x = Just x + spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) spanEnd p = fmap reverse . span p . reverse @@ -423,12 +438,10 @@ layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] -- If that fails, check whether the group contains any priority groups as its children and try to expand them first <|> do -- Split up on the first priority group - (pre, prio : post) <- Just (break isPriorityGroup ys) - -- Make sure to exclude the case where pre and prio fit onto the line but not post. - -- This would look weird and also not be true to the intended semantics for priority groups. - guard . isNothing $ handleGroup (pre ++ [prio]) (Chunk ti (Node (Group False) post) : xs) - -- Try to fit pre onto one line (with prio expanded, also need to re-group post) - handleGroup pre ([Chunk ti prio, Chunk ti (Node (Group False) post)] ++ xs) + -- Note that the pattern on prio is infallible as per isPriorityGroup + (pre, (Node (Group True) prio) : post) <- Just (break isPriorityGroup ys) + -- Try to fit pre onto one line (with prio expanded, and post manually unexpanded) + handleGroup pre $ map (Chunk ti) prio ++ map (Chunk ti) (unexpandSpacing post) ++ xs -- Otherwise, dissolve the group by mapping its members to the target indentation -- This also implies that whitespace in there will now be rendered "expanded" & fromMaybe (go cc ci $ map (Chunk ti) ys ++ xs) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 64151e75..c579b634 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -314,19 +314,19 @@ prettyApp commentPre pre post commentPost f a absorbApp expr = pretty expr absorbLast (Term t) | isAbsorbable t - = prettyTerm t + = group' True $ nest 2 $ prettyTerm t absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) - = base $ group $ pretty (Ann pre' open Nothing) <> line' - <> nest 2 (pretty post' <> group expr) + = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) <> line' + <> group (nest 2 (pretty post' <> pretty expr)) <> line' <> pretty close - absorbLast arg = group arg + absorbLast arg = group' True $ nest 2 $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f in (if null comment then mempty else commentPre) <> pretty comment <> (group' False $ - pre <> group (absorbApp fWithoutComment) <> line <> group' True ((nest 2 (absorbLast a))) <> post) + pre <> group (absorbApp fWithoutComment) <> line <> absorbLast a <> post) <> (if null comment then mempty else commentPost) isAbsorbable :: Term -> Bool diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index 4a18508f..b775381e 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -195,4 +195,75 @@ looooooooong = (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } sections); looooooooong' = toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys aaaaaaaa; } sections; } + + # Test breakup behavior at different line lengths + { + name = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name__ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name___ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name____ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_____ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name______ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_______ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name__________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name___________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name____________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_____________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name______________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_______________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name________________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_________________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name__________________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + } + # Same but without binders + [ + (sanitizeDerivationName (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName__ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName___ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName____ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_____ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName______ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_______ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName__________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName___________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName____________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_____________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName______________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_______________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName________________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_________________ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName__________________ (builtins.substring 33 (-1) (baseNameOf path'))) + ] + # Function calls with lambdas as last argument + { + overrideArgs = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs_ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs__ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs___ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs____ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + # Get a list of suggested argument names for a given missing one + getSuggestions = + arg: + lib.pipe (autoArgs // args) [ + lib.attrNames + # Only use ones that are at most 2 edits away. While mork would work, + # levenshteinAtMost is only fast for 2 or less. + (lib.filter (lib.strings.levenshteinAtMost 2 arg)) + # Put strings with shorter distance first + (lib.sort ( + x: y: lib.strings.levenshtein x arg < lib.strings.levenshtein y arg + )) + # Only take the first couple results + (lib.take 3) + # Quote all entries + (map (x: ''"'' + x + ''"'')) + ] + ; + } ] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 5e72ca30..4565f4d1 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -253,4 +253,129 @@ sections ; } + + # Test breakup behavior at different line lengths + { + name = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name__ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name___ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name____ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_____ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name______ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_______ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name__________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name___________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name____________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name_____________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name______________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name_______________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name________________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name_________________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + name__________________ = sanitizeDerivationName ( + builtins.substring 33 (-1) (path') + ); + } + # Same but without binders + [ + (sanitizeDerivationName (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName__ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName___ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName____ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_____ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName______ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName_______ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName_________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName__________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName___________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName____________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName_____________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName______________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName_______________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName________________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName_________________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + (sanitizeDerivationName__________________ ( + builtins.substring 33 (-1) (baseNameOf path') + )) + ] + # Function calls with lambdas as last argument + { + overrideArgs = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs_ = copyArgs ( + newArgs: makeOverridable f (overrideWith newArgs) + ); + overrideArgs__ = copyArgs ( + newArgs: makeOverridable f (overrideWith newArgs) + ); + overrideArgs___ = copyArgs ( + newArgs: makeOverridable f (overrideWith newArgs) + ); + overrideArgs____ = copyArgs ( + newArgs: makeOverridable f (overrideWith newArgs) + ); + # Get a list of suggested argument names for a given missing one + getSuggestions = + arg: + lib.pipe (autoArgs // args) [ + lib.attrNames + # Only use ones that are at most 2 edits away. While mork would work, + # levenshteinAtMost is only fast for 2 or less. + (lib.filter (lib.strings.levenshteinAtMost 2 arg)) + # Put strings with shorter distance first + (lib.sort ( + x: y: lib.strings.levenshtein x arg < lib.strings.levenshtein y arg + )) + # Only take the first couple results + (lib.take 3) + # Quote all entries + (map (x: ''"'' + x + ''"'')) + ] + ; + } ] From 538663c2bbba03a3ca566f34d1f6c5234becf8f0 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Jun 2023 00:39:01 +0200 Subject: [PATCH 055/125] Function application: don't always absorb last argument This was looking especially weird with some kinds of strings --- src/Nixfmt/Pretty.hs | 2 +- test/diff/idioms_lib_2/out.nix | 3 ++- test/diff/idioms_lib_3/out.nix | 3 ++- test/diff/idioms_nixos_2/out.nix | 16 ++++++++-------- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index c579b634..12cb6a58 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -319,7 +319,7 @@ prettyApp commentPre pre post commentPost f a = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) <> line' <> group (nest 2 (pretty post' <> pretty expr)) <> line' <> pretty close - absorbLast arg = group' True $ nest 2 $ pretty arg + absorbLast arg = group' False $ nest 2 $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 4008d17a..0ace2122 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -406,7 +406,8 @@ rec { let unexpected = lib.subtractLists valid given; in - lib.throwIfNot (unexpected == [ ]) "${msg}: ${ + lib.throwIfNot (unexpected == [ ]) + "${msg}: ${ builtins.concatStringsSep ", " ( builtins.map builtins.toString unexpected ) diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 01fc4a82..4a4eb4ae 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -340,7 +340,8 @@ rec { depth: if depthLimit != null && depth > depthLimit then if throwOnDepthLimit then - throw "Exceeded maximum eval-depth limit of ${ + throw + "Exceeded maximum eval-depth limit of ${ toString depthLimit } while trying to evaluate with `generators.withRecursion'!" else diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 36f78b1c..a2e34e82 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -134,8 +134,10 @@ in enableBrokenCiphersForSSE = mkOption { type = types.bool; default = versionOlder stateVersion "22.11"; - defaultText = literalExpression '' - versionOlder system.stateVersion "22.11"''; + defaultText = + literalExpression + ''versionOlder system.stateVersion "22.11"'' + ; description = lib.mdDoc '' This option enables using the OpenSSL PHP extension linked against OpenSSL 1.1 rather than latest OpenSSL (≥ 3), this is not recommended unless you need @@ -896,9 +898,8 @@ in "'hostname' => '${s3.hostname}'," } ${ - optionalString (s3.port != null) "'port' => ${ - toString s3.port - }," + optionalString (s3.port != null) + "'port' => ${toString s3.port}," } 'use_ssl' => ${boolToString s3.useSsl}, ${ @@ -987,9 +988,8 @@ in "'dbhost' => '${c.dbhost}'," } ${ - optionalString (c.dbport != null) "'dbport' => '${ - toString c.dbport - }'," + optionalString (c.dbport != null) + "'dbport' => '${toString c.dbport}'," } ${ optionalString (c.dbuser != null) From 325305eea85ab0eb025ae1b627572697b65d42ba Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Jun 2023 13:10:30 +0200 Subject: [PATCH 056/125] Binders: force-expand nested attribute sets --- src/Nixfmt/Pretty.hs | 37 +++++++++------ test/diff/attr_set/out.nix | 12 ++++- test/diff/idioms_lib_4/out.nix | 80 ++++++++++++++++++++++++-------- test/diff/idioms_nixos_1/out.nix | 4 +- test/diff/key_value/out.nix | 4 +- 5 files changed, 101 insertions(+), 36 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 12cb6a58..6fa5ebcc 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -129,7 +129,7 @@ instance Pretty Binder where inner = case expr of -- Absorbable term. Always start on the same line, keep semicolon attatched - (Term t) | isAbsorbable t -> hardspace <> group expr + (Term t) | isAbsorbable t -> hardspace <> prettyTermWide t -- Not all strings are absorbably, but in this case we always want to keep them attached. -- Because there's nothing to gain from having them start on a new line. (Term (String _)) -> hardspace <> group expr @@ -151,6 +151,28 @@ instance Pretty Binder where -- Otherwise, start on new line, expand fully (including the semicolon) _ -> line <> group' False (pretty expr <> line') +-- Pretty a set +-- while we already pretty eagerly expand sets with more than one element, +-- in some situations even that is not sufficient. The wide parameter will +-- be even more eager at expanding, except for empty sets and inherit statements. +prettySet :: Bool -> (Maybe Leaf, Leaf, Items Binder, Leaf) -> Doc +-- Empty, non-recursive attribute set +prettySet _ (Nothing, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) + = pretty paropen <> hardspace <> pretty parclose +-- Singleton sets are allowed to fit onto one line, +-- but apart from that always expand. +prettySet wide (krec, Ann pre paropen post, binders, parclose) + = base $ pretty (fmap (, hardspace) krec) <> + pretty (Ann pre paropen Nothing) <> sep + <> nest 2 (pretty post <> prettyItems hardline binders) <> sep + <> pretty parclose + where + sep = if wide && not (null (unItems binders)) then hardline else line + +prettyTermWide :: Term -> Doc +prettyTermWide (Set krec paropen items parclose) = prettySet True (krec, paropen, items, parclose) +prettyTermWide t = prettyTerm t + -- | Pretty print a term without wrapping it in a group. prettyTerm :: Term -> Doc prettyTerm (Token t) = pretty t @@ -186,18 +208,7 @@ prettyTerm (List (Ann pre paropen post) items parclose) = <> nest 2 ((pretty post) <> prettyItems hardline items) <> hardline <> pretty parclose --- Empty, non-recursive attribute set -prettyTerm (Set Nothing (Ann [] paropen Nothing) (Items []) parclose@(Ann [] _ _)) - = pretty paropen <> hardspace <> pretty parclose - --- General set --- Singleton sets are allowed to fit onto one line, --- but apart from that always expand. -prettyTerm (Set krec (Ann pre paropen post) binders parclose) - = base $ pretty (fmap (, hardspace) krec) <> - pretty (Ann pre paropen Nothing) <> line - <> nest 2 (pretty post <> prettyItems hardline binders) <> line - <> pretty parclose +prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) -- Parenthesized application prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 6766a483..f24dd3b6 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -55,7 +55,17 @@ a = { a = rec { a = { - a = rec { a = { a = rec { a = { a = rec { a = { }; }; }; }; }; }; + a = rec { + a = { + a = rec { + a = { + a = rec { + a = { }; + }; + }; + }; + }; + }; }; }; }; diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index 9e4e9136..a3516981 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -528,25 +528,33 @@ rec { # the normalized name for macOS. macos = { execFormat = macho; - families = { inherit darwin; }; + families = { + inherit darwin; + }; name = "darwin"; }; ios = { execFormat = macho; - families = { inherit darwin; }; + families = { + inherit darwin; + }; }; # A tricky thing about FreeBSD is that there is no stable ABI across # versions. That means that putting in the version as part of the # config string is paramount. freebsd12 = { execFormat = elf; - families = { inherit bsd; }; + families = { + inherit bsd; + }; name = "freebsd"; version = 12; }; freebsd13 = { execFormat = elf; - families = { inherit bsd; }; + families = { + inherit bsd; + }; name = "freebsd"; version = 13; }; @@ -556,7 +564,9 @@ rec { }; netbsd = { execFormat = elf; - families = { inherit bsd; }; + families = { + inherit bsd; + }; }; none = { execFormat = unknown; @@ -564,7 +574,9 @@ rec { }; openbsd = { execFormat = elf; - families = { inherit bsd; }; + families = { + inherit bsd; + }; }; solaris = { execFormat = elf; @@ -621,8 +633,12 @@ rec { # Note: eabi is specific to ARM and PowerPC. # On PowerPC, this corresponds to PPCEABI. # On ARM, this corresponds to ARMEABI. - eabi = { float = "soft"; }; - eabihf = { float = "hard"; }; + eabi = { + float = "soft"; + }; + eabihf = { + float = "hard"; + }; # Other architectures should use ELF in embedded situations. elf = { }; @@ -637,8 +653,12 @@ rec { } ]; }; - gnueabi = { float = "soft"; }; - gnueabihf = { float = "hard"; }; + gnueabi = { + float = "soft"; + }; + gnueabihf = { + float = "hard"; + }; gnu = { assertions = [ { @@ -655,24 +675,44 @@ rec { } ]; }; - gnuabi64 = { abi = "64"; }; - muslabi64 = { abi = "64"; }; + gnuabi64 = { + abi = "64"; + }; + muslabi64 = { + abi = "64"; + }; # NOTE: abi=n32 requires a 64-bit MIPS chip! That is not a typo. # It is basically the 64-bit abi with 32-bit pointers. Details: # https://www.linux-mips.org/pub/linux/mips/doc/ABI/MIPS-N32-ABI-Handbook.pdf - gnuabin32 = { abi = "n32"; }; - muslabin32 = { abi = "n32"; }; + gnuabin32 = { + abi = "n32"; + }; + muslabin32 = { + abi = "n32"; + }; - gnuabielfv2 = { abi = "elfv2"; }; - gnuabielfv1 = { abi = "elfv1"; }; + gnuabielfv2 = { + abi = "elfv2"; + }; + gnuabielfv1 = { + abi = "elfv1"; + }; - musleabi = { float = "soft"; }; - musleabihf = { float = "hard"; }; + musleabi = { + float = "soft"; + }; + musleabihf = { + float = "hard"; + }; musl = { }; - uclibceabi = { float = "soft"; }; - uclibceabihf = { float = "hard"; }; + uclibceabi = { + float = "soft"; + }; + uclibceabihf = { + float = "hard"; + }; uclibc = { }; unknown = { }; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index ae93f764..b9e34516 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -286,7 +286,9 @@ in }) (mkIf (!config.boot.isContainer) { - system.build = { inherit kernel; }; + system.build = { + inherit kernel; + }; system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 8972cece..7692bbdb 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -3,7 +3,9 @@ rec { a = (((4))); a = (((a: b))); - a = { a = 1; }; + a = { + a = 1; + }; b = { a = 1 # d From a95bd3a25d0925989f89636a90e27c203023076b Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Jun 2023 13:19:17 +0200 Subject: [PATCH 057/125] Abstraction: don't absorb body when there are more than two parameters --- src/Nixfmt/Pretty.hs | 11 +++++++---- test/diff/idioms_lib_2/out.nix | 5 ++++- test/diff/lambda/out.nix | 7 ++++++- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 6fa5ebcc..b37df138 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -427,10 +427,13 @@ instance Pretty Expression where <> pretty else_ <> absorbElse expr1 pretty (Abstraction (IDParameter param) colon body) - = pretty param <> pretty colon <> absorbAbs body - where absorbAbs (Abstraction (IDParameter param0) colon0 body0) = - hardspace <> pretty param0 <> pretty colon0 <> absorbAbs body0 - absorbAbs x = absorbSet x + = pretty param <> pretty colon <> absorbAbs 1 body + where absorbAbs :: Int -> Expression -> Doc + absorbAbs depth (Abstraction (IDParameter param0) colon0 body0) = + hardspace <> pretty param0 <> pretty colon0 <> absorbAbs (depth + 1) body0 + absorbAbs depth x + | depth <= 2 = absorbSet x + | otherwise = absorb hardline mempty Nothing x pretty (Abstraction param colon body) = pretty param <> pretty colon <> line <> pretty body diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 0ace2122..f5d130b4 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -147,7 +147,10 @@ rec { flip concat [1] [2] => [ 2 1 ] */ - flip = f: a: b: f b a; + flip = + f: a: b: + f b a + ; /* Apply function if the supplied argument is non-null. diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 832611a0..7810ae57 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -40,7 +40,12 @@ }: null ) - (a: b: c: { }: a: b: c: a) + ( + a: b: c: + { }: + a: b: c: + a + ) ( { From 32609c8207d85ed27ae1b1f28a5ef88a1d48872e Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Jun 2023 14:10:38 +0200 Subject: [PATCH 058/125] Ignore comments in line length calculation Since we don't enforce line limits on comments anyways, all they currently do is to accidentally expand some content before them. This makes the code uglier, without meaningfully reducing the line length in practice. Therefore, we are better of just ignoring them. --- src/Nixfmt/Predoc.hs | 38 +++++++++++++++++++++------------ src/Nixfmt/Pretty.hs | 26 +++++++++++----------- test/diff/idioms_pkgs_3/out.nix | 3 +-- 3 files changed, 38 insertions(+), 29 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 51a1ad23..52db8b71 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -10,6 +10,7 @@ -- easier to use. module Nixfmt.Predoc ( text + , comment , sepBy , hcat , base @@ -35,11 +36,10 @@ module Nixfmt.Predoc import Data.List (intersperse) import Data.Function ((&)) import Data.Functor ((<&>)) -import Data.Maybe (isNothing, fromMaybe) -import Data.Text as Text (Text, concat, length, pack, replicate, strip) +import Data.Maybe (fromMaybe) +import Data.Text as Text (Text, concat, length, replicate, strip) import GHC.Stack (HasCallStack) -- import Debug.Trace (traceShow) -import Control.Monad (guard) import Control.Applicative ((<|>)) -- | Sequential Spacings are reduced to a single Spacing by taking the maximum. @@ -92,7 +92,8 @@ data DocAnn -- | Single document element. Documents are modeled as lists of these elements -- in order to make concatenation simple. data DocE - = Text Text + -- Mark comments with a flag, to not count them to line length limits + = Text Bool Text | Spacing Spacing | Node DocAnn Doc deriving (Show, Eq) @@ -102,11 +103,11 @@ type Doc = [DocE] class Pretty a where pretty :: a -> Doc -instance Pretty Text where - pretty = pure . Text +--instance Pretty Text where +-- pretty = pure . (Text False) -instance Pretty String where - pretty = pure . Text . pack +--instance Pretty String where +-- pretty = pure . (Text False) . pack instance Pretty Doc where pretty = id @@ -123,7 +124,11 @@ instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where text :: Text -> Doc text "" = [] -text t = [Text t] +text t = [Text False t] + +comment :: Text -> Doc +comment "" = [] +comment t = [Text True t] -- | Group document elements together (see Node Group documentation) -- Must not contain non-hard whitespace (e.g. line, softline' etc.) at the start of the end. @@ -268,7 +273,8 @@ mergeSpacings _ y = y mergeLines :: Doc -> Doc mergeLines [] = [] mergeLines (Spacing a : Spacing b : xs) = mergeLines $ Spacing (mergeSpacings a b) : xs -mergeLines (Text a : Text b : xs) = mergeLines $ Text (a <> b) : xs +mergeLines (Text isComment a : Text isComment' b : xs) | isComment == isComment' + = mergeLines $ Text isComment (a <> b) : xs mergeLines (Node ann xs : ys) = Node ann (mergeLines xs) : mergeLines ys mergeLines (x : xs) = x : mergeLines xs @@ -320,7 +326,8 @@ fits :: Int -> Doc -> Maybe Text fits c _ | c < 0 = Nothing fits _ [] = Just "" fits c (x:xs) = case x of - Text t -> (t<>) <$> fits (c - textWidth t) xs + Text False t -> (t<>) <$> fits (c - textWidth t) xs + Text True t -> (t<>) <$> fits c xs Spacing Softbreak -> fits c xs Spacing Break -> fits c xs Spacing Softspace -> (" "<>) <$> fits (c - 1) xs @@ -335,7 +342,8 @@ fits c (x:xs) = case x of -- width 0, which always forces line breaks when possible. firstLineWidth :: Doc -> Int firstLineWidth [] = 0 -firstLineWidth (Text t : xs) = textWidth t + firstLineWidth xs +firstLineWidth (Text False t : xs) = textWidth t + firstLineWidth xs +firstLineWidth (Text True _ : xs) = firstLineWidth xs firstLineWidth (Spacing Hardspace : xs) = 1 + firstLineWidth xs firstLineWidth (Spacing _ : _) = 0 firstLineWidth (Node _ xs : ys) = firstLineWidth (xs ++ ys) @@ -346,7 +354,8 @@ firstLineFits :: Int -> Int -> Doc -> Bool firstLineFits targetWidth maxWidth docs = go maxWidth docs where go c _ | c < 0 = False go c [] = maxWidth - c <= targetWidth - go c (Text t : xs) = go (c - textWidth t) xs + go c (Text False t : xs) = go (c - textWidth t) xs + go c (Text True _ : xs) = go c xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth go c (Node (Group _) ys : xs) = @@ -396,7 +405,8 @@ layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] lineStart = if needsIndent then indent ti else "" in case x of - Text t -> lineStart : t : go (nc + textWidth t) ci xs + Text False t -> lineStart : t : go (nc + textWidth t) ci xs + Text True t -> lineStart : t : go (nc + textWidth t) ci xs -- This code treats whitespace as "expanded" -- A new line resets the column counter and sets the target indentation as current indentation diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index b37df138..beafd578 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -19,7 +19,7 @@ import qualified Data.Text as Text -- import Debug.Trace (traceShowId) import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, newline, pretty, sepBy, softline, softline', text, textWidth) + nest, newline, pretty, sepBy, softline, softline', text, comment, textWidth) import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), @@ -55,11 +55,11 @@ groupWithStart (Ann leading a trailing) b instance Pretty TrailingComment where pretty (TrailingComment c) - = hardspace <> text "#" <> hardspace <> text c <> hardline + = hardspace <> comment ("# " <> c) <> hardline instance Pretty Trivium where pretty EmptyLine = emptyline - pretty (LineComment c) = text "#" <> pretty c <> hardline + pretty (LineComment c) = comment ("#" <> c) <> hardline pretty (BlockComment c) | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment' c) | otherwise @@ -249,13 +249,13 @@ instance Pretty ParamAttr where -- Simple parameter, move comment around -- Move comments around when switching from leading comma to trailing comma style: -- `, name # foo` → `name, #foo` - pretty (ParamAttr (Ann trivia name (Just comment)) Nothing (Just (Ann trivia' comma Nothing))) - = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann trivia' comma (Just comment)))) + pretty (ParamAttr (Ann trivia name (Just comment')) Nothing (Just (Ann trivia' comma Nothing))) + = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann trivia' comma (Just comment')))) -- Simple parameter, move comment around and add trailing comma -- Same as above, but also add trailing comma - pretty (ParamAttr (Ann trivia name (Just comment)) Nothing Nothing) - = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] TComma (Just comment)))) + pretty (ParamAttr (Ann trivia name (Just comment')) Nothing Nothing) + = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] TComma (Just comment')))) -- Simple parameter -- Still need to handle missing trailing comma here, because the special cases above are not exhaustive @@ -333,12 +333,12 @@ prettyApp commentPre pre post commentPost f a absorbLast arg = group' False $ nest 2 $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded - (fWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f + (fWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f in - (if null comment then mempty else commentPre) - <> pretty comment <> (group' False $ + (if null comment' then mempty else commentPre) + <> pretty comment' <> (group' False $ pre <> group (absorbApp fWithoutComment) <> line <> absorbLast a <> post) - <> (if null comment then mempty else commentPost) + <> (if null comment' then mempty else commentPost) isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) @@ -475,9 +475,9 @@ instance Pretty Expression where line <> pretty (moveTrailingCommentUp op') <> nest 2 (absorbOperation expr) -- Extract comment before the first operand and move it out, to prevent force-expanding the expression - (operationWithoutComment, comment) = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) operation + (operationWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) operation in - pretty comment <> (group $ + pretty comment' <> (group $ (concat . map prettyOperation . (flatten Nothing)) operationWithoutComment) pretty (MemberCheck expr qmark sel) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index a359301e..1fd5465d 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -316,8 +316,7 @@ buildStdenv.mkDerivation ({ ++ extraNativeBuildInputs ; - setOutputFlags = - false; # `./mach configure` doesn't understand `--*dir=` flags. + setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. preConfigure = '' From c568bfab14eeb825104ccaa02c56bca297199fab Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Jun 2023 14:21:05 +0200 Subject: [PATCH 059/125] Ignore indentation in line length calculation This makes that lines don't get squished more if they are indented more, resulting in a more uniform look. Eventually, there should be a configurable limit for ignoring indentation, to still have *some* bound on the line length. --- src/Nixfmt/Predoc.hs | 8 +- test/diff/apply/out.nix | 52 ++++--------- test/diff/idioms_lib_2/out.nix | 18 ++--- test/diff/idioms_lib_3/out.nix | 50 ++++-------- test/diff/idioms_lib_4/out.nix | 9 +-- test/diff/idioms_nixos_1/out.nix | 8 +- test/diff/idioms_nixos_2/out.nix | 130 +++++++++---------------------- test/diff/idioms_pkgs_2/out.nix | 3 +- test/diff/idioms_pkgs_3/out.nix | 12 +-- test/diff/if_else/out.nix | 63 +++------------ test/diff/inherit/out.nix | 4 +- test/diff/key_value/out.nix | 5 +- test/diff/lambda/out.nix | 5 +- test/diff/operation/out.nix | 4 +- test/diff/or_default/out.nix | 4 +- test/diff/select/out.nix | 3 +- 16 files changed, 95 insertions(+), 283 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 52db8b71..9b6548f8 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -418,12 +418,12 @@ layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] Spacing (Newlines n) -> newlines n : go 0 ti xs Spacing Softbreak - | firstLineFits (tw - nc) (tw - ti) (map unChunk xs) + | firstLineFits (tw - nc + ci) (tw - ti) (map unChunk xs) -> go cc ci xs | otherwise -> newlines 1 : go 0 ti xs Spacing Softspace - | firstLineFits (tw - nc - 1) (tw - ti) (map unChunk xs) + | firstLineFits (tw - nc + ci - 1) (tw - ti) (map unChunk xs) -> " " : go (cc + 1) ci xs | otherwise -> newlines 1 : go 0 ti xs @@ -437,10 +437,10 @@ layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] handleGroup pre post = if needsIndent then let i = ti + firstLineIndent pre in - fits (tw - i - firstLineWidth (map unChunk post)) pre + fits (tw - firstLineWidth (map unChunk post)) pre <&> \t -> indent i : t : go (i + textWidth t) ci post else - fits (tw - cc - firstLineWidth (map unChunk post)) pre + fits (tw - cc + ci - firstLineWidth (map unChunk post)) pre <&> \t -> t : go (cc + textWidth t) ci post in -- Try to fit the entire group first diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 4565f4d1..ad8ea7cd 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -266,18 +266,10 @@ name_______ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); name________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); name_________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); - name__________ = sanitizeDerivationName ( - builtins.substring 33 (-1) (path') - ); - name___________ = sanitizeDerivationName ( - builtins.substring 33 (-1) (path') - ); - name____________ = sanitizeDerivationName ( - builtins.substring 33 (-1) (path') - ); - name_____________ = sanitizeDerivationName ( - builtins.substring 33 (-1) (path') - ); + name__________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name___________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name____________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); + name_____________ = sanitizeDerivationName (builtins.substring 33 (-1) (path')); name______________ = sanitizeDerivationName ( builtins.substring 33 (-1) (path') ); @@ -301,18 +293,10 @@ (sanitizeDerivationName__ (builtins.substring 33 (-1) (baseNameOf path'))) (sanitizeDerivationName___ (builtins.substring 33 (-1) (baseNameOf path'))) (sanitizeDerivationName____ (builtins.substring 33 (-1) (baseNameOf path'))) - (sanitizeDerivationName_____ ( - builtins.substring 33 (-1) (baseNameOf path') - )) - (sanitizeDerivationName______ ( - builtins.substring 33 (-1) (baseNameOf path') - )) - (sanitizeDerivationName_______ ( - builtins.substring 33 (-1) (baseNameOf path') - )) - (sanitizeDerivationName________ ( - builtins.substring 33 (-1) (baseNameOf path') - )) + (sanitizeDerivationName_____ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName______ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName_______ (builtins.substring 33 (-1) (baseNameOf path'))) + (sanitizeDerivationName________ (builtins.substring 33 (-1) (baseNameOf path'))) (sanitizeDerivationName_________ ( builtins.substring 33 (-1) (baseNameOf path') )) @@ -347,18 +331,10 @@ # Function calls with lambdas as last argument { overrideArgs = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); - overrideArgs_ = copyArgs ( - newArgs: makeOverridable f (overrideWith newArgs) - ); - overrideArgs__ = copyArgs ( - newArgs: makeOverridable f (overrideWith newArgs) - ); - overrideArgs___ = copyArgs ( - newArgs: makeOverridable f (overrideWith newArgs) - ); - overrideArgs____ = copyArgs ( - newArgs: makeOverridable f (overrideWith newArgs) - ); + overrideArgs_ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs__ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs___ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); + overrideArgs____ = copyArgs (newArgs: makeOverridable f (overrideWith newArgs)); # Get a list of suggested argument names for a given missing one getSuggestions = arg: @@ -368,9 +344,7 @@ # levenshteinAtMost is only fast for 2 or less. (lib.filter (lib.strings.levenshteinAtMost 2 arg)) # Put strings with shorter distance first - (lib.sort ( - x: y: lib.strings.levenshtein x arg < lib.strings.levenshtein y arg - )) + (lib.sort (x: y: lib.strings.levenshtein x arg < lib.strings.levenshtein y arg)) # Only take the first couple results (lib.take 3) # Quote all entries diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index f5d130b4..c3b6ff29 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -107,8 +107,7 @@ rec { # bitwise “xor” bitXor = - builtins.bitXor - or (import ./zip-int-bits.nix (a: b: if a != b then 1 else 0)); + builtins.bitXor or (import ./zip-int-bits.nix (a: b: if a != b then 1 else 0)); # bitwise “not” bitNot = builtins.sub (-1); @@ -203,10 +202,7 @@ rec { let suffixFile = ../.version-suffix; in - if pathExists suffixFile then - lib.strings.fileContents suffixFile - else - "pre-git" + if pathExists suffixFile then lib.strings.fileContents suffixFile else "pre-git" ; /* Attempts to return the the current revision of nixpkgs and @@ -230,8 +226,7 @@ rec { ; nixpkgsVersion = - builtins.trace - "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" + builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version ; @@ -361,8 +356,7 @@ rec { then msg: builtins.trace "warning: ${msg}" ( - abort - "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors." + abort "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors." ) else msg: builtins.trace "warning: ${msg}" @@ -411,9 +405,7 @@ rec { in lib.throwIfNot (unexpected == [ ]) "${msg}: ${ - builtins.concatStringsSep ", " ( - builtins.map builtins.toString unexpected - ) + builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) } unexpected; valid ones: ${ builtins.concatStringsSep ", " (builtins.map builtins.toString valid) }" diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 4a4eb4ae..f724b01c 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -37,8 +37,7 @@ rec { err = t: v: abort ( - "generators.mkValueStringDefault: " - + "${t} not supported: ${toPretty { } v}" + "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}" ) ; in @@ -112,9 +111,7 @@ rec { ; in attrs: - libStr.concatStrings ( - lib.concatLists (libAttr.mapAttrsToList mkLines attrs) - ) + libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) ; # Generate an INI-style config file from an @@ -227,12 +224,9 @@ rec { if globalSection == { } then "" else - (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) - + "\n" - ) - + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } - sections + (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" ) + + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections) ; # Generate a git-config file from an attrset. @@ -286,14 +280,9 @@ rec { recurse = path: value: if isAttrs value && !lib.isDerivation value then - lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) - value + lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) value else if length path > 1 then - { - ${concatStringsSep "." (lib.reverseList (tail path))}.${ - head path - } = value; - } + { ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = value; } else { ${head path} = value; } ; @@ -333,9 +322,7 @@ rec { "__pretty" ]; stepIntoAttr = - evalNext: name: - if builtins.elem name specialAttrs then id else evalNext - ; + evalNext: name: if builtins.elem name specialAttrs then id else evalNext; transform = depth: if depthLimit != null && depth > depthLimit then @@ -433,10 +420,7 @@ rec { ] ; singlelineResult = - ''"'' - + concatStringsSep "\\n" (map escapeSingleline lines) - + ''"'' - ; + ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; multilineResult = let escapedLines = map escapeMultiline lines; @@ -451,10 +435,7 @@ rec { + "''" ; in - if multiline && length lines > 1 then - multilineResult - else - singlelineResult + if multiline && length lines > 1 then multilineResult else singlelineResult else if true == v then "true" else if false == v then @@ -476,8 +457,7 @@ rec { let fna = lib.functionArgs v; showFnas = concatStringsSep ", " ( - libAttr.mapAttrsToList - (name: hasDefVal: if hasDefVal then name + "?" else name) + libAttr.mapAttrsToList (name: hasDefVal: if hasDefVal then name + "?" else name) fna ); in @@ -498,9 +478,9 @@ rec { ( name: value: "${libStr.escapeNixIdentifier name} = ${ - builtins.addErrorContext - "while evaluating an attribute `${name}`" - (go (indent + " ") value) + builtins.addErrorContext "while evaluating an attribute `${name}`" ( + go (indent + " ") value + ) };" ) v @@ -612,9 +592,7 @@ rec { if isAttrs v then "{ ${ concatItems ( - lib.attrsets.mapAttrsToList - (key: value: "${key} = ${toDhall args value}") - v + lib.attrsets.mapAttrsToList (key: value: "${key} = ${toDhall args value}") v ) } }" else if isList v then diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index a3516981..da6ad0a9 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -841,9 +841,7 @@ rec { }; } .${toString (length l)} - or (throw - "system string has invalid number of hyphen-separated components" - ) + or (throw "system string has invalid number of hyphen-separated components") ; # This should revert the job done by config.guess from the gcc compiler. @@ -939,10 +937,7 @@ rec { let optExecFormat = lib.optionalString - ( - kernel.name == "netbsd" - && gnuNetBSDDefaultExecFormat cpu != kernel.execFormat - ) + (kernel.name == "netbsd" && gnuNetBSDDefaultExecFormat cpu != kernel.execFormat) kernel.execFormat.name ; optAbi = lib.optionalString (abi != abis.unknown) "-${abi.name}"; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index b9e34516..50f07107 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -47,8 +47,7 @@ in kernel = super.kernel.override ( originalArgs: { inherit randstructSeed; - kernelPatches = - (originalArgs.kernelPatches or [ ]) ++ kernelPatches; + kernelPatches = (originalArgs.kernelPatches or [ ]) ++ kernelPatches; features = lib.recursiveUpdate super.kernel.features features; } ); @@ -302,10 +301,7 @@ in ] ; - boot.kernel.sysctl."kernel.printk" = - mkDefault - config.boot.consoleLogLevel - ; + boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; boot.kernelModules = [ "loop" diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index a2e34e82..be7dd32c 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -134,10 +134,7 @@ in enableBrokenCiphersForSSE = mkOption { type = types.bool; default = versionOlder stateVersion "22.11"; - defaultText = - literalExpression - ''versionOlder system.stateVersion "22.11"'' - ; + defaultText = literalExpression ''versionOlder system.stateVersion "22.11"''; description = lib.mdDoc '' This option enables using the OpenSSL PHP extension linked against OpenSSL 1.1 rather than latest OpenSSL (≥ 3), this is not recommended unless you need @@ -233,10 +230,7 @@ in logLevel = mkOption { type = types.ints.between 0 4; default = 2; - description = - lib.mdDoc - "Log level value between 0 (DEBUG) and 4 (FATAL)." - ; + description = lib.mdDoc "Log level value between 0 (DEBUG) and 4 (FATAL)."; }; logType = mkOption { type = types.enum [ @@ -259,10 +253,7 @@ in }; package = mkOption { type = types.package; - description = - lib.mdDoc - "Which package to use for the Nextcloud instance." - ; + description = lib.mdDoc "Which package to use for the Nextcloud instance."; relatedPackages = [ "nextcloud24" "nextcloud25" @@ -742,10 +733,7 @@ in recommendedHttpHeaders = mkOption { type = types.bool; default = true; - description = - lib.mdDoc - "Enable additional recommended HTTP response headers" - ; + description = lib.mdDoc "Enable additional recommended HTTP response headers"; }; hstsMaxAge = mkOption { type = types.ints.positive; @@ -774,9 +762,9 @@ in After nextcloud${ toString major } is installed successfully, you can safely upgrade - to ${ - toString (major + 1) - }. The latest version available is nextcloud${toString latest}. + to ${toString (major + 1)}. The latest version available is nextcloud${ + toString latest + }. Please note that Nextcloud doesn't support upgrades across multiple major versions (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). @@ -840,17 +828,12 @@ in ; services.nextcloud.phpPackage = - if versionOlder cfg.package.version "26" then - pkgs.php81 - else - pkgs.php82 - ; + if versionOlder cfg.package.version "26" then pkgs.php81 else pkgs.php82; } { assertions = [ { - assertion = - cfg.database.createLocally -> cfg.config.dbtype == "mysql"; + assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; message = "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; } ]; } @@ -876,11 +859,8 @@ in let c = cfg.config; writePhpArray = - a: - "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]" - ; - requiresReadSecretFunction = - c.dbpassFile != null || c.objectstore.s3.enable; + a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]"; + requiresReadSecretFunction = c.dbpassFile != null || c.objectstore.s3.enable; objectstoreConfig = let s3 = c.objectstore.s3; @@ -893,19 +873,10 @@ in 'autocreate' => ${boolToString s3.autocreate}, 'key' => '${s3.key}', 'secret' => nix_read_secret('${s3.secretFile}'), - ${ - optionalString (s3.hostname != null) - "'hostname' => '${s3.hostname}'," - } - ${ - optionalString (s3.port != null) - "'port' => ${toString s3.port}," - } + ${optionalString (s3.hostname != null) "'hostname' => '${s3.hostname}',"} + ${optionalString (s3.port != null) "'port' => ${toString s3.port},"} 'use_ssl' => ${boolToString s3.useSsl}, - ${ - optionalString (s3.region != null) - "'region' => '${s3.region}'," - } + ${optionalString (s3.region != null) "'region' => '${s3.region}',"} 'use_path_style' => ${boolToString s3.usePathStyle}, ${ optionalString (s3.sseCKeyFile != null) @@ -916,8 +887,7 @@ in '' ; - showAppStoreSetting = - cfg.appstoreEnable != null || cfg.extraApps != { }; + showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; renderedAppStoreSetting = let x = cfg.appstoreEnable; @@ -925,8 +895,7 @@ in if x == null then "false" else boolToString x ; - nextcloudGreaterOrEqualThan = - req: versionAtLeast cfg.package.version req; + nextcloudGreaterOrEqualThan = req: versionAtLeast cfg.package.version req; overrideConfig = pkgs.writeText "nextcloud-config.php" '' '${datadir}/data', 'skeletondirectory' => '${cfg.skeletonDirectory}', ${ - optionalString cfg.caching.apcu - "'memcache.local' => '\\OC\\Memcache\\APCu'," + optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu'," } 'log_type' => '${cfg.logType}', 'loglevel' => '${builtins.toString cfg.logLevel}', @@ -979,22 +947,10 @@ in optionalString (c.overwriteProtocol != null) "'overwriteprotocol' => '${c.overwriteProtocol}'," } - ${ - optionalString (c.dbname != null) - "'dbname' => '${c.dbname}'," - } - ${ - optionalString (c.dbhost != null) - "'dbhost' => '${c.dbhost}'," - } - ${ - optionalString (c.dbport != null) - "'dbport' => '${toString c.dbport}'," - } - ${ - optionalString (c.dbuser != null) - "'dbuser' => '${c.dbuser}'," - } + ${optionalString (c.dbname != null) "'dbname' => '${c.dbname}',"} + ${optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}',"} + ${optionalString (c.dbport != null) "'dbport' => '${toString c.dbport}',"} + ${optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}',"} ${ optionalString (c.dbtableprefix != null) "'dbtableprefix' => '${toString c.dbtableprefix}'," @@ -1023,10 +979,7 @@ in ]; $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( - "${ - jsonFormat.generate "nextcloud-extraOptions.json" - cfg.extraOptions - }", + "${jsonFormat.generate "nextcloud-extraOptions.json" cfg.extraOptions}", "impossible: this should never happen (decoding generated extraOptions file %s failed)" )); @@ -1049,11 +1002,7 @@ in dbpass = { arg = "DBPASS"; value = - if c.dbpassFile != null then - ''"$(<"${toString c.dbpassFile}")"'' - else - ''""'' - ; + if c.dbpassFile != null then ''"$(<"${toString c.dbpassFile}")"'' else ''""''; }; adminpass = { arg = "ADMINPASS"; @@ -1065,18 +1014,11 @@ in # The following attributes are optional depending on the type of # database. Those that evaluate to null on the left hand side # will be omitted. - ${ - if c.dbname != null then "--database-name" else null - } = ''"${c.dbname}"''; - ${ - if c.dbhost != null then "--database-host" else null - } = ''"${c.dbhost}"''; - ${ - if c.dbport != null then "--database-port" else null - } = ''"${toString c.dbport}"''; - ${ - if c.dbuser != null then "--database-user" else null - } = ''"${c.dbuser}"''; + ${if c.dbname != null then "--database-name" else null} = ''"${c.dbname}"''; + ${if c.dbhost != null then "--database-host" else null} = ''"${c.dbhost}"''; + ${if c.dbport != null then "--database-port" else null} = '' + "${toString c.dbport}"''; + ${if c.dbuser != null then "--database-user" else null} = ''"${c.dbuser}"''; "--database-pass" = ''"''$${dbpass.arg}"''; "--admin-user" = ''"${c.adminuser}"''; "--admin-pass" = ''"''$${adminpass.arg}"''; @@ -1130,8 +1072,7 @@ in ln -sfT \ ${ pkgs.linkFarm "nix-apps" ( - mapAttrsToList (name: path: { inherit name path; }) - cfg.extraApps + mapAttrsToList (name: path: { inherit name path; }) cfg.extraApps ) } \ ${cfg.home}/nix-apps @@ -1157,13 +1098,12 @@ in ${occ}/bin/nextcloud-occ config:system:delete trusted_domains - ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) - '' - # Try to enable apps - ${occ}/bin/nextcloud-occ app:enable ${ - concatStringsSep " " (attrNames cfg.extraApps) - } - ''} + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' + # Try to enable apps + ${occ}/bin/nextcloud-occ app:enable ${ + concatStringsSep " " (attrNames cfg.extraApps) + } + ''} ${occSetTrustedDomainsCmd} ''; diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index b3e78e50..4b3f8f19 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -23,8 +23,7 @@ stdenv.mkDerivation rec { version = testVersion { package = hello; }; invariant-under-noXlibs = - testEqualDerivation - "hello must not be rebuilt when environment.noXlibs is set." + testEqualDerivation "hello must not be rebuilt when environment.noXlibs is set." hello (nixos { environment.noXlibs = true; }).pkgs.hello ; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 1fd5465d..62aea42f 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -155,9 +155,7 @@ assert stdenv.cc.libc or null != null; assert pipewireSupport -> !waylandSupport || !webrtcSupport - -> - throw - "${pname}: pipewireSupport requires both wayland and webrtc support."; + -> throw "${pname}: pipewireSupport requires both wayland and webrtc support."; let inherit (lib) enableFeature; @@ -264,9 +262,7 @@ buildStdenv.mkDerivation ({ ++ lib.optional (lib.versionAtLeast version "111") ./env_var_for_system_dir-ff111.patch - ++ - lib.optional (lib.versionAtLeast version "96") - ./no-buildconfig-ffx96.patch + ++ lib.optional (lib.versionAtLeast version "96") ./no-buildconfig-ffx96.patch ++ extraPatches ; @@ -428,9 +424,7 @@ buildStdenv.mkDerivation ({ lib.optional ( ltoSupport - && ( - buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64 - ) + && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64) ) "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index ece53e45..a30e7e2e 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -87,74 +87,29 @@ if ( if - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) then - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) else - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) ) then ( if - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) then - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) else - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) ) else ( if - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) then - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) else - ( - if (if a then b else c) then - (if a then b else c) - else - (if a then b else c) - ) + (if (if a then b else c) then (if a then b else c) else (if a then b else c)) ) ) ] diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index 048ea567..29988371 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -18,9 +18,7 @@ j ; } - { - inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; - } + { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } { inherit b d; } { inherit diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 7692bbdb..882c5fce 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -78,8 +78,5 @@ rec { # d ; - p = - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } - a - ; + p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a; } diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 7810ae57..fc225e76 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -29,10 +29,7 @@ d ) (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) - ( - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - ) + (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) ( { pkgs ? import ./.. { }, diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index fe8b1c92..8b3e6a46 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -184,9 +184,7 @@ # Logical precedence ( - assert pipewireSupport - -> !waylandSupport || !webrtcSupport - -> pipewireSupport; + assert pipewireSupport -> !waylandSupport || !webrtcSupport -> pipewireSupport; if aaaaaaaaaaaaaa && bbbbbbbbbbbb || cccccccccccccccccccc && ddddddddddddddddd diff --git a/test/diff/or_default/out.nix b/test/diff/or_default/out.nix index 16c01f52..67abd48c 100644 --- a/test/diff/or_default/out.nix +++ b/test/diff/or_default/out.nix @@ -11,7 +11,7 @@ (a.a or a.a # test or a.a # test or # test - a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a - or a.a or a.a or a.a or a.a or a.a or a.a + a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a or a.a + or a.a or a.a or a.a or a.a or a.a ) ] diff --git a/test/diff/select/out.nix b/test/diff/select/out.nix index f9cdc28b..4248fbcb 100644 --- a/test/diff/select/out.nix +++ b/test/diff/select/out.nix @@ -4,8 +4,7 @@ (a.a) (a.a) (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) - (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a - ) + (a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a.a) ( { # multiple lines From e6693cacd9bd62c3a6373985d43cdbf0fc324dbe Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 4 Jul 2023 13:07:43 +0200 Subject: [PATCH 060/125] Absorb abstraction in binder --- src/Nixfmt/Pretty.hs | 10 ++++-- test/diff/idioms_lib_2/out.nix | 12 +++---- test/diff/idioms_nixos_1/out.nix | 60 +++++++++++++------------------- test/diff/idioms_nixos_2/out.nix | 34 +++++++++--------- test/diff/key_value/out.nix | 22 +++++------- 5 files changed, 61 insertions(+), 77 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index beafd578..bf10a394 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -141,6 +141,8 @@ instance Pretty Binder where -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise (Application f a) -> group $ prettyApp hardline line line' mempty f a + -- Absorb function declarations but only those with simple parameter(s) + (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise (With _ _ _ (Term t)) | isAbsorbable t -> softline <> group' False (pretty expr <> softline') -- Special case `//` operator to treat like an absorbable term @@ -237,9 +239,6 @@ prettyTerm (Parenthesized paropen expr parclose) (Term (Selection _ _)) -> (mempty, line') -- Start on a new line for the others _ -> (line', line') - isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True - isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ body) = isAbstractionWithAbsorbableTerm body - isAbstractionWithAbsorbableTerm _ = False instance Pretty Term where pretty l@List{} = group $ prettyTerm l @@ -340,6 +339,11 @@ prettyApp commentPre pre post commentPost f a pre <> group (absorbApp fWithoutComment) <> line <> absorbLast a <> post) <> (if null comment' then mempty else commentPost) +isAbstractionWithAbsorbableTerm :: Expression -> Bool +isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True +isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ body) = isAbstractionWithAbsorbableTerm body +isAbstractionWithAbsorbableTerm _ = False + isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index c3b6ff29..c6f2ac4a 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -427,13 +427,11 @@ rec { function of the { a, b ? foo, ... }: format, but some facilities like callPackage expect to be able to query expected arguments. */ - setFunctionArgs = - f: args: { - # TODO: Should we add call-time "type" checking like built in? - __functor = self: f; - __functionArgs = args; - } - ; + setFunctionArgs = f: args: { + # TODO: Should we add call-time "type" checking like built in? + __functor = self: f; + __functionArgs = args; + }; /* Extract the expected function arguments from a function. This works both with nix-native { a, b ? foo, ... }: style diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 50f07107..b37ed3b4 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -330,48 +330,38 @@ in }; lib.kernelConfig = { - isYes = - option: { - assertion = config: config.isYes option; - message = "CONFIG_${option} is not yes!"; - configLine = "CONFIG_${option}=y"; - } - ; + isYes = option: { + assertion = config: config.isYes option; + message = "CONFIG_${option} is not yes!"; + configLine = "CONFIG_${option}=y"; + }; - isNo = - option: { - assertion = config: config.isNo option; - message = "CONFIG_${option} is not no!"; - configLine = "CONFIG_${option}=n"; - } - ; + isNo = option: { + assertion = config: config.isNo option; + message = "CONFIG_${option} is not no!"; + configLine = "CONFIG_${option}=n"; + }; - isModule = - option: { - assertion = config: config.isModule option; - message = "CONFIG_${option} is not built as a module!"; - configLine = "CONFIG_${option}=m"; - } - ; + isModule = option: { + assertion = config: config.isModule option; + message = "CONFIG_${option} is not built as a module!"; + configLine = "CONFIG_${option}=m"; + }; ### Usually you will just want to use these two # True if yes or module - isEnabled = - option: { - assertion = config: config.isEnabled option; - message = "CONFIG_${option} is not enabled!"; - configLine = "CONFIG_${option}=y"; - } - ; + isEnabled = option: { + assertion = config: config.isEnabled option; + message = "CONFIG_${option} is not enabled!"; + configLine = "CONFIG_${option}=y"; + }; # True if no or omitted - isDisabled = - option: { - assertion = config: config.isDisabled option; - message = "CONFIG_${option} is not disabled!"; - configLine = "CONFIG_${option}=n"; - } - ; + isDisabled = option: { + assertion = config: config.isDisabled option; + message = "CONFIG_${option} is not disabled!"; + configLine = "CONFIG_${option}=n"; + }; }; # The config options that all modules can depend upon diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index be7dd32c..267b2e5c 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -755,24 +755,22 @@ in warnings = let latest = 26; - upgradeWarning = - major: nixos: '' - A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. - - After nextcloud${ - toString major - } is installed successfully, you can safely upgrade - to ${toString (major + 1)}. The latest version available is nextcloud${ - toString latest - }. - - Please note that Nextcloud doesn't support upgrades across multiple major versions - (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). - - The package can be upgraded by explicitly declaring the service-option - `services.nextcloud.package`. - '' - ; + upgradeWarning = major: nixos: '' + A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. + + After nextcloud${ + toString major + } is installed successfully, you can safely upgrade + to ${toString (major + 1)}. The latest version available is nextcloud${ + toString latest + }. + + Please note that Nextcloud doesn't support upgrades across multiple major versions + (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). + + The package can be upgraded by explicitly declaring the service-option + `services.nextcloud.package`. + ''; in (optional (cfg.poolConfig != null) '' Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 882c5fce..0cfd6c10 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -42,25 +42,19 @@ rec { ; }; j = a: { b = 1; }; - k = - a: { - b = 1; - c = 2; - } - ; - l = - a: # b + k = a: { + b = 1; + c = 2; + }; + l = a: # b { b = 1; - } - ; - m = - a: # b + }; + m = a: # b { b = 1; c = 2; - } - ; + }; n = pkgs: { }; o = { From 3b26c7d373f27a1b71cbd73284685c9576aa53ed Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 9 Jul 2023 00:15:43 +0200 Subject: [PATCH 061/125] Improve mapFirstToken code style --- src/Nixfmt/Types.hs | 74 +++++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 46 deletions(-) diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index d86b7cc9..36354e66 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -4,13 +4,14 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes #-} +{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase #-} module Nixfmt.Types where import Prelude hiding (String) import Control.Monad.State (StateT) +import Data.Bifunctor (first) import Data.Foldable (toList) import Data.Function (on) import Data.Text (Text, pack) @@ -141,58 +142,39 @@ class LanguageElement a where mapFirstToken' :: (forall b. Ann b -> (Ann b, c)) -> a -> (a, c) instance LanguageElement Parameter where - mapFirstToken' f (IDParameter name) - = let (name', ret) = f name in (IDParameter name', ret) - mapFirstToken' f (SetParameter open items close) - = let (open', ret) = f open in (SetParameter open' items close, ret) - mapFirstToken' f (ContextParameter first at second) - = let (first', ret) = mapFirstToken' f first in ((ContextParameter first' at second), ret) + mapFirstToken' f = \case + (IDParameter name) -> first IDParameter (f name) + (SetParameter open items close) -> first (\open' -> SetParameter open' items close) (f open) + (ContextParameter first' at second) -> first (\first'' -> ContextParameter first'' at second) (mapFirstToken' f first') instance LanguageElement Term where - mapFirstToken' f (Token leaf) - = let (leaf', ret) = (f leaf) in (Token leaf', ret) - mapFirstToken' f (String string) - = let (string', ret) = (f string) in (String string', ret) - mapFirstToken' f (Path path) - = let (path', ret) = (f path) in (Path path', ret) - mapFirstToken' f (List open items close) - = let (open', ret) = (f open) in (List open' items close, ret) - mapFirstToken' f (Set (Just rec) open items close) - = let (rec', ret) = (f rec) in (Set (Just rec') open items close, ret) - mapFirstToken' f (Set Nothing open items close) - = let (open', ret) = (f open) in (Set Nothing open' items close, ret) - mapFirstToken' f (Selection term selector) - = let (term', ret) = (mapFirstToken' f term) in (Selection term' selector, ret) - mapFirstToken' f (Parenthesized open expr close) - = let (open', ret) = (f open) in (Parenthesized open' expr close, ret) + mapFirstToken' f = \case + (Token leaf) -> first Token (f leaf) + (String string) -> first String (f string) + (Path path) -> first Path (f path) + (List open items close) -> first (\open' -> List open' items close) (f open) + (Set (Just rec) open items close) -> first (\rec' -> Set (Just rec') open items close) (f rec) + (Set Nothing open items close) -> first (\open' -> Set Nothing open' items close) (f open) + (Selection term selector) -> first (\term' -> Selection term' selector) (mapFirstToken' f term) + (Parenthesized open expr close) -> first (\open' -> Parenthesized open' expr close) (f open) instance LanguageElement Expression where - mapFirstToken' f (Term term) - = let (term', ret) = (mapFirstToken' f term) in (Term term', ret) - mapFirstToken' f (With with expr0 semicolon expr1) - = let (with', ret) = (f with) in (With with' expr0 semicolon expr1, ret) - mapFirstToken' f (Let let_ items in_ body) - = let (let_', ret) = (f let_) in (Let let_' items in_ body, ret) - mapFirstToken' f (Assert assert cond semicolon body) - = let (assert', ret) = (f assert) in (Assert assert' cond semicolon body, ret) - mapFirstToken' f (If if_ expr0 then_ expr1 else_ expr2) - = let (if_', ret) = (f if_) in (If if_' expr0 then_ expr1 else_ expr2, ret) - mapFirstToken' f (Abstraction param colon body) - = let (param', ret) = (mapFirstToken' f param) in (Abstraction param' colon body, ret) - mapFirstToken' f (Application g a) - = let (g', ret) = (mapFirstToken' f g) in (Application g' a, ret) - mapFirstToken' f (Operation left op right) - = let (left', ret) = (mapFirstToken' f left) in (Operation left' op right, ret) - mapFirstToken' f (MemberCheck name dot selectors) - = let (name', ret) = (mapFirstToken' f name) in (MemberCheck name' dot selectors, ret) - mapFirstToken' f (Negation not_ expr) - = let (not_', ret) = (f not_) in (Negation not_' expr, ret) - mapFirstToken' f (Inversion tilde expr) - = let (tilde', ret) = (f tilde) in (Inversion tilde' expr, ret) + mapFirstToken' f = \case + (Term term) -> first Term (mapFirstToken' f term) + (With with expr0 semicolon expr1) -> first (\with' -> With with' expr0 semicolon expr1) (f with) + (Let let_ items in_ body) -> first (\let_' -> Let let_' items in_ body) (f let_) + (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) + (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) instance LanguageElement a => LanguageElement (Whole a) where mapFirstToken' f (Whole a trivia) - = let (a', ret) = (mapFirstToken' f a) in (Whole a' trivia, ret) + = first (\a' -> Whole a' trivia) (mapFirstToken' f a) data Token = Integer Int From 4c0007e9c100d07d37d928604d26a001cfaf34f9 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 9 Jul 2023 15:10:58 +0200 Subject: [PATCH 062/125] Tests: Add check-meta.nix --- test/diff/idioms_lib_5/in.nix | 456 +++++++++++++++++++++++ test/diff/idioms_lib_5/out.nix | 652 +++++++++++++++++++++++++++++++++ 2 files changed, 1108 insertions(+) create mode 100644 test/diff/idioms_lib_5/in.nix create mode 100644 test/diff/idioms_lib_5/out.nix diff --git a/test/diff/idioms_lib_5/in.nix b/test/diff/idioms_lib_5/in.nix new file mode 100644 index 00000000..63fd00d2 --- /dev/null +++ b/test/diff/idioms_lib_5/in.nix @@ -0,0 +1,456 @@ +# Checks derivation meta and attrs for problems (like brokenness, +# licenses, etc). + +{ lib, config, hostPlatform }: + +let + # If we're in hydra, we can dispense with the more verbose error + # messages and make problems easier to spot. + inHydra = config.inHydra or false; + # Allow the user to opt-into additional warnings, e.g. + # import { config = { showDerivationWarnings = [ "maintainerless" ]; }; } + showWarnings = config.showDerivationWarnings; + + getName = attrs: attrs.name or ("${attrs.pname or "«name-missing»"}-${attrs.version or "«version-missing»"}"); + + allowUnfree = config.allowUnfree + || builtins.getEnv "NIXPKGS_ALLOW_UNFREE" == "1"; + + allowNonSource = let + envVar = builtins.getEnv "NIXPKGS_ALLOW_NONSOURCE"; + in if envVar != "" + then envVar != "0" + else config.allowNonSource or true; + + allowlist = config.allowlistedLicenses or config.whitelistedLicenses or []; + blocklist = config.blocklistedLicenses or config.blacklistedLicenses or []; + + areLicenseListsValid = + if lib.mutuallyExclusive allowlist blocklist then + true + else + throw "allowlistedLicenses and blocklistedLicenses are not mutually exclusive."; + + hasLicense = attrs: + attrs ? meta.license; + + hasAllowlistedLicense = assert areLicenseListsValid; attrs: + hasLicense attrs && lib.lists.any (l: builtins.elem l allowlist) (lib.lists.toList attrs.meta.license); + + hasBlocklistedLicense = assert areLicenseListsValid; attrs: + hasLicense attrs && lib.lists.any (l: builtins.elem l blocklist) (lib.lists.toList attrs.meta.license); + + allowBroken = config.allowBroken + || builtins.getEnv "NIXPKGS_ALLOW_BROKEN" == "1"; + + allowUnsupportedSystem = config.allowUnsupportedSystem + || builtins.getEnv "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM" == "1"; + + isUnfree = licenses: lib.lists.any (l: !l.free or true) licenses; + + hasUnfreeLicense = attrs: + hasLicense attrs && + isUnfree (lib.lists.toList attrs.meta.license); + + hasNoMaintainers = attrs: + attrs ? meta.maintainers && (lib.length attrs.meta.maintainers) == 0; + + isMarkedBroken = attrs: attrs.meta.broken or false; + + hasUnsupportedPlatform = + pkg: !(lib.meta.availableOn hostPlatform pkg); + + isMarkedInsecure = attrs: (attrs.meta.knownVulnerabilities or []) != []; + + # Alow granular checks to allow only some unfree packages + # Example: + # {pkgs, ...}: + # { + # allowUnfree = false; + # allowUnfreePredicate = (x: pkgs.lib.hasPrefix "vscode" x.name); + # } + allowUnfreePredicate = config.allowUnfreePredicate or (x: false); + + # Check whether unfree packages are allowed and if not, whether the + # package has an unfree license and is not explicitly allowed by the + # `allowUnfreePredicate` function. + hasDeniedUnfreeLicense = attrs: + hasUnfreeLicense attrs && + !allowUnfree && + !allowUnfreePredicate attrs; + + allowInsecureDefaultPredicate = x: builtins.elem (getName x) (config.permittedInsecurePackages or []); + allowInsecurePredicate = x: (config.allowInsecurePredicate or allowInsecureDefaultPredicate) x; + + hasAllowedInsecure = attrs: + !(isMarkedInsecure attrs) || + allowInsecurePredicate attrs || + builtins.getEnv "NIXPKGS_ALLOW_INSECURE" == "1"; + + + isNonSource = sourceTypes: lib.lists.any (t: !t.isSource) sourceTypes; + + hasNonSourceProvenance = attrs: + (attrs ? meta.sourceProvenance) && + isNonSource attrs.meta.sourceProvenance; + + # Allow granular checks to allow only some non-source-built packages + # Example: + # { pkgs, ... }: + # { + # allowNonSource = false; + # allowNonSourcePredicate = with pkgs.lib.lists; pkg: !(any (p: !p.isSource && p != lib.sourceTypes.binaryFirmware) pkg.meta.sourceProvenance); + # } + allowNonSourcePredicate = config.allowNonSourcePredicate or (x: false); + + # Check whether non-source packages are allowed and if not, whether the + # package has non-source provenance and is not explicitly allowed by the + # `allowNonSourcePredicate` function. + hasDeniedNonSourceProvenance = attrs: + hasNonSourceProvenance attrs && + !allowNonSource && + !allowNonSourcePredicate attrs; + + showLicenseOrSourceType = value: toString (map (v: v.shortName or "unknown") (lib.lists.toList value)); + showLicense = showLicenseOrSourceType; + showSourceType = showLicenseOrSourceType; + + pos_str = meta: meta.position or "«unknown-file»"; + + remediation = { + unfree = remediate_allowlist "Unfree" (remediate_predicate "allowUnfreePredicate"); + non-source = remediate_allowlist "NonSource" (remediate_predicate "allowNonSourcePredicate"); + broken = remediate_allowlist "Broken" (x: ""); + unsupported = remediate_allowlist "UnsupportedSystem" (x: ""); + blocklisted = x: ""; + insecure = remediate_insecure; + broken-outputs = remediateOutputsToInstall; + unknown-meta = x: ""; + maintainerless = x: ""; + }; + remediation_env_var = allow_attr: { + Unfree = "NIXPKGS_ALLOW_UNFREE"; + Broken = "NIXPKGS_ALLOW_BROKEN"; + UnsupportedSystem = "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM"; + NonSource = "NIXPKGS_ALLOW_NONSOURCE"; + }.${allow_attr}; + remediation_phrase = allow_attr: { + Unfree = "unfree packages"; + Broken = "broken packages"; + UnsupportedSystem = "packages that are unsupported for this system"; + NonSource = "packages not built from source"; + }.${allow_attr}; + remediate_predicate = predicateConfigAttr: attrs: + '' + + Alternatively you can configure a predicate to allow specific packages: + { nixpkgs.config.${predicateConfigAttr} = pkg: builtins.elem (lib.getName pkg) [ + "${lib.getName attrs}" + ]; + } + ''; + + # flakeNote will be printed in the remediation messages below. + flakeNote = " + Note: For `nix shell`, `nix build`, `nix develop` or any other Nix 2.4+ + (Flake) command, `--impure` must be passed in order to read this + environment variable. + "; + + remediate_allowlist = allow_attr: rebuild_amendment: attrs: + '' + a) To temporarily allow ${remediation_phrase allow_attr}, you can use an environment variable + for a single invocation of the nix tools. + + $ export ${remediation_env_var allow_attr}=1 + ${flakeNote} + b) For `nixos-rebuild` you can set + { nixpkgs.config.allow${allow_attr} = true; } + in configuration.nix to override this. + ${rebuild_amendment attrs} + c) For `nix-env`, `nix-build`, `nix-shell` or any other Nix command you can add + { allow${allow_attr} = true; } + to ~/.config/nixpkgs/config.nix. + ''; + + remediate_insecure = attrs: + '' + + Known issues: + '' + (lib.concatStrings (map (issue: " - ${issue}\n") attrs.meta.knownVulnerabilities)) + '' + + You can install it anyway by allowing this package, using the + following methods: + + a) To temporarily allow all insecure packages, you can use an environment + variable for a single invocation of the nix tools: + + $ export NIXPKGS_ALLOW_INSECURE=1 + ${flakeNote} + b) for `nixos-rebuild` you can add ‘${getName attrs}’ to + `nixpkgs.config.permittedInsecurePackages` in the configuration.nix, + like so: + + { + nixpkgs.config.permittedInsecurePackages = [ + "${getName attrs}" + ]; + } + + c) For `nix-env`, `nix-build`, `nix-shell` or any other Nix command you can add + ‘${getName attrs}’ to `permittedInsecurePackages` in + ~/.config/nixpkgs/config.nix, like so: + + { + permittedInsecurePackages = [ + "${getName attrs}" + ]; + } + + ''; + + remediateOutputsToInstall = attrs: let + expectedOutputs = attrs.meta.outputsToInstall or []; + actualOutputs = attrs.outputs or [ "out" ]; + missingOutputs = builtins.filter (output: ! builtins.elem output actualOutputs) expectedOutputs; + in '' + The package ${getName attrs} has set meta.outputsToInstall to: ${builtins.concatStringsSep ", " expectedOutputs} + + however ${getName attrs} only has the outputs: ${builtins.concatStringsSep ", " actualOutputs} + + and is missing the following ouputs: + + ${lib.concatStrings (builtins.map (output: " - ${output}\n") missingOutputs)} + ''; + + handleEvalIssue = { meta, attrs }: { reason , errormsg ? "" }: + let + msg = if inHydra + then "Failed to evaluate ${getName attrs}: «${reason}»: ${errormsg}" + else '' + Package ‘${getName attrs}’ in ${pos_str meta} ${errormsg}, refusing to evaluate. + + '' + (builtins.getAttr reason remediation) attrs; + + handler = if config ? handleEvalIssue + then config.handleEvalIssue reason + else throw; + in handler msg; + + handleEvalWarning = { meta, attrs }: { reason , errormsg ? "" }: + let + remediationMsg = (builtins.getAttr reason remediation) attrs; + msg = if inHydra then "Warning while evaluating ${getName attrs}: «${reason}»: ${errormsg}" + else "Package ${getName attrs} in ${pos_str meta} ${errormsg}, continuing anyway." + + (lib.optionalString (remediationMsg != "") "\n${remediationMsg}"); + isEnabled = lib.findFirst (x: x == reason) null showWarnings; + in if isEnabled != null then builtins.trace msg true else true; + + # Deep type-checking. Note that calling `type.check` is not enough: see `lib.mkOptionType`'s documentation. + # We don't include this in lib for now because this function is flawed: it accepts things like `mkIf true 42`. + typeCheck = type: value: let + merged = lib.mergeDefinitions [ ] type [ + { file = lib.unknownModule; inherit value; } + ]; + eval = builtins.tryEval (builtins.deepSeq merged.mergedValue null); + in eval.success; + + # TODO make this into a proper module and use the generic option documentation generation? + metaTypes = with lib.types; rec { + # These keys are documented + description = str; + mainProgram = str; + longDescription = str; + branch = str; + homepage = either (listOf str) str; + downloadPage = str; + changelog = either (listOf str) str; + license = let + licenseType = either (attrsOf anything) str; # TODO disallow `str` licenses, use a module + in either licenseType (listOf licenseType); + sourceProvenance = listOf lib.types.attrs; + maintainers = listOf (attrsOf anything); # TODO use the maintainer type from lib/tests/maintainer-module.nix + priority = int; + pkgConfigModules = listOf str; + platforms = listOf (either str (attrsOf anything)); # see lib.meta.platformMatch + hydraPlatforms = listOf str; + broken = bool; + unfree = bool; + unsupported = bool; + insecure = bool; + # TODO: refactor once something like Profpatsch's types-simple will land + # This is currently dead code due to https://github.com/NixOS/nix/issues/2532 + tests = attrsOf (mkOptionType { + name = "test"; + check = x: x == {} || ( # Accept {} for tests that are unsupported + isDerivation x && + x ? meta.timeout + ); + merge = lib.options.mergeOneOption; + }); + timeout = int; + + # Needed for Hydra to expose channel tarballs: + # https://github.com/NixOS/hydra/blob/53335323ae79ca1a42643f58e520b376898ce641/doc/manual/src/jobs.md#meta-fields + isHydraChannel = bool; + + # Weirder stuff that doesn't appear in the documentation? + maxSilent = int; + knownVulnerabilities = listOf str; + name = str; + version = str; + tag = str; + executables = listOf str; + outputsToInstall = listOf str; + position = str; + available = unspecified; + isBuildPythonPackage = platforms; + schedulingPriority = int; + isFcitxEngine = bool; + isIbusEngine = bool; + isGutenprint = bool; + badPlatforms = platforms; + }; + + checkMetaAttr = k: v: + if metaTypes?${k} then + if typeCheck metaTypes.${k} v then + null + else + "key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got\n ${ + lib.generators.toPretty { indent = " "; } v + }" + else + "key 'meta.${k}' is unrecognized; expected one of: \n [${lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes)}]"; + checkMeta = meta: lib.optionals config.checkMeta (lib.remove null (lib.mapAttrsToList checkMetaAttr meta)); + + checkOutputsToInstall = attrs: let + expectedOutputs = attrs.meta.outputsToInstall or []; + actualOutputs = attrs.outputs or [ "out" ]; + missingOutputs = builtins.filter (output: ! builtins.elem output actualOutputs) expectedOutputs; + in if config.checkMeta + then builtins.length missingOutputs > 0 + else false; + + # Check if a derivation is valid, that is whether it passes checks for + # e.g brokenness or license. + # + # Return { valid: "yes", "warn" or "no" } and additionally + # { reason: String; errormsg: String } if it is not valid, where + # reason is one of "unfree", "blocklisted", "broken", "insecure", ... + # !!! reason strings are hardcoded into OfBorg, make sure to keep them in sync + # Along with a boolean flag for each reason + checkValidity = attrs: + # Check meta attribute types first, to make sure it is always called even when there are other issues + # Note that this is not a full type check and functions below still need to by careful about their inputs! + let res = checkMeta (attrs.meta or {}); in if res != [] then + { valid = "no"; reason = "unknown-meta"; errormsg = "has an invalid meta attrset:${lib.concatMapStrings (x: "\n - " + x) res}\n"; + unfree = false; nonSource = false; broken = false; unsupported = false; insecure = false; + } + else { + unfree = hasUnfreeLicense attrs; + nonSource = hasNonSourceProvenance attrs; + broken = isMarkedBroken attrs; + unsupported = hasUnsupportedPlatform attrs; + insecure = isMarkedInsecure attrs; + } // ( + # --- Put checks that cannot be ignored here --- + if checkOutputsToInstall attrs then + { valid = "no"; reason = "broken-outputs"; errormsg = "has invalid meta.outputsToInstall"; } + + # --- Put checks that can be ignored here --- + else if hasDeniedUnfreeLicense attrs && !(hasAllowlistedLicense attrs) then + { valid = "no"; reason = "unfree"; errormsg = "has an unfree license (‘${showLicense attrs.meta.license}’)"; } + else if hasBlocklistedLicense attrs then + { valid = "no"; reason = "blocklisted"; errormsg = "has a blocklisted license (‘${showLicense attrs.meta.license}’)"; } + else if hasDeniedNonSourceProvenance attrs then + { valid = "no"; reason = "non-source"; errormsg = "contains elements not built from source (‘${showSourceType attrs.meta.sourceProvenance}’)"; } + else if !allowBroken && attrs.meta.broken or false then + { valid = "no"; reason = "broken"; errormsg = "is marked as broken"; } + else if !allowUnsupportedSystem && hasUnsupportedPlatform attrs then + let toPretty = lib.generators.toPretty { + allowPrettyValues = true; + indent = " "; + }; + in { valid = "no"; reason = "unsupported"; + errormsg = '' + is not available on the requested hostPlatform: + hostPlatform.config = "${hostPlatform.config}" + package.meta.platforms = ${toPretty (attrs.meta.platforms or [])} + package.meta.badPlatforms = ${toPretty (attrs.meta.badPlatforms or [])} + ''; + } + else if !(hasAllowedInsecure attrs) then + { valid = "no"; reason = "insecure"; errormsg = "is marked as insecure"; } + + # --- warnings --- + # Please also update the type in /pkgs/top-level/config.nix alongside this. + else if hasNoMaintainers attrs then + { valid = "warn"; reason = "maintainerless"; errormsg = "has no maintainers"; } + # ----- + else { valid = "yes"; }); + + + # The meta attribute is passed in the resulting attribute set, + # but it's not part of the actual derivation, i.e., it's not + # passed to the builder and is not a dependency. But since we + # include it in the result, it *is* available to nix-env for queries. + # Example: + # meta = checkMeta.commonMeta { inherit validity attrs pos references; }; + # validity = checkMeta.assertValidity { inherit meta attrs; }; + commonMeta = { validity, attrs, pos ? null, references ? [ ] }: + let + outputs = attrs.outputs or [ "out" ]; + in + { + # `name` derivation attribute includes cross-compilation cruft, + # is under assert, and is sanitized. + # Let's have a clean always accessible version here. + name = attrs.name or "${attrs.pname}-${attrs.version}"; + + # If the packager hasn't specified `outputsToInstall`, choose a default, + # which is the name of `p.bin or p.out or p` along with `p.man` when + # present. + # + # If the packager has specified it, it will be overridden below in + # `// meta`. + # + # Note: This default probably shouldn't be globally configurable. + # Services and users should specify outputs explicitly, + # unless they are comfortable with this default. + outputsToInstall = + let + hasOutput = out: builtins.elem out outputs; + in + [ (lib.findFirst hasOutput null ([ "bin" "out" ] ++ outputs)) ] + ++ lib.optional (hasOutput "man") "man"; + } + // attrs.meta or { } + # Fill `meta.position` to identify the source location of the package. + // lib.optionalAttrs (pos != null) { + position = pos.file + ":" + toString pos.line; + } // { + # Expose the result of the checks for everyone to see. + inherit (validity) unfree broken unsupported insecure; + + available = validity.valid != "no" + && (if config.checkMetaRecursively or false + then lib.all (d: d.meta.available or true) references + else true); + }; + + assertValidity = { meta, attrs }: let + validity = checkValidity attrs; + in validity // { + # Throw an error if trying to evaluate a non-valid derivation + # or, alternatively, just output a warning message. + handled = + { + no = handleEvalIssue { inherit meta attrs; } { inherit (validity) reason errormsg; }; + warn = handleEvalWarning { inherit meta attrs; } { inherit (validity) reason errormsg; }; + yes = true; + }.${validity.valid}; + + }; + +in { inherit assertValidity commonMeta; } diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix new file mode 100644 index 00000000..8779df1d --- /dev/null +++ b/test/diff/idioms_lib_5/out.nix @@ -0,0 +1,652 @@ +# Checks derivation meta and attrs for problems (like brokenness, +# licenses, etc). + +{ + lib, + config, + hostPlatform, +}: + +let + # If we're in hydra, we can dispense with the more verbose error + # messages and make problems easier to spot. + inHydra = config.inHydra or false; + # Allow the user to opt-into additional warnings, e.g. + # import { config = { showDerivationWarnings = [ "maintainerless" ]; }; } + showWarnings = config.showDerivationWarnings; + + getName = + attrs: + attrs.name or ( + "${attrs.pname or "«name-missing»"}-${attrs.version or "«version-missing»"}" + ) + ; + + allowUnfree = + config.allowUnfree || builtins.getEnv "NIXPKGS_ALLOW_UNFREE" == "1"; + + allowNonSource = + let + envVar = builtins.getEnv "NIXPKGS_ALLOW_NONSOURCE"; + in + if envVar != "" then envVar != "0" else config.allowNonSource or true + ; + + allowlist = config.allowlistedLicenses or config.whitelistedLicenses or [ ]; + blocklist = config.blocklistedLicenses or config.blacklistedLicenses or [ ]; + + areLicenseListsValid = + if lib.mutuallyExclusive allowlist blocklist then + true + else + throw "allowlistedLicenses and blocklistedLicenses are not mutually exclusive." + ; + + hasLicense = attrs: attrs ? meta.license; + + hasAllowlistedLicense = + assert areLicenseListsValid; + attrs: + hasLicense attrs + && lib.lists.any (l: builtins.elem l allowlist) ( + lib.lists.toList attrs.meta.license + ) + ; + + hasBlocklistedLicense = + assert areLicenseListsValid; + attrs: + hasLicense attrs + && lib.lists.any (l: builtins.elem l blocklist) ( + lib.lists.toList attrs.meta.license + ) + ; + + allowBroken = + config.allowBroken || builtins.getEnv "NIXPKGS_ALLOW_BROKEN" == "1"; + + allowUnsupportedSystem = + config.allowUnsupportedSystem + || builtins.getEnv "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM" == "1" + ; + + isUnfree = licenses: lib.lists.any (l: !l.free or true) licenses; + + hasUnfreeLicense = + attrs: hasLicense attrs && isUnfree (lib.lists.toList attrs.meta.license); + + hasNoMaintainers = + attrs: attrs ? meta.maintainers && (lib.length attrs.meta.maintainers) == 0; + + isMarkedBroken = attrs: attrs.meta.broken or false; + + hasUnsupportedPlatform = pkg: !(lib.meta.availableOn hostPlatform pkg); + + isMarkedInsecure = attrs: (attrs.meta.knownVulnerabilities or [ ]) != [ ]; + + # Alow granular checks to allow only some unfree packages + # Example: + # {pkgs, ...}: + # { + # allowUnfree = false; + # allowUnfreePredicate = (x: pkgs.lib.hasPrefix "vscode" x.name); + # } + allowUnfreePredicate = config.allowUnfreePredicate or (x: false); + + # Check whether unfree packages are allowed and if not, whether the + # package has an unfree license and is not explicitly allowed by the + # `allowUnfreePredicate` function. + hasDeniedUnfreeLicense = + attrs: hasUnfreeLicense attrs && !allowUnfree && !allowUnfreePredicate attrs; + + allowInsecureDefaultPredicate = + x: builtins.elem (getName x) (config.permittedInsecurePackages or [ ]); + allowInsecurePredicate = + x: (config.allowInsecurePredicate or allowInsecureDefaultPredicate) x; + + hasAllowedInsecure = + attrs: + !(isMarkedInsecure attrs) + || allowInsecurePredicate attrs + || builtins.getEnv "NIXPKGS_ALLOW_INSECURE" == "1" + ; + + isNonSource = sourceTypes: lib.lists.any (t: !t.isSource) sourceTypes; + + hasNonSourceProvenance = + attrs: + (attrs ? meta.sourceProvenance) && isNonSource attrs.meta.sourceProvenance + ; + + # Allow granular checks to allow only some non-source-built packages + # Example: + # { pkgs, ... }: + # { + # allowNonSource = false; + # allowNonSourcePredicate = with pkgs.lib.lists; pkg: !(any (p: !p.isSource && p != lib.sourceTypes.binaryFirmware) pkg.meta.sourceProvenance); + # } + allowNonSourcePredicate = config.allowNonSourcePredicate or (x: false); + + # Check whether non-source packages are allowed and if not, whether the + # package has non-source provenance and is not explicitly allowed by the + # `allowNonSourcePredicate` function. + hasDeniedNonSourceProvenance = + attrs: + hasNonSourceProvenance attrs + && !allowNonSource + && !allowNonSourcePredicate attrs + ; + + showLicenseOrSourceType = + value: toString (map (v: v.shortName or "unknown") (lib.lists.toList value)); + showLicense = showLicenseOrSourceType; + showSourceType = showLicenseOrSourceType; + + pos_str = meta: meta.position or "«unknown-file»"; + + remediation = { + unfree = remediate_allowlist "Unfree" ( + remediate_predicate "allowUnfreePredicate" + ); + non-source = remediate_allowlist "NonSource" ( + remediate_predicate "allowNonSourcePredicate" + ); + broken = remediate_allowlist "Broken" (x: ""); + unsupported = remediate_allowlist "UnsupportedSystem" (x: ""); + blocklisted = x: ""; + insecure = remediate_insecure; + broken-outputs = remediateOutputsToInstall; + unknown-meta = x: ""; + maintainerless = x: ""; + }; + remediation_env_var = + allow_attr: + { + Unfree = "NIXPKGS_ALLOW_UNFREE"; + Broken = "NIXPKGS_ALLOW_BROKEN"; + UnsupportedSystem = "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM"; + NonSource = "NIXPKGS_ALLOW_NONSOURCE"; + } + .${allow_attr} + ; + remediation_phrase = + allow_attr: + { + Unfree = "unfree packages"; + Broken = "broken packages"; + UnsupportedSystem = "packages that are unsupported for this system"; + NonSource = "packages not built from source"; + } + .${allow_attr} + ; + remediate_predicate = predicateConfigAttr: attrs: '' + + Alternatively you can configure a predicate to allow specific packages: + { nixpkgs.config.${predicateConfigAttr} = pkg: builtins.elem (lib.getName pkg) [ + "${lib.getName attrs}" + ]; + } + ''; + + # flakeNote will be printed in the remediation messages below. + flakeNote = "\n Note: For `nix shell`, `nix build`, `nix develop` or any other Nix 2.4+\n (Flake) command, `--impure` must be passed in order to read this\n environment variable.\n "; + + remediate_allowlist = allow_attr: rebuild_amendment: attrs: '' + a) To temporarily allow ${ + remediation_phrase allow_attr + }, you can use an environment variable + for a single invocation of the nix tools. + + $ export ${remediation_env_var allow_attr}=1 + ${flakeNote} + b) For `nixos-rebuild` you can set + { nixpkgs.config.allow${allow_attr} = true; } + in configuration.nix to override this. + ${rebuild_amendment attrs} + c) For `nix-env`, `nix-build`, `nix-shell` or any other Nix command you can add + { allow${allow_attr} = true; } + to ~/.config/nixpkgs/config.nix. + ''; + + remediate_insecure = + attrs: + '' + + Known issues: + '' + + (lib.concatStrings ( + map (issue: " - ${issue}\n") attrs.meta.knownVulnerabilities + )) + + '' + + You can install it anyway by allowing this package, using the + following methods: + + a) To temporarily allow all insecure packages, you can use an environment + variable for a single invocation of the nix tools: + + $ export NIXPKGS_ALLOW_INSECURE=1 + ${flakeNote} + b) for `nixos-rebuild` you can add ‘${getName attrs}’ to + `nixpkgs.config.permittedInsecurePackages` in the configuration.nix, + like so: + + { + nixpkgs.config.permittedInsecurePackages = [ + "${getName attrs}" + ]; + } + + c) For `nix-env`, `nix-build`, `nix-shell` or any other Nix command you can add + ‘${getName attrs}’ to `permittedInsecurePackages` in + ~/.config/nixpkgs/config.nix, like so: + + { + permittedInsecurePackages = [ + "${getName attrs}" + ]; + } + + '' + ; + + remediateOutputsToInstall = + attrs: + let + expectedOutputs = attrs.meta.outputsToInstall or [ ]; + actualOutputs = attrs.outputs or [ "out" ]; + missingOutputs = + builtins.filter (output: !builtins.elem output actualOutputs) + expectedOutputs + ; + in + '' + The package ${getName attrs} has set meta.outputsToInstall to: ${ + builtins.concatStringsSep ", " expectedOutputs + } + + however ${getName attrs} only has the outputs: ${ + builtins.concatStringsSep ", " actualOutputs + } + + and is missing the following ouputs: + + ${lib.concatStrings (builtins.map (output: " - ${output}\n") missingOutputs)} + '' + ; + + handleEvalIssue = + { + meta, + attrs, + }: + { + reason, + errormsg ? "", + }: + let + msg = + if inHydra then + "Failed to evaluate ${getName attrs}: «${reason}»: ${errormsg}" + else + '' + Package ‘${getName attrs}’ in ${pos_str meta} ${errormsg}, refusing to evaluate. + + '' + + (builtins.getAttr reason remediation) attrs + ; + + handler = + if config ? handleEvalIssue then config.handleEvalIssue reason else throw; + in + handler msg + ; + + handleEvalWarning = + { + meta, + attrs, + }: + { + reason, + errormsg ? "", + }: + let + remediationMsg = (builtins.getAttr reason remediation) attrs; + msg = + if inHydra then + "Warning while evaluating ${getName attrs}: «${reason}»: ${errormsg}" + else + "Package ${getName attrs} in ${pos_str meta} ${errormsg}, continuing anyway." + + (lib.optionalString (remediationMsg != "") '' + + ${remediationMsg}'') + ; + isEnabled = lib.findFirst (x: x == reason) null showWarnings; + in + if isEnabled != null then builtins.trace msg true else true + ; + + # Deep type-checking. Note that calling `type.check` is not enough: see `lib.mkOptionType`'s documentation. + # We don't include this in lib for now because this function is flawed: it accepts things like `mkIf true 42`. + typeCheck = + type: value: + let + merged = lib.mergeDefinitions [ ] type [ { + file = lib.unknownModule; + inherit value; + } ]; + eval = builtins.tryEval (builtins.deepSeq merged.mergedValue null); + in + eval.success + ; + + # TODO make this into a proper module and use the generic option documentation generation? + metaTypes = with lib.types; rec { + # These keys are documented + description = str; + mainProgram = str; + longDescription = str; + branch = str; + homepage = either (listOf str) str; + downloadPage = str; + changelog = either (listOf str) str; + license = + let + licenseType = either (attrsOf anything) str; # TODO disallow `str` licenses, use a module + in + either licenseType (listOf licenseType) + ; + sourceProvenance = listOf lib.types.attrs; + maintainers = listOf (attrsOf anything); # TODO use the maintainer type from lib/tests/maintainer-module.nix + priority = int; + pkgConfigModules = listOf str; + platforms = listOf (either str (attrsOf anything)); # see lib.meta.platformMatch + hydraPlatforms = listOf str; + broken = bool; + unfree = bool; + unsupported = bool; + insecure = bool; + # TODO: refactor once something like Profpatsch's types-simple will land + # This is currently dead code due to https://github.com/NixOS/nix/issues/2532 + tests = attrsOf ( + mkOptionType { + name = "test"; + check = + x: + x == { } + || ( # Accept {} for tests that are unsupported + isDerivation x && x ? meta.timeout + ) + ; + merge = lib.options.mergeOneOption; + } + ); + timeout = int; + + # Needed for Hydra to expose channel tarballs: + # https://github.com/NixOS/hydra/blob/53335323ae79ca1a42643f58e520b376898ce641/doc/manual/src/jobs.md#meta-fields + isHydraChannel = bool; + + # Weirder stuff that doesn't appear in the documentation? + maxSilent = int; + knownVulnerabilities = listOf str; + name = str; + version = str; + tag = str; + executables = listOf str; + outputsToInstall = listOf str; + position = str; + available = unspecified; + isBuildPythonPackage = platforms; + schedulingPriority = int; + isFcitxEngine = bool; + isIbusEngine = bool; + isGutenprint = bool; + badPlatforms = platforms; + }; + + checkMetaAttr = + k: v: + if metaTypes ? ${k} then + if typeCheck metaTypes.${k} v then + null + else + '' + key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got + ${lib.generators.toPretty { indent = " "; } v}'' + else + '' + key 'meta.${k}' is unrecognized; expected one of: + [${lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes)}]'' + ; + checkMeta = + meta: + lib.optionals config.checkMeta ( + lib.remove null (lib.mapAttrsToList checkMetaAttr meta) + ) + ; + + checkOutputsToInstall = + attrs: + let + expectedOutputs = attrs.meta.outputsToInstall or [ ]; + actualOutputs = attrs.outputs or [ "out" ]; + missingOutputs = + builtins.filter (output: !builtins.elem output actualOutputs) + expectedOutputs + ; + in + if config.checkMeta then builtins.length missingOutputs > 0 else false + ; + + # Check if a derivation is valid, that is whether it passes checks for + # e.g brokenness or license. + # + # Return { valid: "yes", "warn" or "no" } and additionally + # { reason: String; errormsg: String } if it is not valid, where + # reason is one of "unfree", "blocklisted", "broken", "insecure", ... + # !!! reason strings are hardcoded into OfBorg, make sure to keep them in sync + # Along with a boolean flag for each reason + checkValidity = + attrs: + # Check meta attribute types first, to make sure it is always called even when there are other issues + # Note that this is not a full type check and functions below still need to by careful about their inputs! + let + res = checkMeta (attrs.meta or { }); + in + if res != [ ] then + { + valid = "no"; + reason = "unknown-meta"; + errormsg = '' + has an invalid meta attrset:${lib.concatMapStrings (x: "\n - " + x) res} + ''; + unfree = false; + nonSource = false; + broken = false; + unsupported = false; + insecure = false; + } + else + { + unfree = hasUnfreeLicense attrs; + nonSource = hasNonSourceProvenance attrs; + broken = isMarkedBroken attrs; + unsupported = hasUnsupportedPlatform attrs; + insecure = isMarkedInsecure attrs; + } // ( + # --- Put checks that cannot be ignored here --- + if checkOutputsToInstall attrs then + { + valid = "no"; + reason = "broken-outputs"; + errormsg = "has invalid meta.outputsToInstall"; + } + + # --- Put checks that can be ignored here --- + else if hasDeniedUnfreeLicense attrs && !(hasAllowlistedLicense attrs) then + { + valid = "no"; + reason = "unfree"; + errormsg = "has an unfree license (‘${showLicense attrs.meta.license}’)"; + } + else if hasBlocklistedLicense attrs then + { + valid = "no"; + reason = "blocklisted"; + errormsg = "has a blocklisted license (‘${showLicense attrs.meta.license}’)"; + } + else if hasDeniedNonSourceProvenance attrs then + { + valid = "no"; + reason = "non-source"; + errormsg = "contains elements not built from source (‘${ + showSourceType attrs.meta.sourceProvenance + }’)"; + } + else if !allowBroken && attrs.meta.broken or false then + { + valid = "no"; + reason = "broken"; + errormsg = "is marked as broken"; + } + else if !allowUnsupportedSystem && hasUnsupportedPlatform attrs then + let + toPretty = lib.generators.toPretty { + allowPrettyValues = true; + indent = " "; + }; + in + { + valid = "no"; + reason = "unsupported"; + errormsg = '' + is not available on the requested hostPlatform: + hostPlatform.config = "${hostPlatform.config}" + package.meta.platforms = ${toPretty (attrs.meta.platforms or [ ])} + package.meta.badPlatforms = ${toPretty (attrs.meta.badPlatforms or [ ])} + ''; + } + else if !(hasAllowedInsecure attrs) then + { + valid = "no"; + reason = "insecure"; + errormsg = "is marked as insecure"; + } + + # --- warnings --- + # Please also update the type in /pkgs/top-level/config.nix alongside this. + else if hasNoMaintainers attrs then + { + valid = "warn"; + reason = "maintainerless"; + errormsg = "has no maintainers"; + } + # ----- + else + { valid = "yes"; } + ) + ; + + # The meta attribute is passed in the resulting attribute set, + # but it's not part of the actual derivation, i.e., it's not + # passed to the builder and is not a dependency. But since we + # include it in the result, it *is* available to nix-env for queries. + # Example: + # meta = checkMeta.commonMeta { inherit validity attrs pos references; }; + # validity = checkMeta.assertValidity { inherit meta attrs; }; + commonMeta = + { + validity, + attrs, + pos ? null, + references ? [ ], + }: + let + outputs = attrs.outputs or [ "out" ]; + in + { + # `name` derivation attribute includes cross-compilation cruft, + # is under assert, and is sanitized. + # Let's have a clean always accessible version here. + name = attrs.name or "${attrs.pname}-${attrs.version}"; + + # If the packager hasn't specified `outputsToInstall`, choose a default, + # which is the name of `p.bin or p.out or p` along with `p.man` when + # present. + # + # If the packager has specified it, it will be overridden below in + # `// meta`. + # + # Note: This default probably shouldn't be globally configurable. + # Services and users should specify outputs explicitly, + # unless they are comfortable with this default. + outputsToInstall = + let + hasOutput = out: builtins.elem out outputs; + in + [ + (lib.findFirst hasOutput null ( + [ + "bin" + "out" + ] + ++ outputs + )) + ] + ++ lib.optional (hasOutput "man") "man" + ; + } // attrs.meta or { } + # Fill `meta.position` to identify the source location of the package. + // lib.optionalAttrs (pos != null) { + position = pos.file + ":" + toString pos.line; + } // { + # Expose the result of the checks for everyone to see. + inherit (validity) + unfree + broken + unsupported + insecure + ; + + available = + validity.valid != "no" + && ( + if config.checkMetaRecursively or false then + lib.all (d: d.meta.available or true) references + else + true + ) + ; + } + ; + + assertValidity = + { + meta, + attrs, + }: + let + validity = checkValidity attrs; + in + validity // { + # Throw an error if trying to evaluate a non-valid derivation + # or, alternatively, just output a warning message. + handled = + { + no = handleEvalIssue { inherit meta attrs; } { + inherit (validity) reason errormsg; + }; + warn = handleEvalWarning { inherit meta attrs; } { + inherit (validity) reason errormsg; + }; + yes = true; + } + .${validity.valid}; + } + ; +in +{ + inherit assertValidity commonMeta; +} From ef310bbe01ca1fee43809bd570271fc6e710d551 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 17 Jul 2023 13:20:51 +0200 Subject: [PATCH 063/125] Improved helper functions --- src/Nixfmt/Predoc.hs | 17 +++++++++++------ src/Nixfmt/Pretty.hs | 26 +++++++++++++------------- 2 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 9b6548f8..1d08e07a 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -12,6 +12,7 @@ module Nixfmt.Predoc ( text , comment , sepBy + , surroundWith , hcat , base , group @@ -156,15 +157,16 @@ group' prio = pure . Node (Group prio) . pretty -- the line, rather than the indentation it should have used: If multiple -- indentation levels start on the same line, only the last indentation level -- will be applied on the next line. This prevents unnecessary nesting. -nest :: HasCallStack => Int -> Doc -> Doc +nest :: HasCallStack => Pretty a => Int -> a -> Doc nest level x = pure . Node (Nest level) $ - if x /= [] && (isSoftSpacing (head x) || isSoftSpacing (last x)) then - error $ "nest should not start or end with whitespace; " <> show x + if x' /= [] && (isSoftSpacing (head x') || isSoftSpacing (last x')) then + error $ "nest should not start or end with whitespace; " <> show x' else - x + x' + where x' = pretty x -base :: Doc -> Doc -base = pure . Node Base +base :: Pretty a => a -> Doc +base = pure . Node Base . pretty -- | Line break or nothing (soft) softline' :: Doc @@ -197,6 +199,9 @@ emptyline = [Spacing Emptyline] newline :: Doc newline = [Spacing (Newlines 1)] +surroundWith :: Pretty a => Doc -> a -> Doc +surroundWith outside inner = outside <> pretty inner <> outside + sepBy :: Pretty a => Doc -> [a] -> Doc sepBy separator = mconcat . intersperse separator . map pretty diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index bf10a394..07bf35e4 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -19,7 +19,7 @@ import qualified Data.Text as Text -- import Debug.Trace (traceShowId) import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, newline, pretty, sepBy, softline, softline', text, comment, textWidth) + nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, textWidth) import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), @@ -165,8 +165,8 @@ prettySet _ (Nothing, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) -- but apart from that always expand. prettySet wide (krec, Ann pre paropen post, binders, parclose) = base $ pretty (fmap (, hardspace) krec) <> - pretty (Ann pre paropen Nothing) <> sep - <> nest 2 (pretty post <> prettyItems hardline binders) <> sep + pretty (Ann pre paropen Nothing) + <> (surroundWith sep $ nest 2 $ pretty post <> prettyItems hardline binders) <> pretty parclose where sep = if wide && not (null (unItems binders)) then hardline else line @@ -197,17 +197,17 @@ prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trail prettyTerm (List paropen@(Ann _ _ Nothing) (Items [item@(CommentedItem iComment item')]) parclose@(Ann [] _ _)) = base $ groupWithStart paropen $ (if isAbsorbable item' && null iComment then - (hardspace <> pretty item' <> hardspace) + surroundWith hardspace item' else - (line <> nest 2 (pretty item) <> line) + surroundWith line $ nest 2 item ) <> pretty parclose -- General list (len >= 2) -- Always expand prettyTerm (List (Ann pre paropen post) items parclose) = - base $ pretty (Ann pre paropen Nothing) <> hardline - <> nest 2 ((pretty post) <> prettyItems hardline items) <> hardline + base $ pretty (Ann pre paropen Nothing) + <> (surroundWith hardline $ nest 2 $ pretty post <> prettyItems hardline items) <> pretty parclose prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) @@ -326,9 +326,9 @@ prettyApp commentPre pre post commentPost f a absorbLast (Term t) | isAbsorbable t = group' True $ nest 2 $ prettyTerm t absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) - = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) <> line' - <> group (nest 2 (pretty post' <> pretty expr)) - <> line' <> pretty close + = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) + <> (surroundWith line' $ group $ nest 2 $ pretty post' <> pretty expr) + <> pretty close absorbLast arg = group' False $ nest 2 $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded @@ -426,8 +426,8 @@ instance Pretty Expression where pretty (If if_ cond then_ expr0 else_ expr1) = base $ group $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - (groupWithStart if_ (line <> nest 2 (pretty cond) <> line <> pretty then_)) - <> line <> nest 2 (group expr0) <> line + groupWithStart if_ (line <> nest 2 (pretty cond) <> line <> pretty then_) + <> (surroundWith line $ nest 2 $ group expr0) <> pretty else_ <> absorbElse expr1 pretty (Abstraction (IDParameter param) colon body) @@ -468,7 +468,7 @@ instance Pretty Expression where -- Force nested operations to start on a new line absorbOperation x@(Operation _ _ _) = group' False $ line <> pretty x -- Force applications to start on a new line if more than the last argument is multiline - absorbOperation (Application f a) = group $ hardspace <> prettyApp hardline line mempty mempty f a + absorbOperation (Application f a) = group $ prettyApp hardline line mempty mempty f a absorbOperation x = hardspace <> pretty x prettyOperation :: (Maybe Leaf, Expression) -> Doc From a54a01af3498fbfb23fb57f2fc99b059270d4e89 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 12 Jul 2023 16:26:43 +0200 Subject: [PATCH 064/125] Improve priority group handling It now also takes into account whether post fits onto a single line or not. Previously this did not matter, as all instances only had whitespace in there, so force-unexpanding worked as a hack. But now it is time to fully implement the feature. No big changes to the layouting algorithm itself were made, however it needed to be refactored such that the interface it provides only processes one item at a time. (The algorithm already did that, it's just that the function always also processed the rest.) This has been done by making use of the State monad. This should cause no changes to the output format. --- src/Nixfmt/Predoc.hs | 178 ++++++++++++++++++++++--------------- src/Nixfmt/Pretty.hs | 2 +- test/diff/attr_set/in.nix | 7 ++ test/diff/attr_set/out.nix | 15 ++++ 4 files changed, 127 insertions(+), 75 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 1d08e07a..573b5dac 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -36,12 +36,14 @@ module Nixfmt.Predoc import Data.List (intersperse) import Data.Function ((&)) -import Data.Functor ((<&>)) +import Data.Functor ((<&>), ($>)) +import Data.Functor.Identity (runIdentity) import Data.Maybe (fromMaybe) import Data.Text as Text (Text, concat, length, replicate, strip) import GHC.Stack (HasCallStack) --- import Debug.Trace (traceShow) +-- import Debug.Trace (traceShow, traceShowId) import Control.Applicative ((<|>)) +import Control.Monad.Trans.State.Strict (State, StateT, StateT(..), mapStateT, state, runState, evalState, get, put) -- | Sequential Spacings are reduced to a single Spacing by taking the maximum. -- This means that e.g. a Space followed by an Emptyline results in just an @@ -77,10 +79,9 @@ data DocAnn -- pre, prio and post. -- If any group contains a priority group, the following happens: -- If it entirely fits on one line, render on one line (as usual). - -- If it does not fit on one line, but pre does, then only expand prio. + -- If it does not fit on one line, but pre and post do when prio is expanded, then try that. -- In all other cases, fully expand the group. -- Groups containing multiple priority groups are not supported at the moment. - -- Nesting further groups into post is not supported at the moment. = Group Bool -- | Node (Nest n) doc indicates all line starts in doc should be indented -- by n more spaces than the surrounding Base. @@ -225,20 +226,17 @@ isHardSpacing (Spacing Emptyline) = True isHardSpacing (Spacing (Newlines _)) = True isHardSpacing _ = False --- Manually force a group to its compact layout, by replacing all relevant whitespace. --- Does not recurse into inner groups (maybe it should though?) +--- Manually force a group to its compact layout, by replacing all relevant whitespace. +--- Does recurse into inner groups. unexpandSpacing :: Doc -> Doc unexpandSpacing [] = [] -unexpandSpacing ((Spacing s):xs) = maybe [] (pure . Spacing) (unexpandSpacing' s) ++ unexpandSpacing xs +unexpandSpacing ((Spacing Space):xs) = Spacing Hardspace : unexpandSpacing xs +unexpandSpacing ((Spacing Softspace):xs) = Spacing Hardspace : unexpandSpacing xs +unexpandSpacing ((Spacing Break):xs) = unexpandSpacing xs +unexpandSpacing ((Spacing Softbreak):xs) = unexpandSpacing xs +unexpandSpacing (s@(Spacing _):xs) = s : unexpandSpacing xs unexpandSpacing (x:xs) = x : unexpandSpacing xs -unexpandSpacing' :: Spacing -> Maybe Spacing -unexpandSpacing' Space = Just Hardspace -unexpandSpacing' Softspace = Just Hardspace -unexpandSpacing' Break = Nothing -unexpandSpacing' Softbreak = Nothing -unexpandSpacing' x = Just x - spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) spanEnd p = fmap reverse . span p . reverse @@ -398,65 +396,97 @@ unChunk (Chunk _ doc) = doc -- Only for the tokens starting on the next line the current -- indentation will match the target indentation. layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ go 0 0 [Chunk 0 $ Node (Group False) doc] - where go :: Int -> Int -> [Chunk] -> [Text] - go _ _ [] = [] - go cc ci (Chunk ti x : xs) = +layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) doc] []) (0, 0) + where + -- All state is (cc, ci) + + -- First argument: chunks to render + -- Second argument: lookahead of following chunks, not rendered + go :: [Chunk] -> [Chunk] -> State (Int, Int) [Text] + go [] _ = return [] + go (x:xs) ys = do { t <- goOne x (xs ++ ys); ts <- go xs ys; return (t ++ ts) } + + -- First argument: chunk to render. This will recurse into nests/groups if the chunk is one. + -- Second argument: lookahead of following chunks + goOne :: Chunk -> [Chunk] -> State (Int, Int) [Text] + goOne (Chunk ti x) xs = get >>= \(cc,ci) -> + let + needsIndent = (cc == 0) + -- next column, if we print some non-whitespace characters + nc = if needsIndent then ti else cc + -- Start of line indentation, if necessary + lineStart = if needsIndent then indent ti else "" + + -- Some state helpers + putCC cc' = put (cc', ci) + putNL = put (0, ti) + in + case x of + Text False t -> putCC (nc + textWidth t) $> [lineStart, t] + Text True t -> putCC (nc + textWidth t) $> [lineStart, t] + + -- This code treats whitespace as "expanded" + -- A new line resets the column counter and sets the target indentation as current indentation + Spacing Break -> putNL $> [newlines 1] + Spacing Space -> putNL $> [newlines 1] + Spacing Hardspace -> putCC (cc + 1) $> [" "] + Spacing Hardline -> putNL $> [newlines 1] + Spacing Emptyline -> putNL $> [newlines 2] + Spacing (Newlines n) -> putNL $> [newlines n] + + Spacing Softbreak + | firstLineFits (tw - nc + ci) (tw - ti) (map unChunk xs) + -> pure [] + | otherwise -> putNL $> [newlines 1] + + Spacing Softspace + | firstLineFits (tw - nc + ci - 1) (tw - ti) (map unChunk xs) + -> putCC (cc + 1) $> [" "] + | otherwise -> putNL $> [newlines 1] + + Node (Nest l) ys -> do { put (cc, (if needsIndent then ti + l else ci)); go (map (Chunk (ti + l)) ys) xs } + Node Base ys -> go (map (Chunk ci) ys) xs + Node (Group _) ys -> let - needsIndent = (cc == 0) - -- next column, if we print some non-whitespace characters - nc = if needsIndent then ti else cc - -- Start of line indentation, if necessary - lineStart = if needsIndent then indent ti else "" + xs' = map unChunk xs + + -- fromMaybe lifted to (StateT s Maybe) + fromMaybeState :: State s a -> StateT s Maybe a -> State s a + fromMaybeState l r = state $ \s -> fromMaybe (runState l s) (runStateT r s) in - case x of - Text False t -> lineStart : t : go (nc + textWidth t) ci xs - Text True t -> lineStart : t : go (nc + textWidth t) ci xs - - -- This code treats whitespace as "expanded" - -- A new line resets the column counter and sets the target indentation as current indentation - Spacing Break -> newlines 1 : go 0 ti xs - Spacing Space -> newlines 1 : go 0 ti xs - Spacing Hardspace -> " " : go (cc + 1) ci xs - Spacing Hardline -> newlines 1 : go 0 ti xs - Spacing Emptyline -> newlines 2 : go 0 ti xs - Spacing (Newlines n) -> newlines n : go 0 ti xs - - Spacing Softbreak - | firstLineFits (tw - nc + ci) (tw - ti) (map unChunk xs) - -> go cc ci xs - | otherwise -> newlines 1 : go 0 ti xs - - Spacing Softspace - | firstLineFits (tw - nc + ci - 1) (tw - ti) (map unChunk xs) - -> " " : go (cc + 1) ci xs - | otherwise -> newlines 1 : go 0 ti xs - - Node (Nest l) ys -> go cc (if needsIndent then ti + l else ci) $ map (Chunk (ti + l)) ys ++ xs - Node Base ys -> go cc ci $ map (Chunk ci) ys ++ xs - Node (Group _) ys -> - let - -- Does the group (plus whatever comes after it on that line) fit in one line? - -- This is where treating whitespace as "compact" happens - handleGroup :: Doc -> [Chunk] -> Maybe [Text] - handleGroup pre post = - if needsIndent then - let i = ti + firstLineIndent pre in - fits (tw - firstLineWidth (map unChunk post)) pre - <&> \t -> indent i : t : go (i + textWidth t) ci post - else - fits (tw - cc + ci - firstLineWidth (map unChunk post)) pre - <&> \t -> t : go (cc + textWidth t) ci post - in - -- Try to fit the entire group first - handleGroup ys xs - -- If that fails, check whether the group contains any priority groups as its children and try to expand them first - <|> do - -- Split up on the first priority group - -- Note that the pattern on prio is infallible as per isPriorityGroup - (pre, (Node (Group True) prio) : post) <- Just (break isPriorityGroup ys) - -- Try to fit pre onto one line (with prio expanded, and post manually unexpanded) - handleGroup pre $ map (Chunk ti) prio ++ map (Chunk ti) (unexpandSpacing post) ++ xs - -- Otherwise, dissolve the group by mapping its members to the target indentation - -- This also implies that whitespace in there will now be rendered "expanded" - & fromMaybe (go cc ci $ map (Chunk ti) ys ++ xs) + -- Try to fit the entire group first + goGroup ti ys xs' + -- If that fails, check whether the group contains a priority group within its children and try to expand that first + <|> do + -- Split up on the first priority group, if present + -- Note that the pattern on prio is infallible as per isPriorityGroup + (pre, (Node (Group True) prio) : post) <- pure $ (break isPriorityGroup ys) + -- Try to fit pre onto one line + preRendered <- goGroup ti pre (prio ++ post ++ xs') + -- Render prio expanded + -- We know that post will be rendered compact. So we tell the renderer that by manually removing all + -- line breaks in post here. Otherwise we might get into awkward the situation where pre and prio are put + -- onto the one line, all three obviously wouldn't fit. + prioRendered <- mapStateT (Just . runIdentity) $ + go (map (Chunk ti) prio) (map (Chunk ti) (unexpandSpacing post) ++ xs) + -- Try to render post onto one line + postRendered <- goGroup ti post xs' + -- If none of these failed, put together and return + return $ (preRendered ++ prioRendered ++ postRendered) + -- Otherwise, dissolve the group by mapping its members to the target indentation + -- This also implies that whitespace in there will now be rendered "expanded". + & fromMaybeState (go (map (Chunk ti) ys) xs) + + -- 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). + -- Any whitespace within the group is treated as "compact". + -- Return Nothing on failure, i.e. if the group would require a line break + goGroup :: Int -> Doc -> Doc -> StateT (Int, Int) Maybe [Text] + goGroup ti grp rest = StateT $ \(cc,ci) -> + if cc == 0 then + let i = ti + firstLineIndent grp in + fits (tw - firstLineWidth rest) grp + <&> \t -> ([indent i, t], (i + textWidth t, ci)) + else + fits (tw + (ci - cc) - firstLineWidth rest) grp + <&> \t -> ([t], (cc + textWidth t, ci)) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 07bf35e4..5e15d964 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -140,7 +140,7 @@ instance Pretty Binder where (Term _) -> group' False (line <> pretty expr) -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise - (Application f a) -> group $ prettyApp hardline line line' mempty f a + (Application f a) -> prettyApp hardline line line' mempty f a -- Absorb function declarations but only those with simple parameter(s) (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index df0a4fb4..0939297e 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -94,6 +94,13 @@ packages ]; } + { + systemd.initrdBi = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + systemd.initrdBin = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + systemd.initrdBin_ = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + systemd.initrdBin__ = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + systemd.initrdBin___ = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + } { patches = [ (substituteAll { diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index f24dd3b6..48af1912 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -143,6 +143,21 @@ packages ]; } + { + systemd.initrdBi = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + systemd.initrdBin = lib.mkIf config.boot.initrd.services.lvm.enable [ + pkgs.vdo + ]; + systemd.initrdBin_ = lib.mkIf config.boot.initrd.services.lvm.enable [ + pkgs.vdo + ]; + systemd.initrdBin__ = lib.mkIf config.boot.initrd.services.lvm.enable [ + pkgs.vdo + ]; + systemd.initrdBin___ = lib.mkIf config.boot.initrd.services.lvm.enable [ + pkgs.vdo + ]; + } { patches = [ (substituteAll { From c4bfa2c2383398411fa04ae7df095d489a6c08c9 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 9 Jul 2023 15:45:32 +0200 Subject: [PATCH 065/125] Rework `//` operator The existing special treatment of the entire operator got removed. Instead, it is mostly treated like any other operator, except for a handful of carefully picked special cases around binders. --- src/Nixfmt/Pretty.hs | 15 ++-- test/diff/attr_set/in.nix | 121 +++++++++++++++++++++++++ test/diff/attr_set/out.nix | 147 +++++++++++++++++++++++++++++++ test/diff/idioms_lib_4/out.nix | 3 +- test/diff/idioms_lib_5/out.nix | 12 ++- test/diff/idioms_nixos_1/out.nix | 7 +- test/diff/idioms_nixos_2/out.nix | 50 ++++++----- test/diff/monsters_5/out.nix | 11 +-- test/diff/paren/out.nix | 3 +- 9 files changed, 330 insertions(+), 39 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 5e15d964..b66f41ff 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -145,8 +145,16 @@ instance Pretty Binder where (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise (With _ _ _ (Term t)) | isAbsorbable t -> softline <> group' False (pretty expr <> softline') - -- Special case `//` operator to treat like an absorbable term - (Operation _ (Ann _ TUpdate _) _) -> softline <> group' False (pretty expr <> softline') + -- Special case `//` 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 [] TUpdate Nothing) b) | isAbsorbable t -> + group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b <> line' + -- Case 2a: LHS fits onto first line, RHS is an absorbable term + (Operation l (Ann [] TUpdate Nothing) (Term t)) | isAbsorbable t -> + group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) <> line' + -- Case 2b: LHS fits onto first line, RHS is a function application + (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> + line <> (group $ pretty l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) line' hardline 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) @@ -445,9 +453,6 @@ instance Pretty Expression where pretty (Application f a) = prettyApp mempty mempty mempty mempty f a - -- '//' operator - pretty (Operation a op@(Ann _ TUpdate _) b) - = pretty a <> softline <> pretty op <> hardspace <> pretty b -- binary operators pretty (Operation a op@(Ann _ op' _) b) | op' == TLess || op' == TGreater || op' == TLessEqual || op' == TGreaterEqual || op' == TEqual || op' == TUnequal diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index 0939297e..9b709688 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -109,4 +109,125 @@ }) ]; } + { + programs.ssh.knownHosts = + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + // { + foo = "bar"; + }; + programs.ssh.knownHosts2 = someStuff // + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + // { + foo = "bar"; + }; + programs.ssh.knownHosts3 = + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + // { + foo = "bar"; + }; + programs.ssh.knownHosts4 = someStuff // + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + // { + foo = "bar"; + }; + programs.ssh.knownHosts5 = someStuff // + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }); + programs.ssh.knownHosts6 = someStuff // + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts; + programs.ssh.knownHosts7 = someStuff # multiline + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }); + programs.ssh.knownHosts8 = someStuff # multiline + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts; + programs.ssh.knownHosts9 = + { multi = 1; line = 2; } + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }); + programs.ssh.knownHosts10 = + { multi = 1; line = 2; } + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts; + } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 48af1912..e7eee7fa 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -166,4 +166,151 @@ }) ]; } + { + programs.ssh.knownHosts = + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + // { + foo = "bar"; + } + ; + programs.ssh.knownHosts2 = + someStuff + // + lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + // { + foo = "bar"; + } + ; + programs.ssh.knownHosts3 = + lib.mapAttrs ( + host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + } + ) + // { + foo = "bar"; + } + ; + programs.ssh.knownHosts4 = + someStuff + // lib.mapAttrs ( + host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + } + ) + // { + foo = "bar"; + } + ; + programs.ssh.knownHosts5 = + someStuff + // lib.mapAttrs ( + host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + } + ); + programs.ssh.knownHosts6 = + someStuff + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + ; + programs.ssh.knownHosts7 = + someStuff # multiline + // lib.mapAttrs ( + host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + } + ); + programs.ssh.knownHosts8 = + someStuff # multiline + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + ; + programs.ssh.knownHosts9 = + { + multi = 1; + line = 2; + } + // lib.mapAttrs ( + host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + } + ) + ; + programs.ssh.knownHosts10 = + { + multi = 1; + line = 2; + } + // lib.mapAttrs + (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) + secret-config.ssh-hosts + ; + } ] diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index da6ad0a9..b1b08653 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -606,7 +606,8 @@ rec { execFormat = unknown; families = { }; }; - } // { + } + // { # aliases # 'darwin' is the kernel for all of them. We choose macOS by default. darwin = kernels.macos; diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 8779df1d..1fa9358c 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -475,7 +475,8 @@ let broken = isMarkedBroken attrs; unsupported = hasUnsupportedPlatform attrs; insecure = isMarkedInsecure attrs; - } // ( + } + // ( # --- Put checks that cannot be ignored here --- if checkOutputsToInstall attrs then { @@ -597,11 +598,13 @@ let ] ++ lib.optional (hasOutput "man") "man" ; - } // attrs.meta or { } + } + // attrs.meta or { } # Fill `meta.position` to identify the source location of the package. // lib.optionalAttrs (pos != null) { position = pos.file + ":" + toString pos.line; - } // { + } + // { # Expose the result of the checks for everyone to see. inherit (validity) unfree @@ -630,7 +633,8 @@ let let validity = checkValidity attrs; in - validity // { + validity + // { # Throw an error if trying to evaluate a non-valid derivation # or, alternatively, just output a warning message. handled = diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index b37ed3b4..bcc39b22 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -39,7 +39,9 @@ in boot.kernelPackages = mkOption { default = pkgs.linuxPackages; - type = types.unspecified // { merge = mergeEqualOption; }; + type = types.unspecified // { + merge = mergeEqualOption; + }; apply = kernelPackages: kernelPackages.extend ( @@ -94,7 +96,8 @@ in boot.kernelParams = mkOption { type = types.listOf ( - types.strMatching ''([^"[:space:]]|"[^"]*")+'' // { + types.strMatching ''([^"[:space:]]|"[^"]*")+'' + // { name = "kernelParam"; description = "string, with spaces inside double quotes"; } diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 267b2e5c..38f0d881 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -49,12 +49,14 @@ let mkKeyValue = generators.mkKeyValueDefault { } " = "; }; - phpOptions = { - upload_max_filesize = cfg.maxUploadSize; - post_max_size = cfg.maxUploadSize; - memory_limit = cfg.maxUploadSize; - } // cfg.phpOptions - // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; }; + phpOptions = + { + upload_max_filesize = cfg.maxUploadSize; + post_max_size = cfg.maxUploadSize; + memory_limit = cfg.maxUploadSize; + } + // cfg.phpOptions // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; } + ; occ = pkgs.writeScriptBin "nextcloud-occ" '' #! ${pkgs.runtimeShell} @@ -614,17 +616,20 @@ in }; }; - enableImagemagick = mkEnableOption ( - lib.mdDoc '' - the ImageMagick module for PHP. - This is used by the theming app and for generating previews of certain images (e.g. SVG and HEIF). - You may want to disable it for increased security. In that case, previews will still be available - for some images (e.g. JPEG and PNG). - See . - '' - ) // { - default = true; - }; + enableImagemagick = + mkEnableOption ( + lib.mdDoc '' + the ImageMagick module for PHP. + This is used by the theming app and for generating previews of certain images (e.g. SVG and HEIF). + You may want to disable it for increased security. In that case, previews will still be available + for some images (e.g. JPEG and PNG). + See . + '' + ) + // { + default = true; + } + ; caching = { apcu = mkOption { @@ -1140,10 +1145,13 @@ in NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; PATH = "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; }; - settings = mapAttrs (name: mkDefault) { - "listen.owner" = config.services.nginx.user; - "listen.group" = config.services.nginx.group; - } // cfg.poolSettings; + settings = + mapAttrs (name: mkDefault) { + "listen.owner" = config.services.nginx.user; + "listen.group" = config.services.nginx.group; + } + // cfg.poolSettings + ; extraConfig = cfg.poolConfig; }; }; diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index c105b678..3987bb48 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -128,14 +128,15 @@ in // - { + { - merge + merge - = + = - mergeEqualOption; - }; + mergeEqualOption; + } + ; apply diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 9ddbca23..ba7e2b0c 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -1,6 +1,7 @@ [ ( - done // listToAttrs [ { + done + // listToAttrs [ { # multline name = entry; value = 1; From 81d3cf8c62bbedb0904fd1739e3249ff869b5621 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 13 Jul 2023 18:05:59 +0200 Subject: [PATCH 066/125] Copy special cases over to `++` operator --- src/Nixfmt/Pretty.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index b66f41ff..6f92a6e3 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -155,6 +155,16 @@ instance Pretty Binder where -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> line <> (group $ pretty l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) line' hardline f a + -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> + group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b <> line' + -- Case 2a: LHS fits onto first line, RHS is an absorbable term + (Operation l (Ann [] TConcat Nothing) (Term t)) | isAbsorbable t -> + group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) <> line' + -- Case 2b: LHS fits onto first line, RHS is a function application + (Operation l (Ann [] TConcat Nothing) (Application f a)) -> + line <> (group $ pretty l) <> line <> prettyApp hardline (pretty TConcat <> hardspace) line' hardline 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) From cc5b42697fe8bd94821889c0751f3943fff86986 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 17 Jul 2023 14:34:52 +0200 Subject: [PATCH 067/125] Introduce support for optional trailing commas We want trailing commas, but only in expanded argument lists. This change allows us to do that. --- src/Nixfmt/Predoc.hs | 38 ++++++++++++++++++++++++-------------- src/Nixfmt/Pretty.hs | 26 +++++++++++++------------- 2 files changed, 37 insertions(+), 27 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 573b5dac..04b1a069 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -11,6 +11,7 @@ module Nixfmt.Predoc ( text , comment + , trailing , sepBy , surroundWith , hcat @@ -91,11 +92,15 @@ data DocAnn | Base deriving (Show, Eq) +-- Comments do not count towards some line length limits +-- Trailing tokens have the property that they will only exist in expanded groups, and "swallowed" in compact groups +data TextAnn = Regular | Comment | Trailing + deriving (Show, Eq) + -- | Single document element. Documents are modeled as lists of these elements -- in order to make concatenation simple. data DocE - -- Mark comments with a flag, to not count them to line length limits - = Text Bool Text + = Text TextAnn Text | Spacing Spacing | Node DocAnn Doc deriving (Show, Eq) @@ -126,11 +131,16 @@ instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where text :: Text -> Doc text "" = [] -text t = [Text False t] +text t = [Text Regular t] comment :: Text -> Doc comment "" = [] -comment t = [Text True t] +comment t = [Text Comment t] + +-- Text tokens that are only needed in expanded groups +trailing :: Text -> Doc +trailing "" = [] +trailing t = [Text Trailing t] -- | Group document elements together (see Node Group documentation) -- Must not contain non-hard whitespace (e.g. line, softline' etc.) at the start of the end. @@ -276,8 +286,8 @@ mergeSpacings _ y = y mergeLines :: Doc -> Doc mergeLines [] = [] mergeLines (Spacing a : Spacing b : xs) = mergeLines $ Spacing (mergeSpacings a b) : xs -mergeLines (Text isComment a : Text isComment' b : xs) | isComment == isComment' - = mergeLines $ Text isComment (a <> b) : xs +mergeLines (Text ann a : Text ann' b : xs) | ann == ann' + = mergeLines $ Text ann (a <> b) : xs mergeLines (Node ann xs : ys) = Node ann (mergeLines xs) : mergeLines ys mergeLines (x : xs) = x : mergeLines xs @@ -329,8 +339,9 @@ fits :: Int -> Doc -> Maybe Text fits c _ | c < 0 = Nothing fits _ [] = Just "" fits c (x:xs) = case x of - Text False t -> (t<>) <$> fits (c - textWidth t) xs - Text True t -> (t<>) <$> fits c xs + Text Regular t -> (t<>) <$> fits (c - textWidth t) xs + Text Comment t -> (t<>) <$> fits c xs + Text Trailing _ -> fits c xs Spacing Softbreak -> fits c xs Spacing Break -> fits c xs Spacing Softspace -> (" "<>) <$> fits (c - 1) xs @@ -345,8 +356,8 @@ fits c (x:xs) = case x of -- width 0, which always forces line breaks when possible. firstLineWidth :: Doc -> Int firstLineWidth [] = 0 -firstLineWidth (Text False t : xs) = textWidth t + firstLineWidth xs -firstLineWidth (Text True _ : xs) = firstLineWidth xs +firstLineWidth (Text Comment _ : xs) = firstLineWidth xs +firstLineWidth (Text _ t : xs) = textWidth t + firstLineWidth xs firstLineWidth (Spacing Hardspace : xs) = 1 + firstLineWidth xs firstLineWidth (Spacing _ : _) = 0 firstLineWidth (Node _ xs : ys) = firstLineWidth (xs ++ ys) @@ -357,8 +368,8 @@ firstLineFits :: Int -> Int -> Doc -> Bool firstLineFits targetWidth maxWidth docs = go maxWidth docs where go c _ | c < 0 = False go c [] = maxWidth - c <= targetWidth - go c (Text False t : xs) = go (c - textWidth t) xs - go c (Text True _ : xs) = go c xs + go c (Text Regular t : xs) = go (c - textWidth t) xs + go c (Text _ _ : xs) = go c xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth go c (Node (Group _) ys : xs) = @@ -422,8 +433,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) putNL = put (0, ti) in case x of - Text False t -> putCC (nc + textWidth t) $> [lineStart, t] - Text True t -> putCC (nc + textWidth t) $> [lineStart, t] + Text _ t -> putCC (nc + textWidth t) $> [lineStart, t] -- This code treats whitespace as "expanded" -- A new line resets the column counter and sets the target indentation as current indentation diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 6f92a6e3..6e3bcef7 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -19,7 +19,7 @@ import qualified Data.Text as Text -- import Debug.Trace (traceShowId) import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, textWidth) + nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailing, textWidth) import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), @@ -50,8 +50,8 @@ moveTrailingCommentUp a = a -- if the first argument has some leading comments they will be put before -- the group groupWithStart :: HasCallStack => Pretty a => Ann a -> Doc -> Doc -groupWithStart (Ann leading a trailing) b - = pretty leading <> group (pretty a <> pretty trailing <> b) +groupWithStart (Ann leading a trailing') b + = pretty leading <> group (pretty a <> pretty trailing' <> b) instance Pretty TrailingComment where pretty (TrailingComment c) @@ -88,14 +88,14 @@ instance Pretty [Trivium] where pretty trivia = hardline <> hcat trivia instance Pretty a => Pretty (Ann a) where - pretty (Ann leading x trailing) - = pretty leading <> pretty x <> pretty trailing + pretty (Ann leading x trailing') + = pretty leading <> pretty x <> pretty trailing' instance Pretty SimpleSelector where pretty (IDSelector i) = pretty i pretty (InterpolSelector interpol) = pretty interpol - pretty (StringSelector (Ann leading s trailing)) - = pretty leading <> prettySimpleString s <> pretty trailing + pretty (StringSelector (Ann leading s trailing')) + = pretty leading <> prettySimpleString s <> pretty trailing' instance Pretty Selector where pretty (Selector dot sel Nothing) @@ -207,8 +207,8 @@ prettyTerm (Selection term@(Parenthesized _ _ _) selectors) = pretty term <> sof prettyTerm (Selection term selectors) = pretty term <> line' <> hcat selectors -- Empty list -prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing)) - = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing +prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing')) + = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing' -- Singleton list -- Expand unless absorbable term or single line @@ -350,7 +350,7 @@ prettyApp commentPre pre post commentPost f a absorbLast arg = group' False $ nest 2 $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded - (fWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) f + (fWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing') -> (Ann [] token trailing', leading)) f in (if null comment' then mempty else commentPre) <> pretty comment' <> (group' False $ @@ -408,7 +408,7 @@ instance Pretty Expression where -- Let bindings are always fully expanded (no single-line form) -- We also take the comments around the `in` (trailing, leading and detached binder comments) -- and move them down to the first token of the body - pretty (Let let_ binders (Ann leading in_ trailing) expr) + pretty (Let let_ binders (Ann leading in_ trailing') expr) = base $ letPart <> hardline <> inPart where -- Convert the TrailingComment to a Trivium, if present @@ -433,7 +433,7 @@ instance Pretty Expression where letBody = nest 2 $ prettyItems hardline (Items bindersWithoutComments) inPart = groupWithStart (Ann [] in_ Nothing) $ hardline -- Take our trailing and inject it between `in` and body - <> pretty (concat binderComments ++ leading ++ convertTrailing trailing) + <> pretty (concat binderComments ++ leading ++ convertTrailing trailing') <> pretty expr <> hardline pretty (Assert assert cond semicolon expr) @@ -494,7 +494,7 @@ instance Pretty Expression where line <> pretty (moveTrailingCommentUp op') <> nest 2 (absorbOperation expr) -- Extract comment before the first operand and move it out, to prevent force-expanding the expression - (operationWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing) -> (Ann [] token trailing, leading)) operation + (operationWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing') -> (Ann [] token trailing', leading)) operation in pretty comment' <> (group $ (concat . map prettyOperation . (flatten Nothing)) operationWithoutComment) From 4468e9b2639e1ae2104daa80cbfbb52df7620f32 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 16 Jul 2023 12:37:44 +0200 Subject: [PATCH 068/125] Expand attrset function parameters less Keep up to two arguments compact, which benefits a lot of small functions operating on key-value pairs. --- src/Nixfmt/Pretty.hs | 71 +++++++++++++++++++++----------- test/diff/apply/out.nix | 4 +- test/diff/idioms_lib_2/out.nix | 4 +- test/diff/idioms_lib_3/out.nix | 9 +--- test/diff/idioms_lib_4/out.nix | 4 +- test/diff/idioms_lib_5/out.nix | 15 ++----- test/diff/idioms_nixos_2/out.nix | 13 +----- test/diff/key_value/out.nix | 8 +--- test/diff/lambda/out.nix | 21 ++-------- test/diff/pattern/out.nix | 44 +++----------------- 10 files changed, 68 insertions(+), 125 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 6e3bcef7..85bcbbf4 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -262,41 +262,46 @@ instance Pretty Term where pretty l@List{} = group $ prettyTerm l pretty x = prettyTerm x +-- Does not move around comments, nor does it inject a trailing comma instance Pretty ParamAttr where - -- Simple parameter, move comment around - -- Move comments around when switching from leading comma to trailing comma style: - -- `, name # foo` → `name, #foo` - pretty (ParamAttr (Ann trivia name (Just comment')) Nothing (Just (Ann trivia' comma Nothing))) - = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann trivia' comma (Just comment')))) - - -- Simple parameter, move comment around and add trailing comma - -- Same as above, but also add trailing comma - pretty (ParamAttr (Ann trivia name (Just comment')) Nothing Nothing) - = pretty (ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] TComma (Just comment')))) - - -- Simple parameter - -- Still need to handle missing trailing comma here, because the special cases above are not exhaustive + -- Simple parameter (no default) pretty (ParamAttr name Nothing maybeComma) - = pretty name <> (fromMaybe (text ",") (fmap pretty maybeComma)) + = pretty name <> pretty maybeComma -- With ? default pretty (ParamAttr name (Just (qmark, def)) maybeComma) = group (pretty name <> hardspace <> pretty qmark <> absorb softline mempty (Just 2) def) - <> (fromMaybe (text ",") (fmap pretty maybeComma)) + <> pretty maybeComma -- `...` pretty (ParamEllipsis ellipsis) = pretty ellipsis +-- Move comments around and inject trailing commas everywhere +moveParamAttrComment :: ParamAttr -> ParamAttr +-- Simple parameter, move comment around +-- Move comments around when switching from leading comma to trailing comma style: +-- `, name # foo` → `name, #foo` +moveParamAttrComment (ParamAttr (Ann trivia name (Just comment')) Nothing (Just (Ann trivia' comma Nothing))) + = ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann trivia' comma (Just comment'))) +-- Simple parameter, move comment around and add trailing comma +-- Same as above, but also add trailing comma +moveParamAttrComment (ParamAttr (Ann trivia name (Just comment')) Nothing Nothing) + = ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] TComma (Just comment'))) +-- Other cases, just inject a trailing comma +moveParamAttrComment (ParamAttr name def Nothing) + = ParamAttr name def (Just (Ann [] TComma Nothing)) +moveParamAttrComment x = x + -- When a `, name` entry has some line comments before it, they are actually attached to the comment -- of the preceding item. Move them to the next one -moveParamComments :: [ParamAttr] -> [ParamAttr] -moveParamComments +moveParamsComments :: [ParamAttr] -> [ParamAttr] +moveParamsComments ((ParamAttr name maybeDefault (Just (Ann trivia comma Nothing))) : (ParamAttr (Ann [] name' Nothing) maybeDefault' maybeComma') : xs) - = (ParamAttr name maybeDefault (Just (Ann [] comma Nothing))) : moveParamComments ((ParamAttr (Ann trivia name' Nothing) maybeDefault' maybeComma') : xs) -moveParamComments (x : xs) = x : moveParamComments xs -moveParamComments [] = [] + = (ParamAttr name maybeDefault (Just (Ann [] comma Nothing))) : moveParamsComments ((ParamAttr (Ann trivia name' Nothing) maybeDefault' maybeComma') : xs) +moveParamsComments (x : xs) = x : moveParamsComments xs +moveParamsComments [] = [] instance Pretty Parameter where -- param: @@ -307,10 +312,28 @@ instance Pretty Parameter where = group $ pretty bopen <> hardspace <> pretty bclose -- { stuff }: - pretty (SetParameter bopen attrs bclose) - = groupWithStart bopen $ hardline - <> nest 2 (((sepBy hardline) . moveParamComments) attrs) <> hardline - <> pretty bclose + pretty (SetParameter bopen attrs bclose) = + groupWithStart bopen $ + (surroundWith sep $ nest 2 (sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs)) + <> pretty bclose + where + -- pretty all ParamAttrs, but make the trailing comma of the last element specially + handleTrailingComma :: [ParamAttr] -> [Doc] + handleTrailingComma [] = [] + -- That's the case we're interested in + handleTrailingComma [(ParamAttr name maybeDefault (Just (Ann [] TComma Nothing)))] + = [pretty (ParamAttr name maybeDefault Nothing) <> trailing ","] + handleTrailingComma (x:xs) = pretty x : handleTrailingComma xs + + sep = case attrs of + [] -> line + [ParamEllipsis _] -> line + -- Attributes must be without default + [ParamAttr _ Nothing _] -> line + [ParamAttr _ Nothing _, ParamEllipsis _] -> line + [ParamAttr _ Nothing _, ParamAttr _ Nothing _] -> line + [ParamAttr _ Nothing _, ParamAttr _ Nothing _, ParamEllipsis _] -> line + _ -> hardline pretty (ContextParameter param1 at param2) = pretty param1 <> pretty at <> pretty param2 diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index ad8ea7cd..a5e18adb 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -187,9 +187,7 @@ # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { outputs = - { - utils, - }: + { utils }: # For each supported platform, utils.lib.eachDefaultSystem (system: { }) ; diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index c6f2ac4a..2ec1b7a9 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -1,6 +1,4 @@ -{ - lib, -}: +{ lib }: rec { diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index f724b01c..d1e77fba 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -12,9 +12,7 @@ # # Tests can be found in ./tests/misc.nix # Documentation in the manual, #sec-generators -{ - lib, -}: +{ lib }: with (lib).trivial; let libStr = lib.strings; @@ -216,10 +214,7 @@ rec { # allow lists as values for duplicate keys listsAsDuplicateKeys ? false, }: - { - globalSection, - sections, - }: + { globalSection, sections }: ( if globalSection == { } then "" diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index b1b08653..fcdf59ff 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -14,9 +14,7 @@ # e.g. exhaustive cases. Its more a sanity check to make sure nobody defines # systems that overlap with existing ones and won't notice something amiss. # -{ - lib, -}: +{ lib }: with lib.lists; with lib.types; with lib.attrsets; diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 1fa9358c..a5e9ece1 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -276,10 +276,7 @@ let ; handleEvalIssue = - { - meta, - attrs, - }: + { meta, attrs }: { reason, errormsg ? "", @@ -303,10 +300,7 @@ let ; handleEvalWarning = - { - meta, - attrs, - }: + { meta, attrs }: { reason, errormsg ? "", @@ -626,10 +620,7 @@ let ; assertValidity = - { - meta, - attrs, - }: + { meta, attrs }: let validity = checkValidity attrs; in diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 38f0d881..cb1cd615 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -17,10 +17,7 @@ let phpPackage = cfg.phpPackage.buildEnv { extensions = - { - enabled, - all, - }: + { enabled, all }: ( with all; # disable default openssl extension @@ -995,13 +992,7 @@ in ''; occInstallCmd = let - mkExport = - { - arg, - value, - }: - "export ${arg}=${value}" - ; + mkExport = { arg, value }: "export ${arg}=${value}"; dbpass = { arg = "DBPASS"; value = diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 0cfd6c10..a3868e02 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -56,13 +56,7 @@ rec { c = 2; }; n = pkgs: { }; - o = - { - pkgs, - ... - }: - { } - ; + o = { pkgs, ... }: { }; a # b diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index fc225e76..99cf3f10 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -45,20 +45,14 @@ ) ( - { - pkgs, - ... - }: + { pkgs, ... }: { # Stuff } ) ( - { - pkgs, - ... - }: + { pkgs, ... }: let in pkgs @@ -66,10 +60,7 @@ ( a: - { - b, - ... - }: + { b, ... }: c: { # Stuff } @@ -77,11 +68,7 @@ ( a: - { - b, - c, - ... - }: + { b, c, ... }: d: { # Stuff } diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 352af4af..8eec87ef 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -62,46 +62,14 @@ _ ) ({ }: _) - ( - { - a, - }: - _ - ) + ({ a }: _) ({ }: _) - ( - { - ... - }: - _ - ) - ( - { - ... - }: - _ - ) - ( - { - ... - }: - _ - ) - ( - { - ... - }: - _ - ) + ({ ... }: _) + ({ ... }: _) + ({ ... }: _) + ({ ... }: _) - ( - { - b, - e, - ... - }: - _ - ) + ({ b, e, ... }: _) ( { b, From 9ac66a9fbe76044e63038b29f31292bc5a5a3748 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 18 Jul 2023 16:28:35 +0200 Subject: [PATCH 069/125] Rework renderer again It is now even more powerful, although there is still a bit of room for improvement in the future. In short, it defers merging spacing across group boundaries, allowing groups to start/end with spacing even if the previous/next token is a whitespace too. Previously, they would get merged, causing weird results. - Removed mergeSpacings', as it is not needed anymore - Merged moveLinesOut and mergeSpacings into a single pass "fixup" - layoutGreedy can now handle some consecutive spacings across group boundaries - It still does not handle all cases, only the ones needed for the current features. More will be added as needed. --- src/Nixfmt/Predoc.hs | 177 +++++++++++++++++++++---------------------- 1 file changed, 87 insertions(+), 90 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 04b1a069..ca91bac6 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -110,12 +110,6 @@ type Doc = [DocE] class Pretty a where pretty :: a -> Doc ---instance Pretty Text where --- pretty = pure . (Text False) - ---instance Pretty String where --- pretty = pure . (Text False) . pack - instance Pretty Doc where pretty = id @@ -250,25 +244,43 @@ unexpandSpacing (x:xs) = x : unexpandSpacing xs spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) spanEnd p = fmap reverse . span p . reverse --- | Fix up a Doc in multiple stages: --- - First, some spacings are moved out of Groups and Nests and empty Groups and --- Nests are removed. --- - Merge consecutive spacings. When merging across group/nest boundaries, the merged --- spacing will be on the "inside" (part of the group). --- - This may move hard spacing in, so we need to move them out again +-- | Fix up a Doc: +-- - Move some spacings (those which are not relevant for group calculations) +-- out of the start/end of Groups and Nests if possible. +-- This is especially important because it moves out hardlines from comments out of groups, +-- which would otherwise wrongly cause them to expand. +-- - Merge consecutive spacings. +-- - Spacings are not merged across Group or Nest boundaries, although this may happen for those +-- spacings that are moved. +-- - Remove empty Groups and Nests +-- After running, any nodes are guaranteed to start/end with at most one whitespace element respectively. fixup :: Doc -> Doc -fixup = concatMap moveLinesOut . mergeLines' . mergeLines . concatMap moveLinesOut - -moveLinesOut :: DocE -> Doc -moveLinesOut (Node ann xs) = - let movedOut = concatMap moveLinesOut xs - (pre, rest) = span isHardSpacing movedOut +fixup [] = [] +-- Merge consecutive spacings +fixup (Spacing a : Spacing b : xs) = fixup $ Spacing (mergeSpacings a b) : xs +-- Merge consecutive texts +fixup (Text ann a : Text ann' b : xs) | ann == ann' = fixup $ Text ann (a <> b) : xs +-- Handle node, with leading spacing to potentially merge with +fixup (Spacing a : Node ann xs : ys) = + let + -- Recurse onto xs, split out leading and trailing whitespace into pre and post. + (pre, rest) = span isHardSpacing $ fixup xs (post, body) = spanEnd isHardSpacing rest - in case body of - [] -> pre ++ post - _ -> pre ++ (Node ann body : post) - -moveLinesOut x = [x] + in if null body then + -- Dissolve empty node + fixup $ (Spacing a : pre) ++ post ++ ys + else + fixup (Spacing a : pre) ++ [Node ann body] ++ fixup (post ++ ys) +-- Handle node, almost the same thing +fixup (Node ann xs : ys) = + let + (pre, rest) = span isHardSpacing $ fixup xs + (post, body) = spanEnd isHardSpacing rest + in if null body then + fixup $ pre ++ post ++ ys + else + fixup pre ++ [Node ann body] ++ fixup (post ++ ys) +fixup (x : xs) = x : fixup xs mergeSpacings :: Spacing -> Spacing -> Spacing mergeSpacings x y | x > y = mergeSpacings y x @@ -281,42 +293,6 @@ mergeSpacings Hardspace (Newlines x) = Newlines x mergeSpacings _ (Newlines x) = Newlines (x + 1) mergeSpacings _ y = y --- Merge whitespace and text elements across the document, but not across Node boundaries. --- After running, any nodes are guaranteed to start/end with at most one whitespace element respectively. -mergeLines :: Doc -> Doc -mergeLines [] = [] -mergeLines (Spacing a : Spacing b : xs) = mergeLines $ Spacing (mergeSpacings a b) : xs -mergeLines (Text ann a : Text ann' b : xs) | ann == ann' - = mergeLines $ Text ann (a <> b) : xs -mergeLines (Node ann xs : ys) = Node ann (mergeLines xs) : mergeLines ys -mergeLines (x : xs) = x : mergeLines xs - -startsWithWhitespace :: Doc -> Bool -startsWithWhitespace (s : _) | isSoftSpacing s = True -startsWithWhitespace ((Node _ inner) : _) = startsWithWhitespace inner -startsWithWhitespace _ = False - -endsWithWhitespace :: Doc -> Bool -endsWithWhitespace (s : []) | isSoftSpacing s = True -endsWithWhitespace ((Node _ inner) : []) = endsWithWhitespace inner -endsWithWhitespace (_ : xs) = endsWithWhitespace xs -endsWithWhitespace _ = False - --- Merge whitespace across group borders -mergeLines' :: Doc -> Doc -mergeLines' [] = [] --- Merge things that got moved together -mergeLines' (Spacing a : Spacing b : xs) = mergeLines' $ Spacing (mergeSpacings a b) : xs --- Move spacing in front of groups in if they can be merged -mergeLines' (Spacing a : Node ann (xs) : ys) | startsWithWhitespace xs = - mergeLines' $ Node ann (Spacing a : xs) : ys --- Merge spacings after groups in if they can be merged -mergeLines' (Node ann xs : Spacing a : ys) | endsWithWhitespace xs = - mergeLines' $ Node ann (xs ++ [Spacing a]) : ys -mergeLines' (Node ann xs : ys) = - Node ann (mergeLines' xs) : mergeLines' ys -mergeLines' (x : xs) = x : mergeLines' xs - layout :: Pretty a => Int -> a -> Text layout w = (<>"\n") . Text.strip . layoutGreedy w . fixup . pretty @@ -338,6 +314,9 @@ textWidth = Text.length fits :: Int -> Doc -> Maybe Text fits c _ | c < 0 = Nothing fits _ [] = Just "" +-- This case is impossible in the input thanks to fixup, but may happen +-- due to our recursion on nodes below +fits c (Spacing a:Spacing b:xs) = fits c (Spacing (mergeSpacings a b):xs) fits c (x:xs) = case x of Text Regular t -> (t<>) <$> fits (c - textWidth t) xs Text Comment t -> (t<>) <$> fits c xs @@ -358,9 +337,12 @@ firstLineWidth :: Doc -> Int firstLineWidth [] = 0 firstLineWidth (Text Comment _ : xs) = firstLineWidth xs firstLineWidth (Text _ t : xs) = textWidth t + firstLineWidth xs +-- This case is impossible in the input thanks to fixup, but may happen +-- due to our recursion on nodes below +firstLineWidth (Spacing a : Spacing b : xs) = firstLineWidth (Spacing (mergeSpacings a b):xs) firstLineWidth (Spacing Hardspace : xs) = 1 + firstLineWidth xs firstLineWidth (Spacing _ : _) = 0 -firstLineWidth (Node _ xs : ys) = firstLineWidth (xs ++ ys) +firstLineWidth (Node _ xs : ys) = firstLineWidth $ xs ++ ys -- | Check if the first line in a document fits a target width given -- a maximum width, without breaking up groups. @@ -370,6 +352,9 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs go c [] = maxWidth - c <= targetWidth go c (Text Regular t : xs) = go (c - textWidth t) 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 nodes below + go c (Spacing a : Spacing b : xs) = go c $ Spacing (mergeSpacings a b) : xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth go c (Node (Group _) ys : xs) = @@ -420,46 +405,48 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) -- First argument: chunk to render. This will recurse into nests/groups if the chunk is one. -- Second argument: lookahead of following chunks goOne :: Chunk -> [Chunk] -> State (Int, Int) [Text] - goOne (Chunk ti x) xs = get >>= \(cc,ci) -> + goOne (Chunk ti x) xs = get >>= \(cc, ci) -> let + xs' = map unChunk xs + + -- The last printed character was a line break needsIndent = (cc == 0) - -- next column, if we print some non-whitespace characters - nc = if needsIndent then ti else cc -- Start of line indentation, if necessary lineStart = if needsIndent then indent ti else "" -- Some state helpers - putCC cc' = put (cc', ci) + putText ts = put (cc + sum (map textWidth ts), ci) $> ts putNL = put (0, ti) - in - case x of - Text _ t -> putCC (nc + textWidth t) $> [lineStart, t] + in case x of + Text _ t -> putText [lineStart, t] -- This code treats whitespace as "expanded" -- A new line resets the column counter and sets the target indentation as current indentation - Spacing Break -> putNL $> [newlines 1] - Spacing Space -> putNL $> [newlines 1] - Spacing Hardspace -> putCC (cc + 1) $> [" "] - Spacing Hardline -> putNL $> [newlines 1] - Spacing Emptyline -> putNL $> [newlines 2] - Spacing (Newlines n) -> putNL $> [newlines n] - - Spacing Softbreak - | firstLineFits (tw - nc + ci) (tw - ti) (map unChunk xs) - -> pure [] - | otherwise -> putNL $> [newlines 1] - - Spacing Softspace - | firstLineFits (tw - nc + ci - 1) (tw - ti) (map unChunk xs) - -> putCC (cc + 1) $> [" "] - | otherwise -> putNL $> [newlines 1] - - Node (Nest l) ys -> do { put (cc, (if needsIndent then ti + l else ci)); go (map (Chunk (ti + l)) ys) xs } + Spacing sp -> + -- We know that the last printed character was a line break (cc == 0), + -- therefore drop any leading whitespace within the group to avoid duplicate newlines + if needsIndent then + pure [] + else case sp of + Break -> putNL $> [newlines 1] + Space -> putNL $> [newlines 1] + Hardspace -> putText [" "] + Hardline -> putNL $> [newlines 1] + Emptyline -> putNL $> [newlines 2] + (Newlines n) -> putNL $> [newlines n] + Softbreak + | firstLineFits (tw - cc + ci) (tw - ti) xs' + -> pure [] + | otherwise -> putNL $> [newlines 1] + Softspace + | firstLineFits (tw - cc + ci - 1) (tw - ti) xs' + -> putText [" "] + | otherwise -> putNL $> [newlines 1] + + Node (Nest l) ys -> put (cc, if cc == 0 then ti + l else ci) >> go (map (Chunk (ti + l)) ys) xs Node Base ys -> go (map (Chunk ci) ys) xs Node (Group _) ys -> let - xs' = map unChunk xs - -- fromMaybe lifted to (StateT s Maybe) fromMaybeState :: State s a -> StateT s Maybe a -> State s a fromMaybeState l r = state $ \s -> fromMaybe (runState l s) (runStateT r s) @@ -492,10 +479,20 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) -- Any whitespace within the group is treated as "compact". -- Return Nothing on failure, i.e. if the group would require a line break goGroup :: Int -> Doc -> Doc -> StateT (Int, Int) Maybe [Text] - goGroup ti grp rest = StateT $ \(cc,ci) -> + -- In general groups are never empty as empty groups are removed in `fixup`, however this also + -- gets called for pre and post of priority groups, which may be empty. + goGroup _ [] _ = pure [] + goGroup ti grp rest = StateT $ \(cc, ci) -> if cc == 0 then - let i = ti + firstLineIndent grp in - fits (tw - firstLineWidth rest) grp + let + -- We know that the last printed character was a line break (cc == 0), + -- therefore drop any leading whitespace within the group to avoid duplicate newlines + grp' = case head grp of + Spacing _ -> tail grp + _ -> grp + i = ti + firstLineIndent grp' + in + fits (tw - firstLineWidth rest) grp' <&> \t -> ([indent i, t], (i + textWidth t, ci)) else fits (tw + (ci - cc) - firstLineWidth rest) grp From a93dcf7e9e19b4308d6cdb50da829839bf88817a Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 17 Jul 2023 15:09:05 +0200 Subject: [PATCH 070/125] Binders: be more selective about semicolon placement Only place the semicolon onto a new line if the last expression of the body is an if statement or an operator chain. --- src/Nixfmt/Pretty.hs | 33 +++++++++++++---------- test/diff/apply/out.nix | 33 ++++++++--------------- test/diff/attr_set/out.nix | 21 +++++---------- test/diff/idioms_lib_1/out.nix | 3 +-- test/diff/idioms_lib_2/out.nix | 35 ++++++++++--------------- test/diff/idioms_lib_3/out.nix | 45 +++++++++++--------------------- test/diff/idioms_lib_4/out.nix | 27 +++++++------------ test/diff/idioms_lib_5/out.nix | 42 ++++++++++------------------- test/diff/idioms_nixos_1/out.nix | 12 +++------ test/diff/idioms_nixos_2/out.nix | 27 +++++++------------ test/diff/idioms_pkgs_2/out.nix | 3 +-- test/diff/idioms_pkgs_3/out.nix | 3 ++- test/diff/idioms_pkgs_4/out.nix | 9 +++---- test/diff/let_in/out.nix | 30 +++++++-------------- test/diff/monsters_1/out.nix | 6 ++--- test/diff/monsters_4/out.nix | 9 +++---- test/diff/monsters_5/out.nix | 36 +++++++++---------------- test/diff/with/out.nix | 6 ++--- 18 files changed, 139 insertions(+), 241 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 85bcbbf4..f11c3f82 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -126,7 +126,7 @@ instance Pretty Binder where = base $ group $ hcat selectors <> nest 2 (hardspace <> pretty assign <> inner) <> pretty semicolon where - inner = + inner = case expr of -- Absorbable term. Always start on the same line, keep semicolon attatched (Term t) | isAbsorbable t -> hardspace <> prettyTermWide t @@ -140,36 +140,36 @@ instance Pretty Binder where (Term _) -> group' False (line <> pretty expr) -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise - (Application f a) -> prettyApp hardline line line' mempty f a + (Application f a) -> prettyApp hardline line mempty mempty f a -- Absorb function declarations but only those with simple parameter(s) (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise - (With _ _ _ (Term t)) | isAbsorbable t -> softline <> group' False (pretty expr <> softline') + (With _ _ _ (Term t)) | isAbsorbable t -> softline <> group expr -- Special case `//` 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 [] TUpdate Nothing) b) | isAbsorbable t -> - group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b <> line' + group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b -- Case 2a: LHS fits onto first line, RHS is an absorbable term (Operation l (Ann [] TUpdate Nothing) (Term t)) | isAbsorbable t -> - group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) <> line' + group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> - line <> (group $ pretty l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) line' hardline f a + line <> (group l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) mempty hardline f a -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> - group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b <> line' + group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b -- Case 2a: LHS fits onto first line, RHS is an absorbable term (Operation l (Ann [] TConcat Nothing) (Term t)) | isAbsorbable t -> - group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) <> line' + group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TConcat Nothing) (Application f a)) -> - line <> (group $ pretty l) <> line <> prettyApp hardline (pretty TConcat <> hardspace) line' hardline f a + line <> (group l) <> line <> prettyApp hardline (pretty TConcat <> hardspace) mempty hardline 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) -- Otherwise, start on new line, expand fully (including the semicolon) - _ -> line <> group' False (pretty expr <> line') + _ -> line <> group expr -- Pretty a set -- while we already pretty eagerly expand sets with more than one element, @@ -457,7 +457,7 @@ instance Pretty Expression where inPart = groupWithStart (Ann [] in_ Nothing) $ hardline -- Take our trailing and inject it between `in` and body <> pretty (concat binderComments ++ leading ++ convertTrailing trailing') - <> pretty expr <> hardline + <> pretty expr pretty (Assert assert cond semicolon expr) = base (pretty assert <> hardspace @@ -465,11 +465,16 @@ instance Pretty Expression where <> absorbSet expr pretty (If if_ cond then_ expr0 else_ expr1) - = base $ group $ + = base $ group' False $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) groupWithStart if_ (line <> nest 2 (pretty cond) <> line <> pretty then_) <> (surroundWith line $ nest 2 $ group expr0) <> pretty else_ <> absorbElse expr1 + -- This trailing line' is a bit of a hack. It makes sure that the semicolon in binders gets placed onto + -- a new line if the items ends with a (multiline) if. + -- Normally this should only be the case when in binders as this might interfere with other syntax constructs, + -- but because our style always puts a new line after multiline Ifs it turns out to work just fine ^^ + <> line' pretty (Abstraction (IDParameter param) colon body) = pretty param <> pretty colon <> absorbAbs 1 body @@ -519,8 +524,8 @@ instance Pretty Expression where -- Extract comment before the first operand and move it out, to prevent force-expanding the expression (operationWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing') -> (Ann [] token trailing', leading)) operation in - pretty comment' <> (group $ - (concat . map prettyOperation . (flatten Nothing)) operationWithoutComment) + pretty comment' <> (group' False $ + ((concat . map prettyOperation . (flatten Nothing)) operationWithoutComment) <> line') pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index a5e18adb..b8788974 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -133,8 +133,7 @@ asdf = 1; # multiline } - argument - ; + argument; name3 = function arg @@ -143,8 +142,7 @@ # multiline } { qwer = 12345; } - argument - ; + argument; } { name4 = @@ -153,8 +151,7 @@ qwer = 12345; qwer2 = 54321; } - argument - ; + argument; } { option1 = @@ -163,8 +160,7 @@ qwer = 12345; qwer2 = 54321; } - lastArg - ; + lastArg; option2 = function arg { asdf = 1; } @@ -172,8 +168,7 @@ qwer = 12345; qwer2 = 54321; } - lastArg - ; + lastArg; option3 = function arg { asdf = 1; } @@ -181,16 +176,14 @@ qwer = 12345; qwer2 = 54321; } - lastArg - ; + lastArg; } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { outputs = { utils }: # For each supported platform, - utils.lib.eachDefaultSystem (system: { }) - ; + utils.lib.eachDefaultSystem (system: { }); } { escapeSingleline = libStr.escape [ @@ -207,8 +200,7 @@ [ "''\${" "'''" - ] - ; + ]; test = foo [ @@ -224,8 +216,7 @@ 1 2 3 # multiline - ] - ; + ]; looooooooong = (toINI { @@ -248,8 +239,7 @@ aaaaaaaa ; } - sections - ; + sections; } # Test breakup behavior at different line lengths @@ -347,7 +337,6 @@ (lib.take 3) # Quote all entries (map (x: ''"'' + x + ''"'')) - ] - ; + ]; } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index e7eee7fa..ea7022bd 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -117,8 +117,7 @@ [ # several items - ] - ; + ]; a = [ some @@ -180,8 +179,7 @@ secret-config.ssh-hosts // { foo = "bar"; - } - ; + }; programs.ssh.knownHosts2 = someStuff // @@ -212,8 +210,7 @@ ) // { foo = "bar"; - } - ; + }; programs.ssh.knownHosts4 = someStuff // lib.mapAttrs ( @@ -253,8 +250,7 @@ "${host_name}.lo.m-0.eu" ]; }) - secret-config.ssh-hosts - ; + secret-config.ssh-hosts; programs.ssh.knownHosts7 = someStuff # multiline // lib.mapAttrs ( @@ -278,8 +274,7 @@ "${host_name}.lo.m-0.eu" ]; }) - secret-config.ssh-hosts - ; + secret-config.ssh-hosts; programs.ssh.knownHosts9 = { multi = 1; @@ -294,8 +289,7 @@ "${host_name}.lo.m-0.eu" ]; } - ) - ; + ); programs.ssh.knownHosts10 = { multi = 1; @@ -310,7 +304,6 @@ "${host_name}.lo.m-0.eu" ]; }) - secret-config.ssh-hosts - ; + secret-config.ssh-hosts; } ] diff --git a/test/diff/idioms_lib_1/out.nix b/test/diff/idioms_lib_1/out.nix index c1013cf2..3c4520d9 100644 --- a/test/diff/idioms_lib_1/out.nix +++ b/test/diff/idioms_lib_1/out.nix @@ -6,6 +6,5 @@ msg: # Value to return x: - if pred then trace msg x else x - ; + if pred then trace msg x else x; } diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 2ec1b7a9..b3307ded 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -12,8 +12,7 @@ rec { id = # The value to return x: - x - ; + x; /* The constant function @@ -30,8 +29,7 @@ rec { x: # Value to ignore y: - x - ; + x; /* Pipes a value through a list of functions, left to right. @@ -67,8 +65,7 @@ rec { let reverseApply = x: f: f x; in - builtins.foldl' reverseApply val functions - ; + builtins.foldl' reverseApply val functions; # note please don’t add a function like `compose = flip pipe`. # This would confuse users, because the order of the functions @@ -133,8 +130,7 @@ rec { x: # Right attribute set (higher precedence for equal keys) y: - x // y - ; + x // y; /* Flip the order of the arguments of a binary function. @@ -146,8 +142,7 @@ rec { */ flip = f: a: b: - f b a - ; + f b a; /* Apply function if the supplied argument is non-null. @@ -162,8 +157,7 @@ rec { f: # Argument to check for null before passing it to `f` a: - if a == null then a else f a - ; + if a == null then a else f a; # Pull in some builtins not included elsewhere. inherit (builtins) @@ -200,7 +194,10 @@ rec { let suffixFile = ../.version-suffix; in - if pathExists suffixFile then lib.strings.fileContents suffixFile else "pre-git" + if pathExists suffixFile then + lib.strings.fileContents suffixFile + else + "pre-git" ; /* Attempts to return the the current revision of nixpkgs and @@ -225,8 +222,7 @@ rec { nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" - version - ; + version; /* Determine whether the function is being called from inside a Nix shell. @@ -406,8 +402,7 @@ rec { builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) } unexpected; valid ones: ${ builtins.concatStringsSep ", " (builtins.map builtins.toString valid) - }" - ; + }"; info = msg: builtins.trace "INFO: ${msg}"; @@ -479,8 +474,7 @@ rec { .${toString d} ; in - lib.concatMapStrings toHexDigit (toBaseDigits 16 i) - ; + lib.concatMapStrings toHexDigit (toBaseDigits 16 i); /* `toBaseDigits base i` converts the positive integer i to a list of its digits in the given base. For example: @@ -508,6 +502,5 @@ rec { in assert (base >= 2); assert (i >= 0); - lib.reverseList (go i) - ; + lib.reverseList (go i); } diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index d1e77fba..cef667ca 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -36,8 +36,7 @@ rec { t: v: abort ( "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}" - ) - ; + ); in if isInt v then toString v @@ -86,8 +85,7 @@ rec { mkValueString ? mkValueStringDefault { }, }: sep: k: v: - "${libStr.escape [ sep ] k}${sep}${mkValueString v}" - ; + "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; ## -- FILE FORMAT GENERATORS -- @@ -109,8 +107,7 @@ rec { ; in attrs: - libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)) - ; + libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); # Generate an INI-style config file from an # attrset of sections to an attrset of key-value pairs. @@ -153,8 +150,7 @@ rec { # map function to string for each key val mapAttrsToStringsSep = sep: mapFn: attrs: - libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs) - ; + libStr.concatStringsSep sep (libAttr.mapAttrsToList mapFn attrs); mkSection = sectName: sectValues: '' @@ -164,8 +160,7 @@ rec { ; in # map input to ini sections - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ; + mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; # Generate an INI-style config file from an attrset # specifying the global section (no header), and an @@ -266,8 +261,7 @@ rec { let mkKeyValue = mkKeyValueDefault { } " = " k; in - concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)) - ; + concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)); # converts { a.b.c = 5; } to { "a.b".c = 5; } for toINI gitFlattenAttrs = @@ -283,13 +277,11 @@ rec { ; in attrs: - lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)) - ; + lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); toINI_ = toINI { inherit mkKeyValue mkSectionName; }; in - toINI_ (gitFlattenAttrs attrs) - ; + toINI_ (gitFlattenAttrs attrs); # Generates JSON from an arbitrary (non-function) value. # For more information see the documentation of the builtin. @@ -345,8 +337,7 @@ rec { transform (depth + 1) v ; in - mapAny 0 - ; + mapAny 0; # Pretty print a value, akin to `builtins.trace`. # Should probably be a builtin as well. @@ -412,8 +403,7 @@ rec { [ "''\${" "'''" - ] - ; + ]; singlelineResult = ''"'' + concatStringsSep "\\n" (map escapeSingleline lines) + ''"''; multilineResult = @@ -486,8 +476,7 @@ rec { abort "generators.toPretty: should never happen (v = ${v})" ; in - go indent - ; + go indent; # PLIST handling toPlist = @@ -534,8 +523,7 @@ rec { (literal ind "") (item ind x) (literal ind "") - ] - ; + ]; attrs = ind: x: @@ -543,8 +531,7 @@ rec { (literal ind "") (attr ind x) (literal ind "") - ] - ; + ]; attr = let @@ -563,16 +550,14 @@ rec { ) x ) - ) - ; + ); in '' ${expr "" v} - '' - ; + ''; # Translate a simple Nix expression to Dhall notation. # Note that integers are translated to Integer and never diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index fcdf59ff..b3117bf9 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -30,8 +30,7 @@ let name: value: assert type.check value; setType type.name ({ inherit name; } // value) - ) - ; + ); in rec { @@ -359,8 +358,7 @@ rec { significantByte = littleEndian; family = "javascript"; }; - } - ; + }; # GNU build systems assume that older NetBSD architectures are using a.out. gnuNetBSDDefaultExecFormat = @@ -444,8 +442,7 @@ rec { # identity (b == a) - ] - ; + ]; ################################################################################ @@ -742,8 +739,7 @@ rec { mkSystem = components: assert types.parsedPlatform.check components; - setType "system" components - ; + setType "system" components; mkSkeletonFromList = l: @@ -839,9 +835,9 @@ rec { abi = elemAt l 3; }; } - .${toString (length l)} - or (throw "system string has invalid number of hyphen-separated components") - ; + .${toString (length l)} or (throw + "system string has invalid number of hyphen-separated components" + ); # This should revert the job done by config.guess from the gcc compiler. mkSystemFromSkeleton = @@ -901,8 +897,7 @@ rec { ; }; in - mkSystem parsed - ; + mkSystem parsed; mkSystemFromString = s: mkSystemFromSkeleton (mkSkeletonFromList (lib.splitString "-" s)); @@ -937,12 +932,10 @@ rec { optExecFormat = lib.optionalString (kernel.name == "netbsd" && gnuNetBSDDefaultExecFormat cpu != kernel.execFormat) - kernel.execFormat.name - ; + kernel.execFormat.name; optAbi = lib.optionalString (abi != abis.unknown) "-${abi.name}"; in - "${cpu.name}-${vendor.name}-${kernelName kernel}${optExecFormat}${optAbi}" - ; + "${cpu.name}-${vendor.name}-${kernelName kernel}${optExecFormat}${optAbi}"; ################################################################################ } diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index a5e9ece1..62189229 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -19,8 +19,7 @@ let attrs: attrs.name or ( "${attrs.pname or "«name-missing»"}-${attrs.version or "«version-missing»"}" - ) - ; + ); allowUnfree = config.allowUnfree || builtins.getEnv "NIXPKGS_ALLOW_UNFREE" == "1"; @@ -29,8 +28,7 @@ let let envVar = builtins.getEnv "NIXPKGS_ALLOW_NONSOURCE"; in - if envVar != "" then envVar != "0" else config.allowNonSource or true - ; + if envVar != "" then envVar != "0" else config.allowNonSource or true; allowlist = config.allowlistedLicenses or config.whitelistedLicenses or [ ]; blocklist = config.blocklistedLicenses or config.blacklistedLicenses or [ ]; @@ -115,8 +113,7 @@ let hasNonSourceProvenance = attrs: - (attrs ? meta.sourceProvenance) && isNonSource attrs.meta.sourceProvenance - ; + (attrs ? meta.sourceProvenance) && isNonSource attrs.meta.sourceProvenance; # Allow granular checks to allow only some non-source-built packages # Example: @@ -167,8 +164,7 @@ let UnsupportedSystem = "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM"; NonSource = "NIXPKGS_ALLOW_NONSOURCE"; } - .${allow_attr} - ; + .${allow_attr}; remediation_phrase = allow_attr: { @@ -177,8 +173,7 @@ let UnsupportedSystem = "packages that are unsupported for this system"; NonSource = "packages not built from source"; } - .${allow_attr} - ; + .${allow_attr}; remediate_predicate = predicateConfigAttr: attrs: '' Alternatively you can configure a predicate to allow specific packages: @@ -257,8 +252,7 @@ let actualOutputs = attrs.outputs or [ "out" ]; missingOutputs = builtins.filter (output: !builtins.elem output actualOutputs) - expectedOutputs - ; + expectedOutputs; in '' The package ${getName attrs} has set meta.outputsToInstall to: ${ @@ -272,8 +266,7 @@ let and is missing the following ouputs: ${lib.concatStrings (builtins.map (output: " - ${output}\n") missingOutputs)} - '' - ; + ''; handleEvalIssue = { meta, attrs }: @@ -296,8 +289,7 @@ let handler = if config ? handleEvalIssue then config.handleEvalIssue reason else throw; in - handler msg - ; + handler msg; handleEvalWarning = { meta, attrs }: @@ -318,8 +310,7 @@ let ; isEnabled = lib.findFirst (x: x == reason) null showWarnings; in - if isEnabled != null then builtins.trace msg true else true - ; + if isEnabled != null then builtins.trace msg true else true; # Deep type-checking. Note that calling `type.check` is not enough: see `lib.mkOptionType`'s documentation. # We don't include this in lib for now because this function is flawed: it accepts things like `mkIf true 42`. @@ -332,8 +323,7 @@ let } ]; eval = builtins.tryEval (builtins.deepSeq merged.mergedValue null); in - eval.success - ; + eval.success; # TODO make this into a proper module and use the generic option documentation generation? metaTypes = with lib.types; rec { @@ -349,8 +339,7 @@ let let licenseType = either (attrsOf anything) str; # TODO disallow `str` licenses, use a module in - either licenseType (listOf licenseType) - ; + either licenseType (listOf licenseType); sourceProvenance = listOf lib.types.attrs; maintainers = listOf (attrsOf anything); # TODO use the maintainer type from lib/tests/maintainer-module.nix priority = int; @@ -418,8 +407,7 @@ let meta: lib.optionals config.checkMeta ( lib.remove null (lib.mapAttrsToList checkMetaAttr meta) - ) - ; + ); checkOutputsToInstall = attrs: @@ -428,11 +416,9 @@ let actualOutputs = attrs.outputs or [ "out" ]; missingOutputs = builtins.filter (output: !builtins.elem output actualOutputs) - expectedOutputs - ; + expectedOutputs; in - if config.checkMeta then builtins.length missingOutputs > 0 else false - ; + if config.checkMeta then builtins.length missingOutputs > 0 else false; # Check if a derivation is valid, that is whether it passes checks for # e.g brokenness or license. diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index bcc39b22..497dd313 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -54,8 +54,7 @@ in } ); } - ) - ; + ); # We don't want to evaluate all of linuxPackages for the manual # - some of it might not even evaluate correctly. defaultText = literalExpression "pkgs.linuxPackages"; @@ -275,16 +274,14 @@ in # x86 RTC needed by the stage 2 init script. "rtc_cmos" ] - ) - ; + ); boot.initrd.kernelModules = optionals config.boot.initrd.includeDefaultModules [ # For LVM. "dm_mod" - ] - ; + ]; }) (mkIf (!config.boot.isContainer) { @@ -301,8 +298,7 @@ in ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" - ] - ; + ]; boot.kernel.sysctl."kernel.printk" = mkDefault config.boot.consoleLogLevel; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index cb1cd615..d1baf0ef 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -52,8 +52,7 @@ let post_max_size = cfg.maxUploadSize; memory_limit = cfg.maxUploadSize; } - // cfg.phpOptions // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; } - ; + // cfg.phpOptions // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; }; occ = pkgs.writeScriptBin "nextcloud-occ" '' #! ${pkgs.runtimeShell} @@ -344,8 +343,7 @@ in int bool ] - ) - ; + ); default = { "pm" = "dynamic"; "pm.max_children" = "32"; @@ -625,8 +623,7 @@ in ) // { default = true; - } - ; + }; caching = { apcu = mkOption { @@ -824,8 +821,7 @@ in nextcloud25 else nextcloud26 - ) - ; + ); services.nextcloud.phpPackage = if versionOlder cfg.package.version "26" then pkgs.php81 else pkgs.php82; @@ -884,16 +880,14 @@ in } ], ] - '' - ; + ''; showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; renderedAppStoreSetting = let x = cfg.appstoreEnable; in - if x == null then "false" else boolToString x - ; + if x == null then "false" else boolToString x; nextcloudGreaterOrEqualThan = req: versionAtLeast cfg.package.version req; @@ -1025,8 +1019,7 @@ in ${mkExport adminpass} ${occ}/bin/nextcloud-occ maintenance:install \ ${installFlags} - '' - ; + ''; occSetTrustedDomainsCmd = concatStringsSep "\n" ( imap0 (i: v: '' @@ -1107,10 +1100,8 @@ in # an automatic creation of the database user. environment.NC_setup_create_db_user = lib.mkIf (nextcloudGreaterOrEqualThan "26") - "false" - ; - } - ; + "false"; + }; nextcloud-cron = { after = [ "nextcloud-setup.service" ]; environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index 4b3f8f19..84f50d54 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -25,8 +25,7 @@ stdenv.mkDerivation rec { invariant-under-noXlibs = testEqualDerivation "hello must not be rebuilt when environment.noXlibs is set." hello - (nixos { environment.noXlibs = true; }).pkgs.hello - ; + (nixos { environment.noXlibs = true; }).pkgs.hello; }; meta = with lib; { diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 62aea42f..0c64ad51 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -155,7 +155,8 @@ assert stdenv.cc.libc or null != null; assert pipewireSupport -> !waylandSupport || !webrtcSupport - -> throw "${pname}: pipewireSupport requires both wayland and webrtc support."; + -> throw "${pname}: pipewireSupport requires both wayland and webrtc support." +; let inherit (lib) enableFeature; diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index 95551743..99d6bfa8 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -91,8 +91,7 @@ let [ ../cygwin/rebase-x86_64.sh ] else [ ] - ) - ; + ); # A function that builds a "native" stdenv (one that uses tools in # /usr etc.). @@ -149,8 +148,7 @@ let overrides config ; - } - ; + }; in [ @@ -188,8 +186,7 @@ in nativeLibc = true; }; inherit stdenvNoCC; - } - ; + }; fetchurl = import ../../build-support/fetchurl { inherit lib stdenvNoCC; diff --git a/test/diff/let_in/out.nix b/test/diff/let_in/out.nix index e9a4b377..2ad06c03 100644 --- a/test/diff/let_in/out.nix +++ b/test/diff/let_in/out.nix @@ -5,62 +5,53 @@ let b = 2; c = 3; in - d - ; + d; a = let c = 1; in - f - ; + f; a = let c = 1; in # e - f - ; + f; a = let c = 1; # d in - f - ; + f; a = let c = 1; # d in # e - f - ; + f; a = let # b c = 1; in - f - ; + f; a = let # b c = 1; in # e - f - ; + f; a = let # b c = 1; # d in - f - ; + f; a = let # b c = 1; # d in # e - f - ; + f; a = let @@ -68,8 +59,7 @@ let [ 1 2 - ] - ; + ]; in a diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index 2e38f998..7602ee82 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -126,8 +126,7 @@ stdenv.mkDerivation # foo "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # foo - } - ; + }; # foo cargoDeps # foo @@ -154,8 +153,7 @@ stdenv.mkDerivation # foo "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # foo - } - ; + }; # foo nativeBuildInputs # foo diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index e8d6cedc..71d0fdc7 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -64,8 +64,7 @@ stdenv.mkDerivation # Foo sha256 # Foo = # Foo "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo - } - ; # Foo + }; # Foo cargoDeps # Foo = # Foo rustPlatform.fetchCargoTarball # Foo @@ -80,8 +79,7 @@ stdenv.mkDerivation # Foo hash # Foo = # Foo "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo - } - ; # Foo + }; # Foo nativeBuildInputs # Foo = # Foo [ @@ -139,8 +137,7 @@ stdenv.mkDerivation # Foo [ # Foo jtojnar # Foo - ] - ; # Foo + ]; # Foo platforms # Foo = # Foo platforms.unix; # Foo diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 3987bb48..59a5a6ee 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -49,8 +49,7 @@ let '' ${concatStringsSep "\n" config.boot.kernelModules} - '' - ; + ''; in { @@ -83,8 +82,7 @@ in literalExpression - "{debug= true;}" - ; + "{debug= true;}"; internal @@ -103,8 +101,7 @@ in which would have separate nixos options. `grep features pkgs/os-specific/linux/kernel/common-config.nix` ''; - } - ; + }; boot.kernelPackages @@ -193,14 +190,11 @@ in super.kernel.features - features - ; + features; } - ) - ; + ); } - ) - ; + ); # We don't want to evaluate all of linuxPackages for the manual # - some of it might not even evaluate correctly. @@ -211,8 +205,7 @@ in literalExpression - "pkgs.linuxPackages" - ; + "pkgs.linuxPackages"; example @@ -220,8 +213,7 @@ in literalExpression - "pkgs.linuxKernel.packages.linux_5_10" - ; + "pkgs.linuxKernel.packages.linux_5_10"; description @@ -239,8 +231,7 @@ in then it also needs to contain an attribute nvidia_x11. ''; - } - ; + }; boot.kernelPatches @@ -256,8 +247,7 @@ in types.listOf - types.attrs - ; + types.attrs; default @@ -271,10 +261,8 @@ in literalExpression - "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]" - ; + "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; description = "A list of additional patches to apply to the kernel."; - } - ; + }; }; } diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index f2ca1004..413c3b48 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -30,8 +30,7 @@ a = with b; # comment - 1 - ; + 1; } { a = with b; 1; @@ -61,7 +60,6 @@ makeBinPath ([ rsync util-linux - ]) - ; + ]); } ] From 43dd01d78790a44b1714ff82378a5e1f22dd972e Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 28 Sep 2023 16:19:42 +0200 Subject: [PATCH 071/125] Fix comment handling Instead of extracting comments from tokens with a lot of special cases, we now move them out of groups as part of the fixup processing. This fixes comment handling in all the remaining cases which were previously forgotten. --- src/Nixfmt/Predoc.hs | 27 +++++++++++++++------ src/Nixfmt/Pretty.hs | 44 +++++++++++++--------------------- test/diff/idioms_lib_2/out.nix | 3 +-- test/diff/idioms_lib_4/out.nix | 6 ++--- test/diff/lambda/in.nix | 19 +++++++++++++++ test/diff/lambda/out.nix | 20 ++++++++++++++++ test/diff/operation/in.nix | 5 ++++ test/diff/operation/out.nix | 5 ++++ 8 files changed, 89 insertions(+), 40 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index ca91bac6..6c4352d3 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -230,6 +230,14 @@ isHardSpacing (Spacing Emptyline) = True isHardSpacing (Spacing (Newlines _)) = True isHardSpacing _ = False +-- Check if an element is a comment +-- Some comments are nested as nodes with multiple elements. +-- Therefore nodes are counted as comments if they only contain comments or hard spacings +isComment :: DocE -> Bool +isComment (Text Comment _) = True +isComment (Node _ inner) = all (\x -> isComment x || isHardSpacing x) inner +isComment _ = False + --- Manually force a group to its compact layout, by replacing all relevant whitespace. --- Does recurse into inner groups. unexpandSpacing :: Doc -> Doc @@ -260,21 +268,25 @@ fixup [] = [] fixup (Spacing a : Spacing b : xs) = fixup $ Spacing (mergeSpacings a b) : xs -- Merge consecutive texts fixup (Text ann a : Text ann' b : xs) | ann == ann' = fixup $ Text ann (a <> b) : xs --- Handle node, with leading spacing to potentially merge with -fixup (Spacing a : Node ann xs : ys) = +-- Handle node, with stuff in front of it to potentially merge with +fixup (a@(Spacing _) : Node ann xs : ys) = let + moveComment = case ann of { Nest _ -> False; _ -> True } -- Recurse onto xs, split out leading and trailing whitespace into pre and post. - (pre, rest) = span isHardSpacing $ fixup xs + -- 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 || (moveComment && isComment x)) $ fixup xs (post, body) = spanEnd isHardSpacing rest in if null body then -- Dissolve empty node - fixup $ (Spacing a : pre) ++ post ++ ys + fixup $ (a : pre) ++ post ++ ys else - fixup (Spacing a : pre) ++ [Node ann body] ++ fixup (post ++ ys) --- Handle node, almost the same thing + fixup (a : pre) ++ [Node ann body] ++ fixup (post ++ ys) +-- Handle node, almost the same thing as above fixup (Node ann xs : ys) = let - (pre, rest) = span isHardSpacing $ fixup xs + moveComment = case ann of { Nest _ -> False; _ -> True } + (pre, rest) = span (\x -> isHardSpacing x || (moveComment && isComment x)) $ fixup xs (post, body) = spanEnd isHardSpacing rest in if null body then fixup $ pre ++ post ++ ys @@ -489,6 +501,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) -- therefore drop any leading whitespace within the group to avoid duplicate newlines grp' = case head grp of Spacing _ -> tail grp + Node ann@(Group _) ((Spacing _) : inner) -> (Node ann inner) : tail grp _ -> grp i = ti + firstLineIndent grp' in diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index f11c3f82..d86a4037 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -23,15 +23,14 @@ import Nixfmt.Predoc import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), - StringPart(..), Term(..), Token(..), TrailingComment(..), Trivia, Trivium(..), + StringPart(..), Term(..), Token(..), TrailingComment(..), Trivium(..), Whole(..), tokenText, mapFirstToken') import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) -import GHC.Stack (HasCallStack) prettyCommentLine :: Text -> Doc prettyCommentLine l | Text.null l = emptyline - | otherwise = text l <> hardline + | otherwise = comment l <> hardline toLineComment :: TrailingComment -> Trivium toLineComment (TrailingComment c) = LineComment $ " " <> c @@ -45,14 +44,6 @@ moveTrailingCommentUp :: Ann a -> Ann a moveTrailingCommentUp (Ann pre a (Just post)) = Ann (pre ++ [toLineComment post]) a Nothing moveTrailingCommentUp a = a --- Make sure a group is not expanded because the token that starts it has --- leading comments. This will render both arguments as a group, but --- if the first argument has some leading comments they will be put before --- the group -groupWithStart :: HasCallStack => Pretty a => Ann a -> Doc -> Doc -groupWithStart (Ann leading a trailing') b - = pretty leading <> group (pretty a <> pretty trailing' <> b) - instance Pretty TrailingComment where pretty (TrailingComment c) = hardspace <> comment ("# " <> c) <> hardline @@ -63,9 +54,9 @@ instance Pretty Trivium where pretty (BlockComment c) | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment' c) | otherwise - = base $ text "/*" <> hardspace + = base $ comment "/*" <> hardspace <> nest 3 (hcat (map prettyCommentLine c)) - <> text "*/" <> hardline + <> comment "*/" <> hardline instance Pretty a => Pretty (Item a) where pretty (DetachedComments trivia) = pretty trivia @@ -213,7 +204,8 @@ prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trail -- Singleton list -- Expand unless absorbable term or single line prettyTerm (List paropen@(Ann _ _ Nothing) (Items [item@(CommentedItem iComment item')]) parclose@(Ann [] _ _)) - = base $ groupWithStart paropen $ + = base $ group $ + pretty paropen <> (if isAbsorbable item' && null iComment then surroundWith hardspace item' else @@ -232,7 +224,7 @@ prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, i -- Parenthesized application prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) - = base $ groupWithStart (Ann pre paropen Nothing) $ nest 2 ( + = base $ group $ pretty (Ann pre paropen Nothing) <> nest 2 ( -- Move comment trailing on '(' to next line, combine with comment from application case pretty post of { [] -> []; c -> hardline <> c } <> base (prettyApp hardline mempty line' hardline f a) @@ -241,7 +233,7 @@ prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = base $ groupWithStart paropen (lineL <> nest 2 (group expr) <> lineR <> pretty parclose) + = base $ group $ pretty paropen <> lineL <> nest 2 (group expr) <> lineR <> pretty parclose where (lineL, lineR) = case expr of @@ -313,8 +305,9 @@ instance Pretty Parameter where -- { stuff }: pretty (SetParameter bopen attrs bclose) = - groupWithStart bopen $ - (surroundWith sep $ nest 2 (sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs)) + group $ + pretty bopen + <> (surroundWith sep $ nest 2 (sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs)) <> pretty bclose where -- pretty all ParamAttrs, but make the trailing comma of the last element specially @@ -452,9 +445,9 @@ instance Pretty Expression where ([], []) (unItems binders) - letPart = groupWithStart let_ $ hardline <> letBody + letPart = group $ pretty let_ <> hardline <> letBody letBody = nest 2 $ prettyItems hardline (Items bindersWithoutComments) - inPart = groupWithStart (Ann [] in_ Nothing) $ hardline + inPart = group $ pretty (Ann [] in_ Nothing) <> hardline -- Take our trailing and inject it between `in` and body <> pretty (concat binderComments ++ leading ++ convertTrailing trailing') <> pretty expr @@ -467,7 +460,7 @@ instance Pretty Expression where pretty (If if_ cond then_ expr0 else_ expr1) = base $ group' False $ -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - groupWithStart if_ (line <> nest 2 (pretty cond) <> line <> pretty then_) + group (pretty if_ <> line <> nest 2 (pretty cond) <> line <> pretty then_) <> (surroundWith line $ nest 2 $ group expr0) <> pretty else_ <> absorbElse expr1 -- This trailing line' is a bit of a hack. It makes sure that the semicolon in binders gets placed onto @@ -491,7 +484,7 @@ instance Pretty Expression where pretty (Application f a) = prettyApp mempty mempty mempty mempty f a - -- binary operators + -- not chainable binary operators: <, >, <=, >=, ==, != pretty (Operation a op@(Ann _ op' _) b) | op' == TLess || op' == TGreater || op' == TLessEqual || op' == TGreaterEqual || op' == TEqual || op' == TUnequal = pretty a <> softline <> pretty op <> hardspace <> pretty b @@ -520,12 +513,9 @@ instance Pretty Expression where -- The others prettyOperation ((Just op'), expr) = line <> pretty (moveTrailingCommentUp op') <> nest 2 (absorbOperation expr) - - -- Extract comment before the first operand and move it out, to prevent force-expanding the expression - (operationWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing') -> (Ann [] token trailing', leading)) operation in - pretty comment' <> (group' False $ - ((concat . map prettyOperation . (flatten Nothing)) operationWithoutComment) <> line') + group' False $ + ((concat . map prettyOperation . (flatten Nothing)) operation) <> line' pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index b3307ded..b2c94033 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -11,8 +11,7 @@ rec { */ id = # The value to return - x: - x; + x: x; /* The constant function diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index b3117bf9..d4b670a9 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -845,12 +845,10 @@ rec { cpu, # Optional, but fallback too complex for here. # Inferred below instead. - vendor ? assert false; - null, + vendor ? assert false; null, kernel, # Also inferred below - abi ? assert false; - null, + abi ? assert false; null, }@args: let getCpu = name: cpuTypes.${name} or (throw "Unknown CPU type: ${name}"); diff --git a/test/diff/lambda/in.nix b/test/diff/lambda/in.nix index 3711558b..69454cef 100644 --- a/test/diff/lambda/in.nix +++ b/test/diff/lambda/in.nix @@ -1,4 +1,23 @@ +let + inherit lib; +in [ + ( + { lib, }: + let + foo = 1; + in + foo + ) + ( + /* Collection of functions useful for debugging + Some comment */ + { lib }: + let + foo = 1; + in + foo + ) (a: b: /*c*/ d) ({}: b: /*c*/ d) (a: {}: /*c*/ d) diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 99cf3f10..42d4b05b 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -1,4 +1,24 @@ +let + inherit lib; +in [ + ( + { lib }: + let + foo = 1; + in + foo + ) + ( + /* Collection of functions useful for debugging + Some comment + */ + { lib }: + let + foo = 1; + in + foo + ) ( a: b: # c d diff --git a/test/diff/operation/in.nix b/test/diff/operation/in.nix index 6ad3b415..44d3ba92 100644 --- a/test/diff/operation/in.nix +++ b/test/diff/operation/in.nix @@ -1,4 +1,9 @@ [ + ( + # To find infinite recursion in NixOS option docs: + # builtins.trace opt.loc + [ docOption ] ++ optionals subOptionsVisible subOptions + ) ( # Filter out git baseName == ".gitignore" diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 8b3e6a46..95be0fee 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -1,4 +1,9 @@ [ + ( + # To find infinite recursion in NixOS option docs: + # builtins.trace opt.loc + [ docOption ] ++ optionals subOptionsVisible subOptions + ) ( # Filter out git baseName == ".gitignore" From 549541f3ca63d0aff75108b6b053385e1a0cb85c Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 10 Oct 2023 22:34:08 +0200 Subject: [PATCH 072/125] Expand singleton lists again --- src/Nixfmt/Pretty.hs | 18 +++-------------- test/diff/idioms_lib_4/out.nix | 14 +++++++------ test/diff/idioms_lib_5/out.nix | 10 ++++++---- test/diff/idioms_nixos_2/out.nix | 24 ++++++++++++---------- test/diff/lists/out.nix | 34 ++++++++++++++++++++------------ test/diff/paren/out.nix | 12 ++++++----- 6 files changed, 59 insertions(+), 53 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index d86a4037..115bf017 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -201,23 +201,11 @@ prettyTerm (Selection term selectors) = pretty term <> line' <> hcat selectors prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing')) = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing' --- Singleton list --- Expand unless absorbable term or single line -prettyTerm (List paropen@(Ann _ _ Nothing) (Items [item@(CommentedItem iComment item')]) parclose@(Ann [] _ _)) - = base $ group $ - pretty paropen <> - (if isAbsorbable item' && null iComment then - surroundWith hardspace item' - else - surroundWith line $ nest 2 item - ) - <> pretty parclose - --- General list (len >= 2) --- Always expand +-- General list +-- Always expand if len > 1 prettyTerm (List (Ann pre paropen post) items parclose) = base $ pretty (Ann pre paropen Nothing) - <> (surroundWith hardline $ nest 2 $ pretty post <> prettyItems hardline items) + <> (surroundWith line $ nest 2 $ pretty post <> prettyItems hardline items) <> pretty parclose prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index d4b670a9..e8bdec00 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -641,12 +641,14 @@ rec { androideabi = { }; android = { - assertions = [ { - assertion = platform: !platform.isAarch32; - message = '' - The "android" ABI is not for 32-bit ARM. Use "androideabi" instead. - ''; - } ]; + assertions = [ + { + assertion = platform: !platform.isAarch32; + message = '' + The "android" ABI is not for 32-bit ARM. Use "androideabi" instead. + ''; + } + ]; }; gnueabi = { diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 62189229..33c80ba2 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -317,10 +317,12 @@ let typeCheck = type: value: let - merged = lib.mergeDefinitions [ ] type [ { - file = lib.unknownModule; - inherit value; - } ]; + merged = lib.mergeDefinitions [ ] type [ + { + file = lib.unknownModule; + inherit value; + } + ]; eval = builtins.tryEval (builtins.deepSeq merged.mergedValue null); in eval.success; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index d1baf0ef..2baaeef3 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -828,10 +828,12 @@ in } { - assertions = [ { - assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; - message = "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; - } ]; + assertions = [ + { + assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; + message = "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; + } + ]; } { @@ -1154,12 +1156,14 @@ in enable = true; package = lib.mkDefault pkgs.mariadb; ensureDatabases = [ cfg.config.dbname ]; - ensureUsers = [ { - name = cfg.config.dbuser; - ensurePermissions = { - "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; - }; - } ]; + ensureUsers = [ + { + name = cfg.config.dbuser; + ensurePermissions = { + "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; + }; + } + ]; initialScript = pkgs.writeText "mysql-init" '' CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${ builtins.readFile (cfg.config.dbpassFile) diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index b8dec391..75ffcf4d 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -1,9 +1,11 @@ [ - [ { - # multiline - foo = "bar"; - foo2 = "barbar"; - } ] + [ + { + # multiline + foo = "bar"; + foo2 = "barbar"; + } + ] [ ( if foo then @@ -72,14 +74,20 @@ # e ] - [ [ - multi - line - ] ] + [ + [ + multi + line + ] + ] [ [ [ singleton ] ] ] [ [ [ { } ] ] ] - [ [ [ - { } - multiline - ] ] ] + [ + [ + [ + { } + multiline + ] + ] + ] ] diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index ba7e2b0c..02cce54f 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -1,11 +1,13 @@ [ ( done - // listToAttrs [ { - # multline - name = entry; - value = 1; - } ] + // listToAttrs [ + { + # multline + name = entry; + value = 1; + } + ] ) ] ( From 7649a1b5626d87219904350295ca77593aff1349 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 11 Oct 2023 15:47:24 +0200 Subject: [PATCH 073/125] Put semicolons on same line again --- src/Nixfmt/Pretty.hs | 11 ++------ test/diff/attr_set/out.nix | 9 ++---- test/diff/idioms_lib_2/out.nix | 24 ++++++---------- test/diff/idioms_lib_3/out.nix | 42 ++++++++++------------------ test/diff/idioms_lib_4/out.nix | 39 +++++++++----------------- test/diff/idioms_lib_5/out.nix | 48 +++++++++++--------------------- test/diff/idioms_nixos_1/out.nix | 6 ++-- test/diff/idioms_nixos_2/out.nix | 9 ++---- test/diff/idioms_pkgs_3/out.nix | 30 +++++++------------- test/diff/idioms_pkgs_4/out.nix | 12 +++----- test/diff/monsters_5/out.nix | 6 ++-- 11 files changed, 78 insertions(+), 158 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 115bf017..b15939be 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -145,7 +145,7 @@ instance Pretty Binder where group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) mempty hardline f a + line <> (group l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) mempty mempty f a -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> @@ -155,7 +155,7 @@ instance Pretty Binder where group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TConcat Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp hardline (pretty TConcat <> hardspace) mempty hardline f a + line <> (group l) <> line <> prettyApp hardline (pretty TConcat <> hardspace) mempty mempty 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) @@ -451,11 +451,6 @@ instance Pretty Expression where group (pretty if_ <> line <> nest 2 (pretty cond) <> line <> pretty then_) <> (surroundWith line $ nest 2 $ group expr0) <> pretty else_ <> absorbElse expr1 - -- This trailing line' is a bit of a hack. It makes sure that the semicolon in binders gets placed onto - -- a new line if the items ends with a (multiline) if. - -- Normally this should only be the case when in binders as this might interfere with other syntax constructs, - -- but because our style always puts a new line after multiline Ifs it turns out to work just fine ^^ - <> line' pretty (Abstraction (IDParameter param) colon body) = pretty param <> pretty colon <> absorbAbs 1 body @@ -503,7 +498,7 @@ instance Pretty Expression where line <> pretty (moveTrailingCommentUp op') <> nest 2 (absorbOperation expr) in group' False $ - ((concat . map prettyOperation . (flatten Nothing)) operation) <> line' + (concat . map prettyOperation . (flatten Nothing)) operation pretty (MemberCheck expr qmark sel) = pretty expr <> softline diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index ea7022bd..77774632 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -133,8 +133,7 @@ ++ (optionals condition [ more items - ]) - ; + ]); b = with pkgs; [ a lot @@ -195,8 +194,7 @@ secret-config.ssh-hosts // { foo = "bar"; - } - ; + }; programs.ssh.knownHosts3 = lib.mapAttrs ( host_name: publicKey: { @@ -225,8 +223,7 @@ ) // { foo = "bar"; - } - ; + }; programs.ssh.knownHosts5 = someStuff // lib.mapAttrs ( diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index b2c94033..8d60856b 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -196,8 +196,7 @@ rec { if pathExists suffixFile then lib.strings.fileContents suffixFile else - "pre-git" - ; + "pre-git"; /* Attempts to return the the current revision of nixpkgs and returns the supplied default value otherwise. @@ -216,8 +215,7 @@ rec { else if lib.pathExists revisionFile then lib.fileContents revisionFile else - default - ; + default; nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" @@ -263,8 +261,7 @@ rec { else if a > b then 1 else - 0 - ; + 0; /* Split type into two subtypes by predicate `p`, take all elements of the first subtype to be less than all the elements of the @@ -300,8 +297,7 @@ rec { else if p b then 1 else - no a b - ; + no a b; /* Reads a JSON file. @@ -352,8 +348,7 @@ rec { abort "NIX_ABORT_ON_WARN=true; warnings are treated as unrecoverable errors." ) else - msg: builtins.trace "warning: ${msg}" - ; + msg: builtins.trace "warning: ${msg}"; /* Like warn, but only warn when the first argument is `true`. @@ -436,8 +431,7 @@ rec { if f ? __functor then f.__functionArgs or (lib.functionArgs (f.__functor f)) else - builtins.functionArgs f - ; + builtins.functionArgs f; /* Check whether something is a function or something annotated with function args. @@ -470,8 +464,7 @@ rec { "14" = "E"; "15" = "F"; } - .${toString d} - ; + .${toString d}; in lib.concatMapStrings toHexDigit (toBaseDigits 16 i); @@ -496,8 +489,7 @@ rec { r = i - ((i / base) * base); q = (i - r) / base; in - [ r ] ++ go q - ; + [ r ] ++ go q; in assert (base >= 2); assert (i >= 0); diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index cef667ca..91a693e2 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -69,8 +69,7 @@ rec { else if isFloat v then libStr.floatToString v else - err "this value is" (toString v) - ; + err "this value is" (toString v); # Generate a line of key k and value v, separated by # character sep. If sep appears in k, it is escaped. @@ -103,8 +102,7 @@ rec { if listsAsDuplicateKeys then k: v: map (mkLine k) (if lib.isList v then v else [ v ]) else - k: v: [ (mkLine k v) ] - ; + k: v: [ (mkLine k v) ]; in attrs: libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); @@ -156,8 +154,7 @@ rec { '' [${mkSectionName sectName}] '' - + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues - ; + + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; in # map input to ini sections mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; @@ -216,8 +213,7 @@ rec { else (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" ) - + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections) - ; + + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections); # Generate a git-config file from an attrset. # @@ -252,8 +248,7 @@ rec { if containsQuote || subsections == [ ] then name else - ''${section} "${subsection}"'' - ; + ''${section} "${subsection}"''; # generation for multiple ini values mkKeyValue = @@ -273,8 +268,7 @@ rec { else if length path > 1 then { ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = value; } else - { ${head path} = value; } - ; + { ${head path} = value; }; in attrs: lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); @@ -321,8 +315,7 @@ rec { else const "" else - id - ; + id; mapAny = with builtins; depth: v: @@ -334,8 +327,7 @@ rec { else if isList v then map evalNext v else - transform (depth + 1) v - ; + transform (depth + 1) v; in mapAny 0; @@ -368,16 +360,14 @@ rec { ${indent} '' else - " " - ; + " "; outroSpace = if multiline then '' ${indent}'' else - " " - ; + " "; in if isInt v then toString v @@ -417,8 +407,7 @@ rec { + introSpace + concatStringsSep introSpace (lib.init escapedLines) + (if lastLine == "" then outroSpace else introSpace + lastLine) - + "''" - ; + + "''"; in if multiline && length lines > 1 then multilineResult else singlelineResult else if true == v then @@ -473,8 +462,7 @@ rec { + outroSpace + "}" else - abort "generators.toPretty: should never happen (v = ${v})" - ; + abort "generators.toPretty: should never happen (v = ${v})"; in go indent; @@ -502,8 +490,7 @@ rec { else if isFloat x then float ind x else - abort "generators.toPlist: should never happen (v = ${v})" - ; + abort "generators.toPlist: should never happen (v = ${v})"; literal = ind: x: ind + x; @@ -586,6 +573,5 @@ rec { else if v == null then abort "generators.toDhall: cannot convert a null to Dhall" else - builtins.toJSON v - ; + builtins.toJSON v; } diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index e8bdec00..3953f448 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -75,8 +75,7 @@ rec { types.significantByte.check x.significantByte else !(x ? significantByte) - ) - ; + ); }; types.cpuType = enum (attrValues cpuTypes); @@ -371,8 +370,7 @@ rec { then execFormats.aout else - execFormats.elf - ; + execFormats.elf; # Determine when two CPUs are compatible with each other. That is, # can code built for system B run on system A? For that to happen, @@ -509,8 +507,7 @@ rec { check = x: types.execFormat.check x.execFormat - && all types.kernelFamily.check (attrValues x.families) - ; + && all types.kernelFamily.check (attrValues x.families); }; types.kernel = enum (attrValues kernels); @@ -609,8 +606,7 @@ rec { watchos = kernels.ios; tvos = kernels.ios; win32 = kernels.windows; - } - ; + }; ################################################################################ @@ -732,8 +728,7 @@ rec { types.cpuType.check cpu && types.vendor.check vendor && types.kernel.check kernel - && types.abi.check abi - ; + && types.abi.check abi; }; isSystem = isType "system"; @@ -754,8 +749,7 @@ rec { abi = "unknown"; } else - throw "Target specification with 1 components is ambiguous" - ; + throw "Target specification with 1 components is ambiguous"; "2" = # We only do 2-part hacks for things Nix already supports if elemAt l 1 == "cygwin" then { @@ -784,8 +778,7 @@ rec { { cpu = elemAt l 0; kernel = elemAt l 1; - } - ; + }; "3" = # cpu-kernel-environment if @@ -824,12 +817,10 @@ rec { if elemAt l 2 == "mingw32" then "windows" # autotools breaks on -gnu for window else - elemAt l 2 - ; + elemAt l 2; } else - throw "Target specification with 3 components is ambiguous" - ; + throw "Target specification with 3 components is ambiguous"; "4" = { cpu = elemAt l 0; vendor = elemAt l 1; @@ -868,16 +859,14 @@ rec { else if isWindows parsed then vendors.pc else - vendors.unknown - ; + vendors.unknown; kernel = if hasPrefix "darwin" args.kernel then getKernel "darwin" else if hasPrefix "netbsd" args.kernel then getKernel "netbsd" else - getKernel args.kernel - ; + getKernel args.kernel; abi = if args ? abi then getAbi args.abi @@ -893,8 +882,7 @@ rec { else abis.gnu else - abis.unknown - ; + abis.unknown; }; in mkSystem parsed; @@ -916,8 +904,7 @@ rec { else if kernel.families ? darwin then "${cpu.name}-darwin" else - "${cpu.name}-${kernelName kernel}" - ; + "${cpu.name}-${kernelName kernel}"; tripleFromSystem = { diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 33c80ba2..61424dc6 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -37,8 +37,7 @@ let if lib.mutuallyExclusive allowlist blocklist then true else - throw "allowlistedLicenses and blocklistedLicenses are not mutually exclusive." - ; + throw "allowlistedLicenses and blocklistedLicenses are not mutually exclusive."; hasLicense = attrs: attrs ? meta.license; @@ -48,8 +47,7 @@ let hasLicense attrs && lib.lists.any (l: builtins.elem l allowlist) ( lib.lists.toList attrs.meta.license - ) - ; + ); hasBlocklistedLicense = assert areLicenseListsValid; @@ -57,16 +55,14 @@ let hasLicense attrs && lib.lists.any (l: builtins.elem l blocklist) ( lib.lists.toList attrs.meta.license - ) - ; + ); allowBroken = config.allowBroken || builtins.getEnv "NIXPKGS_ALLOW_BROKEN" == "1"; allowUnsupportedSystem = config.allowUnsupportedSystem - || builtins.getEnv "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM" == "1" - ; + || builtins.getEnv "NIXPKGS_ALLOW_UNSUPPORTED_SYSTEM" == "1"; isUnfree = licenses: lib.lists.any (l: !l.free or true) licenses; @@ -106,8 +102,7 @@ let attrs: !(isMarkedInsecure attrs) || allowInsecurePredicate attrs - || builtins.getEnv "NIXPKGS_ALLOW_INSECURE" == "1" - ; + || builtins.getEnv "NIXPKGS_ALLOW_INSECURE" == "1"; isNonSource = sourceTypes: lib.lists.any (t: !t.isSource) sourceTypes; @@ -131,8 +126,7 @@ let attrs: hasNonSourceProvenance attrs && !allowNonSource - && !allowNonSourcePredicate attrs - ; + && !allowNonSourcePredicate attrs; showLicenseOrSourceType = value: toString (map (v: v.shortName or "unknown") (lib.lists.toList value)); @@ -242,8 +236,7 @@ let ]; } - '' - ; + ''; remediateOutputsToInstall = attrs: @@ -283,8 +276,7 @@ let Package ‘${getName attrs}’ in ${pos_str meta} ${errormsg}, refusing to evaluate. '' - + (builtins.getAttr reason remediation) attrs - ; + + (builtins.getAttr reason remediation) attrs; handler = if config ? handleEvalIssue then config.handleEvalIssue reason else throw; @@ -306,8 +298,7 @@ let "Package ${getName attrs} in ${pos_str meta} ${errormsg}, continuing anyway." + (lib.optionalString (remediationMsg != "") '' - ${remediationMsg}'') - ; + ${remediationMsg}''); isEnabled = lib.findFirst (x: x == reason) null showWarnings; in if isEnabled != null then builtins.trace msg true else true; @@ -362,8 +353,7 @@ let x == { } || ( # Accept {} for tests that are unsupported isDerivation x && x ? meta.timeout - ) - ; + ); merge = lib.options.mergeOneOption; } ); @@ -403,8 +393,7 @@ let else '' key 'meta.${k}' is unrecognized; expected one of: - [${lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes)}]'' - ; + [${lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes)}]''; checkMeta = meta: lib.optionals config.checkMeta ( @@ -529,8 +518,7 @@ let # ----- else { valid = "yes"; } - ) - ; + ); # The meta attribute is passed in the resulting attribute set, # but it's not part of the actual derivation, i.e., it's not @@ -578,8 +566,7 @@ let ++ outputs )) ] - ++ lib.optional (hasOutput "man") "man" - ; + ++ lib.optional (hasOutput "man") "man"; } // attrs.meta or { } # Fill `meta.position` to identify the source location of the package. @@ -602,10 +589,8 @@ let lib.all (d: d.meta.available or true) references else true - ) - ; - } - ; + ); + }; assertValidity = { meta, attrs }: @@ -627,8 +612,7 @@ let yes = true; } .${validity.valid}; - } - ; + }; in { inherit assertValidity commonMeta; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 497dd313..2d26acba 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -371,8 +371,7 @@ in (isYes "MODULES") (isYes "BINFMT_ELF") ] - ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")) - ; + ++ (optional (randstructSeed != "") (isYes "GCC_PLUGIN_RANDSTRUCT")); # nixpkgs kernels are assumed to have all required features assertions = @@ -387,8 +386,7 @@ in assertion = attrs.assertion cfg; inherit (attrs) message; }) - config.system.requiredKernelConfig - ; + config.system.requiredKernelConfig; }) ]; } diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 2baaeef3..3a01554d 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -37,8 +37,7 @@ let ++ optional cfg.caching.redis redis ++ optional cfg.caching.memcached memcached ) - ++ cfg.phpExtraExtensions all - ; # Enabled by user + ++ cfg.phpExtraExtensions all; # Enabled by user extraConfig = toKeyValue phpOptions; }; @@ -803,8 +802,7 @@ in See on how to achieve this. For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 - '') - ; + ''); services.nextcloud.package = with pkgs; @@ -1134,8 +1132,7 @@ in "listen.owner" = config.services.nginx.user; "listen.group" = config.services.nginx.group; } - // cfg.poolSettings - ; + // cfg.poolSettings; extraConfig = cfg.poolConfig; }; }; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 0c64ad51..d10db2a6 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -155,8 +155,7 @@ assert stdenv.cc.libc or null != null; assert pipewireSupport -> !waylandSupport || !webrtcSupport - -> throw "${pname}: pipewireSupport requires both wayland and webrtc support." -; + -> throw "${pname}: pipewireSupport requires both wayland and webrtc support."; let inherit (lib) enableFeature; @@ -182,8 +181,7 @@ let if ltoSupport then buildPackages.rustc.llvmPackages.bintools else - stdenv.cc.bintools - ; + stdenv.cc.bintools; } ); @@ -264,16 +262,14 @@ buildStdenv.mkDerivation ({ lib.optional (lib.versionAtLeast version "111") ./env_var_for_system_dir-ff111.patch ++ lib.optional (lib.versionAtLeast version "96") ./no-buildconfig-ffx96.patch - ++ extraPatches - ; + ++ extraPatches; postPatch = '' rm -rf obj-x86_64-pc-linux-gnu patchShebangs mach build '' - + extraPostPatch - ; + + extraPostPatch; # Ignore trivial whitespace changes in patches, this fixes compatibility of # ./env_var_for_system_dir.patch with Firefox >=65 without having to track @@ -310,8 +306,7 @@ buildStdenv.mkDerivation ({ patchelf ] ++ lib.optionals pgoSupport [ xvfb-run ] - ++ extraNativeBuildInputs - ; + ++ extraNativeBuildInputs; setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. @@ -382,8 +377,7 @@ buildStdenv.mkDerivation ({ '' + lib.optionalString (enableOfficialBranding && !stdenv.is32bit) '' export MOZILLA_OFFICIAL=1 - '' - ; + ''; # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags configurePlatforms = [ ]; @@ -453,8 +447,7 @@ buildStdenv.mkDerivation ({ ] ++ lib.optional enableOfficialBranding "--enable-official-branding" ++ lib.optional (branding != null) "--with-branding=${branding}" - ++ extraConfigureFlags - ; + ++ extraConfigureFlags; buildInputs = [ @@ -505,8 +498,7 @@ buildStdenv.mkDerivation ({ libdrm ] ++ lib.optional jemallocSupport jemalloc - ++ extraBuildInputs - ; + ++ extraBuildInputs; profilingPhase = lib.optionalString pgoSupport '' # Package up Firefox for profiling @@ -554,8 +546,7 @@ buildStdenv.mkDerivation ({ '' + '' cd mozobj - '' - ; + ''; postInstall = '' @@ -570,8 +561,7 @@ buildStdenv.mkDerivation ({ # Needed to find Mozilla runtime gappsWrapperArgs+=(--argv0 "$out/bin/.${binaryName}-wrapped") - '' - ; + ''; postFixup = lib.optionalString crashreporterSupport '' patchelf --add-rpath "${ diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index 99d6bfa8..5e0a7b34 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -16,8 +16,7 @@ let if system == "i686-freebsd" || system == "x86_64-freebsd" then "/usr/local/bin/bash" else - "/bin/bash" - ; + "/bin/bash"; path = (lib.optionals (system == "i686-solaris") [ "/usr/gnu" ]) @@ -27,8 +26,7 @@ let "/" "/usr" "/usr/local" - ] - ; + ]; prehookBase = '' # Disable purity tests; it's allowed (even needed) to link to @@ -123,8 +121,7 @@ let else if system == "x86_64-cygwin" then prehookCygwin else - prehookBase - ; + prehookBase; extraNativeBuildInputs = extraNativeBuildInputs @@ -135,8 +132,7 @@ let extraNativeBuildInputsCygwin else [ ] - ) - ; + ); initialPath = extraPath ++ path; diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 59a5a6ee..d64c4253 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -132,8 +132,7 @@ in = mergeEqualOption; - } - ; + }; apply @@ -179,8 +178,7 @@ in ++ - kernelPatches - ; + kernelPatches; features From 8645a226f865b4a60725fc934b4f4a531dbd8e13 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 23 Jun 2023 17:09:30 +0200 Subject: [PATCH 074/125] Update the default line length to 100 As was empirically determined in https://github.com/piegamesde/nixfmt/pull/3 and https://github.com/piegamesde/nixpkgs/pull/3 --- main/Main.hs | 2 +- test/test.sh | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index e5f4ef96..f7d76d94 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -43,7 +43,7 @@ data Nixfmt = Nixfmt options :: Nixfmt options = - let defaultWidth = 80 + let defaultWidth = 100 addDefaultHint value message = message ++ "\n[default: " ++ show value ++ "]" in Nixfmt diff --git a/test/test.sh b/test/test.sh index 1042af61..74977086 100755 --- a/test/test.sh +++ b/test/test.sh @@ -11,7 +11,7 @@ shellcheck "$0" cd "$(dirname "$0")/.." shopt -s expand_aliases -alias nixfmt="cabal v2-run --verbose=0 nixfmt --" +alias nixfmt="cabal v2-run --verbose=0 nixfmt -- -w 80" # Do a test run to make sure it compiles fine nixfmt --version From d2d4a548c3150d3746e67cfa4144a1b132b260e4 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 17 Nov 2023 13:45:54 +0100 Subject: [PATCH 075/125] Tests: add make-derivation.nix It contains some good corner cases for function declarations with comments --- test/diff/idioms_pkgs_5/in.nix | 599 +++++++++++++++++++++++ test/diff/idioms_pkgs_5/out.nix | 836 ++++++++++++++++++++++++++++++++ 2 files changed, 1435 insertions(+) create mode 100644 test/diff/idioms_pkgs_5/in.nix create mode 100644 test/diff/idioms_pkgs_5/out.nix diff --git a/test/diff/idioms_pkgs_5/in.nix b/test/diff/idioms_pkgs_5/in.nix new file mode 100644 index 00000000..8c52eb10 --- /dev/null +++ b/test/diff/idioms_pkgs_5/in.nix @@ -0,0 +1,599 @@ +{ lib, config }: + +stdenv: + +let + # Lib attributes are inherited to the lexical scope for performance reasons. + inherit (lib) + any + assertMsg + attrNames + boolToString + chooseDevOutputs + concatLists + concatMap + concatMapStrings + concatStringsSep + elem + elemAt + extendDerivation + filter + findFirst + flip + head + imap1 + isAttrs + isBool + isDerivation + isInt + isList + isString + mapAttrs + mapNullable + optional + optionalAttrs + optionalString + optionals + remove + splitString + subtractLists + unique + ; + + checkMeta = import ./check-meta.nix { + inherit lib config; + # Nix itself uses the `system` field of a derivation to decide where + # to build it. This is a bit confusing for cross compilation. + inherit (stdenv) hostPlatform; + }; + + # Based off lib.makeExtensible, with modifications: + makeDerivationExtensible = rattrs: + let + # NOTE: The following is a hint that will be printed by the Nix cli when + # encountering an infinite recursion. It must not be formatted into + # separate lines, because Nix would only show the last line of the comment. + + # An infinite recursion here can be caused by having the attribute names of expression `e` in `.overrideAttrs(finalAttrs: previousAttrs: e)` depend on `finalAttrs`. Only the attribute values of `e` can depend on `finalAttrs`. + args = rattrs (args // { inherit finalPackage overrideAttrs; }); + # ^^^^ + + overrideAttrs = f0: + let + f = self: super: + # Convert f0 to an overlay. Legacy is: + # overrideAttrs (super: {}) + # We want to introduce self. We follow the convention of overlays: + # overrideAttrs (self: super: {}) + # Which means the first parameter can be either self or super. + # This is surprising, but far better than the confusion that would + # arise from flipping an overlay's parameters in some cases. + let x = f0 super; + in + if builtins.isFunction x + then + # Can't reuse `x`, because `self` comes first. + # Looks inefficient, but `f0 super` was a cheap thunk. + f0 self super + else x; + in + makeDerivationExtensible + (self: let super = rattrs self; in super // (if builtins.isFunction f0 || f0?__functor then f self super else f0)); + + finalPackage = + mkDerivationSimple overrideAttrs args; + + in finalPackage; + + #makeDerivationExtensibleConst = attrs: makeDerivationExtensible (_: attrs); + # but pre-evaluated for a slight improvement in performance. + makeDerivationExtensibleConst = attrs: + mkDerivationSimple + (f0: + let + f = self: super: + let x = f0 super; + in + if builtins.isFunction x + then + f0 self super + else x; + in + makeDerivationExtensible (self: attrs // (if builtins.isFunction f0 || f0?__functor then f self attrs else f0))) + attrs; + + mkDerivationSimple = overrideAttrs: + + +# `mkDerivation` wraps the builtin `derivation` function to +# produce derivations that use this stdenv and its shell. +# +# See also: +# +# * https://nixos.org/nixpkgs/manual/#sec-using-stdenv +# Details on how to use this mkDerivation function +# +# * https://nixos.org/manual/nix/stable/expressions/derivations.html#derivations +# Explanation about derivations in general +{ + +# These types of dependencies are all exhaustively documented in +# the "Specifying Dependencies" section of the "Standard +# Environment" chapter of the Nixpkgs manual. + +# TODO(@Ericson2314): Stop using legacy dep attribute names + +# host offset -> target offset + depsBuildBuild ? [] # -1 -> -1 +, depsBuildBuildPropagated ? [] # -1 -> -1 +, nativeBuildInputs ? [] # -1 -> 0 N.B. Legacy name +, propagatedNativeBuildInputs ? [] # -1 -> 0 N.B. Legacy name +, depsBuildTarget ? [] # -1 -> 1 +, depsBuildTargetPropagated ? [] # -1 -> 1 + +, depsHostHost ? [] # 0 -> 0 +, depsHostHostPropagated ? [] # 0 -> 0 +, buildInputs ? [] # 0 -> 1 N.B. Legacy name +, propagatedBuildInputs ? [] # 0 -> 1 N.B. Legacy name + +, depsTargetTarget ? [] # 1 -> 1 +, depsTargetTargetPropagated ? [] # 1 -> 1 + +, checkInputs ? [] +, installCheckInputs ? [] +, nativeCheckInputs ? [] +, nativeInstallCheckInputs ? [] + +# Configure Phase +, configureFlags ? [] +, cmakeFlags ? [] +, mesonFlags ? [] +, # Target is not included by default because most programs don't care. + # Including it then would cause needless mass rebuilds. + # + # TODO(@Ericson2314): Make [ "build" "host" ] always the default / resolve #87909 + configurePlatforms ? optionals + (stdenv.hostPlatform != stdenv.buildPlatform || config.configurePlatformsByDefault) + [ "build" "host" ] + +# TODO(@Ericson2314): Make unconditional / resolve #33599 +# Check phase +, doCheck ? config.doCheckByDefault or false + +# TODO(@Ericson2314): Make unconditional / resolve #33599 +# InstallCheck phase +, doInstallCheck ? config.doCheckByDefault or false + +, # TODO(@Ericson2314): Make always true and remove / resolve #178468 + strictDeps ? if config.strictDepsByDefault then true else stdenv.hostPlatform != stdenv.buildPlatform + +, enableParallelBuilding ? config.enableParallelBuildingByDefault + +, meta ? {} +, passthru ? {} +, pos ? # position used in error messages and for meta.position + (if attrs.meta.description or null != null + then builtins.unsafeGetAttrPos "description" attrs.meta + else if attrs.version or null != null + then builtins.unsafeGetAttrPos "version" attrs + else builtins.unsafeGetAttrPos "name" attrs) +, separateDebugInfo ? false +, outputs ? [ "out" ] +, __darwinAllowLocalNetworking ? false +, __impureHostDeps ? [] +, __propagatedImpureHostDeps ? [] +, sandboxProfile ? "" +, propagatedSandboxProfile ? "" + +, hardeningEnable ? [] +, hardeningDisable ? [] + +, patches ? [] + +, __contentAddressed ? + (! attrs ? outputHash) # Fixed-output drvs can't be content addressed too + && config.contentAddressedByDefault + +# Experimental. For simple packages mostly just works, +# but for anything complex, be prepared to debug if enabling. +, __structuredAttrs ? config.structuredAttrsByDefault or false + +, env ? { } + +, ... } @ attrs: + +# Policy on acceptable hash types in nixpkgs +assert attrs ? outputHash -> ( + let algo = + attrs.outputHashAlgo or (head (splitString "-" attrs.outputHash)); + in + if algo == "md5" then + throw "Rejected insecure ${algo} hash '${attrs.outputHash}'" + else + true +); + +let + # TODO(@oxij, @Ericson2314): This is here to keep the old semantics, remove when + # no package has `doCheck = true`. + doCheck' = doCheck && stdenv.buildPlatform.canExecute stdenv.hostPlatform; + doInstallCheck' = doInstallCheck && stdenv.buildPlatform.canExecute stdenv.hostPlatform; + + separateDebugInfo' = separateDebugInfo && stdenv.hostPlatform.isLinux; + outputs' = outputs ++ optional separateDebugInfo' "debug"; + + # Turn a derivation into its outPath without a string context attached. + # See the comment at the usage site. + unsafeDerivationToUntrackedOutpath = drv: + if isDerivation drv + then builtins.unsafeDiscardStringContext drv.outPath + else drv; + + noNonNativeDeps = builtins.length (depsBuildTarget ++ depsBuildTargetPropagated + ++ depsHostHost ++ depsHostHostPropagated + ++ buildInputs ++ propagatedBuildInputs + ++ depsTargetTarget ++ depsTargetTargetPropagated) == 0; + dontAddHostSuffix = attrs ? outputHash && !noNonNativeDeps || !stdenv.hasCC; + + hardeningDisable' = if any (x: x == "fortify") hardeningDisable + # disabling fortify implies fortify3 should also be disabled + then unique (hardeningDisable ++ [ "fortify3" ]) + else hardeningDisable; + supportedHardeningFlags = [ "fortify" "fortify3" "stackprotector" "pie" "pic" "strictoverflow" "format" "relro" "bindnow" ]; + # Musl-based platforms will keep "pie", other platforms will not. + # If you change this, make sure to update section `{#sec-hardening-in-nixpkgs}` + # in the nixpkgs manual to inform users about the defaults. + defaultHardeningFlags = if stdenv.hostPlatform.isMusl && + # Except when: + # - static aarch64, where compilation works, but produces segfaulting dynamically linked binaries. + # - static armv7l, where compilation fails. + !(stdenv.hostPlatform.isAarch && stdenv.hostPlatform.isStatic) + then supportedHardeningFlags + else remove "pie" supportedHardeningFlags; + enabledHardeningOptions = + if builtins.elem "all" hardeningDisable' + then [] + else subtractLists hardeningDisable' (defaultHardeningFlags ++ hardeningEnable); + # hardeningDisable additionally supports "all". + erroneousHardeningFlags = subtractLists supportedHardeningFlags (hardeningEnable ++ remove "all" hardeningDisable); + + checkDependencyList = checkDependencyList' []; + checkDependencyList' = positions: name: deps: flip imap1 deps (index: dep: + if isDerivation dep || dep == null || builtins.isString dep || builtins.isPath dep then dep + else if isList dep then checkDependencyList' ([index] ++ positions) name dep + else throw "Dependency is not of a valid type: ${concatMapStrings (ix: "element ${toString ix} of ") ([index] ++ positions)}${name} for ${attrs.name or attrs.pname}"); +in if builtins.length erroneousHardeningFlags != 0 +then abort ("mkDerivation was called with unsupported hardening flags: " + lib.generators.toPretty {} { + inherit erroneousHardeningFlags hardeningDisable hardeningEnable supportedHardeningFlags; +}) +else let + doCheck = doCheck'; + doInstallCheck = doInstallCheck'; + buildInputs' = buildInputs + ++ optionals doCheck checkInputs + ++ optionals doInstallCheck installCheckInputs; + nativeBuildInputs' = nativeBuildInputs + ++ optional separateDebugInfo' ../../build-support/setup-hooks/separate-debug-info.sh + ++ optional stdenv.hostPlatform.isWindows ../../build-support/setup-hooks/win-dll-link.sh + ++ optionals doCheck nativeCheckInputs + ++ optionals doInstallCheck nativeInstallCheckInputs; + + outputs = outputs'; + + references = nativeBuildInputs ++ buildInputs + ++ propagatedNativeBuildInputs ++ propagatedBuildInputs; + + dependencies = map (map chooseDevOutputs) [ + [ + (map (drv: drv.__spliced.buildBuild or drv) (checkDependencyList "depsBuildBuild" depsBuildBuild)) + (map (drv: drv.__spliced.buildHost or drv) (checkDependencyList "nativeBuildInputs" nativeBuildInputs')) + (map (drv: drv.__spliced.buildTarget or drv) (checkDependencyList "depsBuildTarget" depsBuildTarget)) + ] + [ + (map (drv: drv.__spliced.hostHost or drv) (checkDependencyList "depsHostHost" depsHostHost)) + (map (drv: drv.__spliced.hostTarget or drv) (checkDependencyList "buildInputs" buildInputs')) + ] + [ + (map (drv: drv.__spliced.targetTarget or drv) (checkDependencyList "depsTargetTarget" depsTargetTarget)) + ] + ]; + propagatedDependencies = map (map chooseDevOutputs) [ + [ + (map (drv: drv.__spliced.buildBuild or drv) (checkDependencyList "depsBuildBuildPropagated" depsBuildBuildPropagated)) + (map (drv: drv.__spliced.buildHost or drv) (checkDependencyList "propagatedNativeBuildInputs" propagatedNativeBuildInputs)) + (map (drv: drv.__spliced.buildTarget or drv) (checkDependencyList "depsBuildTargetPropagated" depsBuildTargetPropagated)) + ] + [ + (map (drv: drv.__spliced.hostHost or drv) (checkDependencyList "depsHostHostPropagated" depsHostHostPropagated)) + (map (drv: drv.__spliced.hostTarget or drv) (checkDependencyList "propagatedBuildInputs" propagatedBuildInputs)) + ] + [ + (map (drv: drv.__spliced.targetTarget or drv) (checkDependencyList "depsTargetTargetPropagated" depsTargetTargetPropagated)) + ] + ]; + + computedSandboxProfile = + concatMap (input: input.__propagatedSandboxProfile or []) + (stdenv.extraNativeBuildInputs + ++ stdenv.extraBuildInputs + ++ concatLists dependencies); + + computedPropagatedSandboxProfile = + concatMap (input: input.__propagatedSandboxProfile or []) + (concatLists propagatedDependencies); + + computedImpureHostDeps = + unique (concatMap (input: input.__propagatedImpureHostDeps or []) + (stdenv.extraNativeBuildInputs + ++ stdenv.extraBuildInputs + ++ concatLists dependencies)); + + computedPropagatedImpureHostDeps = + unique (concatMap (input: input.__propagatedImpureHostDeps or []) + (concatLists propagatedDependencies)); + + envIsExportable = isAttrs env && !isDerivation env; + + derivationArg = + (removeAttrs attrs + (["meta" "passthru" "pos" + "checkInputs" "installCheckInputs" + "nativeCheckInputs" "nativeInstallCheckInputs" + "__contentAddressed" + "__darwinAllowLocalNetworking" + "__impureHostDeps" "__propagatedImpureHostDeps" + "sandboxProfile" "propagatedSandboxProfile"] + ++ optional (__structuredAttrs || envIsExportable) "env")) + // (optionalAttrs (attrs ? name || (attrs ? pname && attrs ? version)) { + name = + let + # Indicate the host platform of the derivation if cross compiling. + # Fixed-output derivations like source tarballs shouldn't get a host + # suffix. But we have some weird ones with run-time deps that are + # just used for their side-affects. Those might as well since the + # hash can't be the same. See #32986. + hostSuffix = optionalString + (stdenv.hostPlatform != stdenv.buildPlatform && !dontAddHostSuffix) + "-${stdenv.hostPlatform.config}"; + + # Disambiguate statically built packages. This was originally + # introduce as a means to prevent nix-env to get confused between + # nix and nixStatic. This should be also achieved by moving the + # hostSuffix before the version, so we could contemplate removing + # it again. + staticMarker = optionalString stdenv.hostPlatform.isStatic "-static"; + in + lib.strings.sanitizeDerivationName ( + if attrs ? name + then attrs.name + hostSuffix + else + # we cannot coerce null to a string below + assert assertMsg (attrs ? version && attrs.version != null) "The ‘version’ attribute cannot be null."; + "${attrs.pname}${staticMarker}${hostSuffix}-${attrs.version}" + ); + }) // optionalAttrs __structuredAttrs { env = checkedEnv; } // { + builder = attrs.realBuilder or stdenv.shell; + args = attrs.args or ["-e" (attrs.builder or ./default-builder.sh)]; + inherit stdenv; + + # The `system` attribute of a derivation has special meaning to Nix. + # Derivations set it to choose what sort of machine could be used to + # execute the build, The build platform entirely determines this, + # indeed more finely than Nix knows or cares about. The `system` + # attribute of `buildPlatfom` matches Nix's degree of specificity. + # exactly. + inherit (stdenv.buildPlatform) system; + + userHook = config.stdenv.userHook or null; + __ignoreNulls = true; + inherit __structuredAttrs strictDeps; + + depsBuildBuild = elemAt (elemAt dependencies 0) 0; + nativeBuildInputs = elemAt (elemAt dependencies 0) 1; + depsBuildTarget = elemAt (elemAt dependencies 0) 2; + depsHostHost = elemAt (elemAt dependencies 1) 0; + buildInputs = elemAt (elemAt dependencies 1) 1; + depsTargetTarget = elemAt (elemAt dependencies 2) 0; + + depsBuildBuildPropagated = elemAt (elemAt propagatedDependencies 0) 0; + propagatedNativeBuildInputs = elemAt (elemAt propagatedDependencies 0) 1; + depsBuildTargetPropagated = elemAt (elemAt propagatedDependencies 0) 2; + depsHostHostPropagated = elemAt (elemAt propagatedDependencies 1) 0; + propagatedBuildInputs = elemAt (elemAt propagatedDependencies 1) 1; + depsTargetTargetPropagated = elemAt (elemAt propagatedDependencies 2) 0; + + # This parameter is sometimes a string, sometimes null, and sometimes a list, yuck + configureFlags = + configureFlags + ++ optional (elem "build" configurePlatforms) "--build=${stdenv.buildPlatform.config}" + ++ optional (elem "host" configurePlatforms) "--host=${stdenv.hostPlatform.config}" + ++ optional (elem "target" configurePlatforms) "--target=${stdenv.targetPlatform.config}"; + + cmakeFlags = + cmakeFlags + ++ optionals (stdenv.hostPlatform != stdenv.buildPlatform) ([ + "-DCMAKE_SYSTEM_NAME=${findFirst isString "Generic" (optional (!stdenv.hostPlatform.isRedox) stdenv.hostPlatform.uname.system)}" + ] ++ optionals (stdenv.hostPlatform.uname.processor != null) [ + "-DCMAKE_SYSTEM_PROCESSOR=${stdenv.hostPlatform.uname.processor}" + ] ++ optionals (stdenv.hostPlatform.uname.release != null) [ + "-DCMAKE_SYSTEM_VERSION=${stdenv.hostPlatform.uname.release}" + ] ++ optionals (stdenv.hostPlatform.isDarwin) [ + "-DCMAKE_OSX_ARCHITECTURES=${stdenv.hostPlatform.darwinArch}" + ] ++ optionals (stdenv.buildPlatform.uname.system != null) [ + "-DCMAKE_HOST_SYSTEM_NAME=${stdenv.buildPlatform.uname.system}" + ] ++ optionals (stdenv.buildPlatform.uname.processor != null) [ + "-DCMAKE_HOST_SYSTEM_PROCESSOR=${stdenv.buildPlatform.uname.processor}" + ] ++ optionals (stdenv.buildPlatform.uname.release != null) [ + "-DCMAKE_HOST_SYSTEM_VERSION=${stdenv.buildPlatform.uname.release}" + ] ++ optionals (stdenv.buildPlatform.canExecute stdenv.hostPlatform) [ + "-DCMAKE_CROSSCOMPILING_EMULATOR=env" + ]); + + mesonFlags = + let + # See https://mesonbuild.com/Reference-tables.html#cpu-families + cpuFamily = platform: with platform; + /**/ if isAarch32 then "arm" + else if isx86_32 then "x86" + else platform.uname.processor; + + crossFile = builtins.toFile "cross-file.conf" '' + [properties] + needs_exe_wrapper = ${boolToString (!stdenv.buildPlatform.canExecute stdenv.hostPlatform)} + + [host_machine] + system = '${stdenv.targetPlatform.parsed.kernel.name}' + cpu_family = '${cpuFamily stdenv.targetPlatform}' + cpu = '${stdenv.targetPlatform.parsed.cpu.name}' + endian = ${if stdenv.targetPlatform.isLittleEndian then "'little'" else "'big'"} + + [binaries] + llvm-config = 'llvm-config-native' + ''; + crossFlags = optionals (stdenv.hostPlatform != stdenv.buildPlatform) [ "--cross-file=${crossFile}" ]; + in crossFlags ++ mesonFlags; + + inherit patches; + + inherit doCheck doInstallCheck; + + inherit outputs; + } // optionalAttrs (__contentAddressed) { + inherit __contentAddressed; + # Provide default values for outputHashMode and outputHashAlgo because + # most people won't care about these anyways + outputHashAlgo = attrs.outputHashAlgo or "sha256"; + outputHashMode = attrs.outputHashMode or "recursive"; + } // optionalAttrs (enableParallelBuilding) { + inherit enableParallelBuilding; + enableParallelChecking = attrs.enableParallelChecking or true; + enableParallelInstalling = attrs.enableParallelInstalling or true; + } // optionalAttrs (hardeningDisable != [] || hardeningEnable != [] || stdenv.hostPlatform.isMusl) { + NIX_HARDENING_ENABLE = enabledHardeningOptions; + } // optionalAttrs (stdenv.hostPlatform.isx86_64 && stdenv.hostPlatform ? gcc.arch) { + requiredSystemFeatures = attrs.requiredSystemFeatures or [] ++ [ "gccarch-${stdenv.hostPlatform.gcc.arch}" ]; + } // optionalAttrs (stdenv.buildPlatform.isDarwin) { + inherit __darwinAllowLocalNetworking; + # TODO: remove `unique` once nix has a list canonicalization primitive + __sandboxProfile = + let profiles = [ stdenv.extraSandboxProfile ] ++ computedSandboxProfile ++ computedPropagatedSandboxProfile ++ [ propagatedSandboxProfile sandboxProfile ]; + final = concatStringsSep "\n" (filter (x: x != "") (unique profiles)); + in final; + __propagatedSandboxProfile = unique (computedPropagatedSandboxProfile ++ [ propagatedSandboxProfile ]); + __impureHostDeps = computedImpureHostDeps ++ computedPropagatedImpureHostDeps ++ __propagatedImpureHostDeps ++ __impureHostDeps ++ stdenv.__extraImpureHostDeps ++ [ + "/dev/zero" + "/dev/random" + "/dev/urandom" + "/bin/sh" + ]; + __propagatedImpureHostDeps = computedPropagatedImpureHostDeps ++ __propagatedImpureHostDeps; + } // + # If we use derivations directly here, they end up as build-time dependencies. + # This is especially problematic in the case of disallowed*, since the disallowed + # derivations will be built by nix as build-time dependencies, while those + # derivations might take a very long time to build, or might not even build + # successfully on the platform used. + # We can improve on this situation by instead passing only the outPath, + # without an attached string context, to nix. The out path will be a placeholder + # which will be replaced by the actual out path if the derivation in question + # is part of the final closure (and thus needs to be built). If it is not + # part of the final closure, then the placeholder will be passed along, + # but in that case we know for a fact that the derivation is not part of the closure. + # This means that passing the out path to nix does the right thing in either + # case, both for disallowed and allowed references/requisites, and we won't + # build the derivation if it wouldn't be part of the closure, saving time and resources. + # While the problem is less severe for allowed*, since we want the derivation + # to be built eventually, we would still like to get the error early and without + # having to wait while nix builds a derivation that might not be used. + # See also https://github.com/NixOS/nix/issues/4629 + optionalAttrs (attrs ? disallowedReferences) { + disallowedReferences = + map unsafeDerivationToUntrackedOutpath attrs.disallowedReferences; + } // + optionalAttrs (attrs ? disallowedRequisites) { + disallowedRequisites = + map unsafeDerivationToUntrackedOutpath attrs.disallowedRequisites; + } // + optionalAttrs (attrs ? allowedReferences) { + allowedReferences = + mapNullable unsafeDerivationToUntrackedOutpath attrs.allowedReferences; + } // + optionalAttrs (attrs ? allowedRequisites) { + allowedRequisites = + mapNullable unsafeDerivationToUntrackedOutpath attrs.allowedRequisites; + }; + + meta = checkMeta.commonMeta { inherit validity attrs pos references; }; + validity = checkMeta.assertValidity { inherit meta attrs; }; + + checkedEnv = + let + overlappingNames = attrNames (builtins.intersectAttrs env derivationArg); + in + assert assertMsg envIsExportable + "When using structured attributes, `env` must be an attribute set of environment variables."; + assert assertMsg (overlappingNames == [ ]) + "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; + mapAttrs + (n: v: assert assertMsg (isString v || isBool v || isInt v || isDerivation v) + "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${builtins.typeOf v}."; v) + env; + +in + +extendDerivation + validity.handled + ({ + # A derivation that always builds successfully and whose runtime + # dependencies are the original derivations build time dependencies + # This allows easy building and distributing of all derivations + # needed to enter a nix-shell with + # nix-build shell.nix -A inputDerivation + inputDerivation = derivation (derivationArg // { + # Add a name in case the original drv didn't have one + name = derivationArg.name or "inputDerivation"; + # This always only has one output + outputs = [ "out" ]; + + # Propagate the original builder and arguments, since we override + # them and they might contain references to build inputs + _derivation_original_builder = derivationArg.builder; + _derivation_original_args = derivationArg.args; + + builder = stdenv.shell; + # The bash builtin `export` dumps all current environment variables, + # which is where all build input references end up (e.g. $PATH for + # binaries). By writing this to $out, Nix can find and register + # them as runtime dependencies (since Nix greps for store paths + # through $out to find them) + args = [ "-c" '' + export > $out + for var in $passAsFile; do + pathVar="''${var}Path" + printf "%s" "$(< "''${!pathVar}")" >> $out + done + '' ]; + + # inputDerivation produces the inputs; not the outputs, so any + # restrictions on what used to be the outputs don't serve a purpose + # anymore. + allowedReferences = null; + allowedRequisites = null; + disallowedReferences = [ ]; + disallowedRequisites = [ ]; + }); + + inherit passthru overrideAttrs; + inherit meta; + } // + # Pass through extra attributes that are not inputs, but + # should be made available to Nix expressions using the + # derivation (e.g., in assertions). + passthru) + (derivation (derivationArg // optionalAttrs envIsExportable checkedEnv)); + +in + fnOrAttrs: + if builtins.isFunction fnOrAttrs + then makeDerivationExtensible fnOrAttrs + else makeDerivationExtensibleConst fnOrAttrs diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix new file mode 100644 index 00000000..0536bf1f --- /dev/null +++ b/test/diff/idioms_pkgs_5/out.nix @@ -0,0 +1,836 @@ +{ lib, config }: + +stdenv: + +let + # Lib attributes are inherited to the lexical scope for performance reasons. + inherit (lib) + any + assertMsg + attrNames + boolToString + chooseDevOutputs + concatLists + concatMap + concatMapStrings + concatStringsSep + elem + elemAt + extendDerivation + filter + findFirst + flip + head + imap1 + isAttrs + isBool + isDerivation + isInt + isList + isString + mapAttrs + mapNullable + optional + optionalAttrs + optionalString + optionals + remove + splitString + subtractLists + unique + ; + + checkMeta = import ./check-meta.nix { + inherit lib config; + # Nix itself uses the `system` field of a derivation to decide where + # to build it. This is a bit confusing for cross compilation. + inherit (stdenv) hostPlatform; + }; + + # Based off lib.makeExtensible, with modifications: + makeDerivationExtensible = + rattrs: + let + # NOTE: The following is a hint that will be printed by the Nix cli when + # encountering an infinite recursion. It must not be formatted into + # separate lines, because Nix would only show the last line of the comment. + + # An infinite recursion here can be caused by having the attribute names of expression `e` in `.overrideAttrs(finalAttrs: previousAttrs: e)` depend on `finalAttrs`. Only the attribute values of `e` can depend on `finalAttrs`. + args = rattrs (args // { inherit finalPackage overrideAttrs; }); + # ^^^^ + + overrideAttrs = + f0: + let + f = + self: super: + # Convert f0 to an overlay. Legacy is: + # overrideAttrs (super: {}) + # We want to introduce self. We follow the convention of overlays: + # overrideAttrs (self: super: {}) + # Which means the first parameter can be either self or super. + # This is surprising, but far better than the confusion that would + # arise from flipping an overlay's parameters in some cases. + let + x = f0 super; + in + if builtins.isFunction x then + # Can't reuse `x`, because `self` comes first. + # Looks inefficient, but `f0 super` was a cheap thunk. + f0 self super + else + x; + in + makeDerivationExtensible ( + self: + let + super = rattrs self; + in + super // (if builtins.isFunction f0 || f0 ? __functor then f self super else f0) + ); + + finalPackage = mkDerivationSimple overrideAttrs args; + in + finalPackage; + + #makeDerivationExtensibleConst = attrs: makeDerivationExtensible (_: attrs); + # but pre-evaluated for a slight improvement in performance. + makeDerivationExtensibleConst = + attrs: + mkDerivationSimple + ( + f0: + let + f = + self: super: + let + x = f0 super; + in + if builtins.isFunction x then f0 self super else x; + in + makeDerivationExtensible ( + self: + attrs // (if builtins.isFunction f0 || f0 ? __functor then f self attrs else f0) + ) + ) + attrs; + + mkDerivationSimple = + overrideAttrs: + + # `mkDerivation` wraps the builtin `derivation` function to + # produce derivations that use this stdenv and its shell. + # + # See also: + # + # * https://nixos.org/nixpkgs/manual/#sec-using-stdenv + # Details on how to use this mkDerivation function + # + # * https://nixos.org/manual/nix/stable/expressions/derivations.html#derivations + # Explanation about derivations in general + { + + # These types of dependencies are all exhaustively documented in + # the "Specifying Dependencies" section of the "Standard + # Environment" chapter of the Nixpkgs manual. + + # TODO(@Ericson2314): Stop using legacy dep attribute names + + # host offset -> target offset + depsBuildBuild ? [ ] # -1 -> -1 + , + depsBuildBuildPropagated ? [ ] # -1 -> -1 + , + nativeBuildInputs ? [ ] # -1 -> 0 N.B. Legacy name + , + propagatedNativeBuildInputs ? [ ] # -1 -> 0 N.B. Legacy name + , + depsBuildTarget ? [ ] # -1 -> 1 + , + depsBuildTargetPropagated ? [ ] # -1 -> 1 + , + + depsHostHost ? [ ] # 0 -> 0 + , + depsHostHostPropagated ? [ ] # 0 -> 0 + , + buildInputs ? [ ] # 0 -> 1 N.B. Legacy name + , + propagatedBuildInputs ? [ ] # 0 -> 1 N.B. Legacy name + , + + depsTargetTarget ? [ ] # 1 -> 1 + , + depsTargetTargetPropagated ? [ ] # 1 -> 1 + , + + checkInputs ? [ ], + installCheckInputs ? [ ], + nativeCheckInputs ? [ ], + nativeInstallCheckInputs ? [ ], + + # Configure Phase + configureFlags ? [ ], + cmakeFlags ? [ ], + mesonFlags ? [ ], + # Target is not included by default because most programs don't care. + # Including it then would cause needless mass rebuilds. + # + # TODO(@Ericson2314): Make [ "build" "host" ] always the default / resolve #87909 + configurePlatforms ? optionals + ( + stdenv.hostPlatform != stdenv.buildPlatform + || config.configurePlatformsByDefault + ) + [ + "build" + "host" + ], + + # TODO(@Ericson2314): Make unconditional / resolve #33599 + # Check phase + doCheck ? config.doCheckByDefault or false, + + # TODO(@Ericson2314): Make unconditional / resolve #33599 + # InstallCheck phase + doInstallCheck ? config.doCheckByDefault or false + + , + # TODO(@Ericson2314): Make always true and remove / resolve #178468 + strictDeps ? if config.strictDepsByDefault then + true + else + stdenv.hostPlatform != stdenv.buildPlatform, + + enableParallelBuilding ? config.enableParallelBuildingByDefault, + + meta ? { }, + passthru ? { }, + pos ? # position used in error messages and for meta.position + ( + if attrs.meta.description or null != null then + builtins.unsafeGetAttrPos "description" attrs.meta + else if attrs.version or null != null then + builtins.unsafeGetAttrPos "version" attrs + else + builtins.unsafeGetAttrPos "name" attrs + ), + separateDebugInfo ? false, + outputs ? [ "out" ], + __darwinAllowLocalNetworking ? false, + __impureHostDeps ? [ ], + __propagatedImpureHostDeps ? [ ], + sandboxProfile ? "", + propagatedSandboxProfile ? "", + + hardeningEnable ? [ ], + hardeningDisable ? [ ], + + patches ? [ ], + + __contentAddressed ? + (!attrs ? outputHash) # Fixed-output drvs can't be content addressed too + && config.contentAddressedByDefault, + + # Experimental. For simple packages mostly just works, + # but for anything complex, be prepared to debug if enabling. + __structuredAttrs ? config.structuredAttrsByDefault or false, + + env ? { } + + , + ... + }@attrs: + + # Policy on acceptable hash types in nixpkgs + assert attrs ? outputHash + -> ( + let + algo = attrs.outputHashAlgo or (head (splitString "-" attrs.outputHash)); + in + if algo == "md5" then + throw "Rejected insecure ${algo} hash '${attrs.outputHash}'" + else + true + ); + + let + # TODO(@oxij, @Ericson2314): This is here to keep the old semantics, remove when + # no package has `doCheck = true`. + doCheck' = doCheck && stdenv.buildPlatform.canExecute stdenv.hostPlatform; + doInstallCheck' = + doInstallCheck && stdenv.buildPlatform.canExecute stdenv.hostPlatform; + + separateDebugInfo' = separateDebugInfo && stdenv.hostPlatform.isLinux; + outputs' = outputs ++ optional separateDebugInfo' "debug"; + + # Turn a derivation into its outPath without a string context attached. + # See the comment at the usage site. + unsafeDerivationToUntrackedOutpath = + drv: + if isDerivation drv then + builtins.unsafeDiscardStringContext drv.outPath + else + drv; + + noNonNativeDeps = + builtins.length ( + depsBuildTarget + ++ depsBuildTargetPropagated + ++ depsHostHost + ++ depsHostHostPropagated + ++ buildInputs + ++ propagatedBuildInputs + ++ depsTargetTarget + ++ depsTargetTargetPropagated + ) == 0; + dontAddHostSuffix = attrs ? outputHash && !noNonNativeDeps || !stdenv.hasCC; + + hardeningDisable' = + if + any (x: x == "fortify") hardeningDisable + # disabling fortify implies fortify3 should also be disabled + then + unique (hardeningDisable ++ [ "fortify3" ]) + else + hardeningDisable; + supportedHardeningFlags = [ + "fortify" + "fortify3" + "stackprotector" + "pie" + "pic" + "strictoverflow" + "format" + "relro" + "bindnow" + ]; + # Musl-based platforms will keep "pie", other platforms will not. + # If you change this, make sure to update section `{#sec-hardening-in-nixpkgs}` + # in the nixpkgs manual to inform users about the defaults. + defaultHardeningFlags = + if + stdenv.hostPlatform.isMusl + && + # Except when: + # - static aarch64, where compilation works, but produces segfaulting dynamically linked binaries. + # - static armv7l, where compilation fails. + !(stdenv.hostPlatform.isAarch && stdenv.hostPlatform.isStatic) + then + supportedHardeningFlags + else + remove "pie" supportedHardeningFlags; + enabledHardeningOptions = + if builtins.elem "all" hardeningDisable' then + [ ] + else + subtractLists hardeningDisable' (defaultHardeningFlags ++ hardeningEnable); + # hardeningDisable additionally supports "all". + erroneousHardeningFlags = subtractLists supportedHardeningFlags ( + hardeningEnable ++ remove "all" hardeningDisable + ); + + checkDependencyList = checkDependencyList' [ ]; + checkDependencyList' = + positions: name: deps: + flip imap1 deps ( + index: dep: + if + isDerivation dep || dep == null || builtins.isString dep || builtins.isPath dep + then + dep + else if isList dep then + checkDependencyList' ([ index ] ++ positions) name dep + else + throw + "Dependency is not of a valid type: ${ + concatMapStrings (ix: "element ${toString ix} of ") ([ index ] ++ positions) + }${name} for ${attrs.name or attrs.pname}" + ); + in + if builtins.length erroneousHardeningFlags != 0 then + abort ( + "mkDerivation was called with unsupported hardening flags: " + + lib.generators.toPretty { } { + inherit + erroneousHardeningFlags + hardeningDisable + hardeningEnable + supportedHardeningFlags + ; + } + ) + else + let + doCheck = doCheck'; + doInstallCheck = doInstallCheck'; + buildInputs' = + buildInputs + ++ optionals doCheck checkInputs + ++ optionals doInstallCheck installCheckInputs; + nativeBuildInputs' = + nativeBuildInputs + ++ + optional separateDebugInfo' + ../../build-support/setup-hooks/separate-debug-info.sh + ++ + optional stdenv.hostPlatform.isWindows + ../../build-support/setup-hooks/win-dll-link.sh + ++ optionals doCheck nativeCheckInputs + ++ optionals doInstallCheck nativeInstallCheckInputs; + + outputs = outputs'; + + references = + nativeBuildInputs + ++ buildInputs + ++ propagatedNativeBuildInputs + ++ propagatedBuildInputs; + + dependencies = map (map chooseDevOutputs) [ + [ + (map (drv: drv.__spliced.buildBuild or drv) ( + checkDependencyList "depsBuildBuild" depsBuildBuild + )) + (map (drv: drv.__spliced.buildHost or drv) ( + checkDependencyList "nativeBuildInputs" nativeBuildInputs' + )) + (map (drv: drv.__spliced.buildTarget or drv) ( + checkDependencyList "depsBuildTarget" depsBuildTarget + )) + ] + [ + (map (drv: drv.__spliced.hostHost or drv) ( + checkDependencyList "depsHostHost" depsHostHost + )) + (map (drv: drv.__spliced.hostTarget or drv) ( + checkDependencyList "buildInputs" buildInputs' + )) + ] + [ + (map (drv: drv.__spliced.targetTarget or drv) ( + checkDependencyList "depsTargetTarget" depsTargetTarget + )) + ] + ]; + propagatedDependencies = map (map chooseDevOutputs) [ + [ + (map (drv: drv.__spliced.buildBuild or drv) ( + checkDependencyList "depsBuildBuildPropagated" depsBuildBuildPropagated + )) + (map (drv: drv.__spliced.buildHost or drv) ( + checkDependencyList "propagatedNativeBuildInputs" propagatedNativeBuildInputs + )) + (map (drv: drv.__spliced.buildTarget or drv) ( + checkDependencyList "depsBuildTargetPropagated" depsBuildTargetPropagated + )) + ] + [ + (map (drv: drv.__spliced.hostHost or drv) ( + checkDependencyList "depsHostHostPropagated" depsHostHostPropagated + )) + (map (drv: drv.__spliced.hostTarget or drv) ( + checkDependencyList "propagatedBuildInputs" propagatedBuildInputs + )) + ] + [ + (map (drv: drv.__spliced.targetTarget or drv) ( + checkDependencyList "depsTargetTargetPropagated" depsTargetTargetPropagated + )) + ] + ]; + + computedSandboxProfile = + concatMap (input: input.__propagatedSandboxProfile or [ ]) + ( + stdenv.extraNativeBuildInputs + ++ stdenv.extraBuildInputs + ++ concatLists dependencies + ); + + computedPropagatedSandboxProfile = + concatMap (input: input.__propagatedSandboxProfile or [ ]) + (concatLists propagatedDependencies); + + computedImpureHostDeps = unique ( + concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( + stdenv.extraNativeBuildInputs + ++ stdenv.extraBuildInputs + ++ concatLists dependencies + ) + ); + + computedPropagatedImpureHostDeps = unique ( + concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( + concatLists propagatedDependencies + ) + ); + + envIsExportable = isAttrs env && !isDerivation env; + + derivationArg = + (removeAttrs attrs ( + [ + "meta" + "passthru" + "pos" + "checkInputs" + "installCheckInputs" + "nativeCheckInputs" + "nativeInstallCheckInputs" + "__contentAddressed" + "__darwinAllowLocalNetworking" + "__impureHostDeps" + "__propagatedImpureHostDeps" + "sandboxProfile" + "propagatedSandboxProfile" + ] + ++ optional (__structuredAttrs || envIsExportable) "env" + )) + // (optionalAttrs (attrs ? name || (attrs ? pname && attrs ? version)) { + name = + let + # Indicate the host platform of the derivation if cross compiling. + # Fixed-output derivations like source tarballs shouldn't get a host + # suffix. But we have some weird ones with run-time deps that are + # just used for their side-affects. Those might as well since the + # hash can't be the same. See #32986. + hostSuffix = + optionalString + (stdenv.hostPlatform != stdenv.buildPlatform && !dontAddHostSuffix) + "-${stdenv.hostPlatform.config}"; + + # Disambiguate statically built packages. This was originally + # introduce as a means to prevent nix-env to get confused between + # nix and nixStatic. This should be also achieved by moving the + # hostSuffix before the version, so we could contemplate removing + # it again. + staticMarker = optionalString stdenv.hostPlatform.isStatic "-static"; + in + lib.strings.sanitizeDerivationName ( + if attrs ? name then + attrs.name + hostSuffix + else + # we cannot coerce null to a string below + assert assertMsg (attrs ? version && attrs.version != null) + "The ‘version’ attribute cannot be null."; + "${attrs.pname}${staticMarker}${hostSuffix}-${attrs.version}" + ); + }) + // optionalAttrs __structuredAttrs { env = checkedEnv; } + // { + builder = attrs.realBuilder or stdenv.shell; + args = + attrs.args or [ + "-e" + (attrs.builder or ./default-builder.sh) + ]; + inherit stdenv; + + # The `system` attribute of a derivation has special meaning to Nix. + # Derivations set it to choose what sort of machine could be used to + # execute the build, The build platform entirely determines this, + # indeed more finely than Nix knows or cares about. The `system` + # attribute of `buildPlatfom` matches Nix's degree of specificity. + # exactly. + inherit (stdenv.buildPlatform) system; + + userHook = config.stdenv.userHook or null; + __ignoreNulls = true; + inherit __structuredAttrs strictDeps; + + depsBuildBuild = elemAt (elemAt dependencies 0) 0; + nativeBuildInputs = elemAt (elemAt dependencies 0) 1; + depsBuildTarget = elemAt (elemAt dependencies 0) 2; + depsHostHost = elemAt (elemAt dependencies 1) 0; + buildInputs = elemAt (elemAt dependencies 1) 1; + depsTargetTarget = elemAt (elemAt dependencies 2) 0; + + depsBuildBuildPropagated = elemAt (elemAt propagatedDependencies 0) 0; + propagatedNativeBuildInputs = elemAt (elemAt propagatedDependencies 0) 1; + depsBuildTargetPropagated = elemAt (elemAt propagatedDependencies 0) 2; + depsHostHostPropagated = elemAt (elemAt propagatedDependencies 1) 0; + propagatedBuildInputs = elemAt (elemAt propagatedDependencies 1) 1; + depsTargetTargetPropagated = elemAt (elemAt propagatedDependencies 2) 0; + + # This parameter is sometimes a string, sometimes null, and sometimes a list, yuck + configureFlags = + configureFlags + ++ + optional (elem "build" configurePlatforms) + "--build=${stdenv.buildPlatform.config}" + ++ + optional (elem "host" configurePlatforms) + "--host=${stdenv.hostPlatform.config}" + ++ + optional (elem "target" configurePlatforms) + "--target=${stdenv.targetPlatform.config}"; + + cmakeFlags = + cmakeFlags + ++ optionals (stdenv.hostPlatform != stdenv.buildPlatform) ( + [ + "-DCMAKE_SYSTEM_NAME=${ + findFirst isString "Generic" ( + optional (!stdenv.hostPlatform.isRedox) stdenv.hostPlatform.uname.system + ) + }" + ] + ++ optionals (stdenv.hostPlatform.uname.processor != null) [ + "-DCMAKE_SYSTEM_PROCESSOR=${stdenv.hostPlatform.uname.processor}" + ] + ++ optionals (stdenv.hostPlatform.uname.release != null) [ + "-DCMAKE_SYSTEM_VERSION=${stdenv.hostPlatform.uname.release}" + ] + ++ optionals (stdenv.hostPlatform.isDarwin) [ + "-DCMAKE_OSX_ARCHITECTURES=${stdenv.hostPlatform.darwinArch}" + ] + ++ optionals (stdenv.buildPlatform.uname.system != null) [ + "-DCMAKE_HOST_SYSTEM_NAME=${stdenv.buildPlatform.uname.system}" + ] + ++ optionals (stdenv.buildPlatform.uname.processor != null) [ + "-DCMAKE_HOST_SYSTEM_PROCESSOR=${stdenv.buildPlatform.uname.processor}" + ] + ++ optionals (stdenv.buildPlatform.uname.release != null) [ + "-DCMAKE_HOST_SYSTEM_VERSION=${stdenv.buildPlatform.uname.release}" + ] + ++ optionals (stdenv.buildPlatform.canExecute stdenv.hostPlatform) [ + "-DCMAKE_CROSSCOMPILING_EMULATOR=env" + ] + ); + + mesonFlags = + let + # See https://mesonbuild.com/Reference-tables.html#cpu-families + cpuFamily = + platform: + with platform; + if isAarch32 then + "arm" + else if isx86_32 then + "x86" + else + platform.uname.processor; + + crossFile = builtins.toFile "cross-file.conf" '' + [properties] + needs_exe_wrapper = ${ + boolToString (!stdenv.buildPlatform.canExecute stdenv.hostPlatform) + } + + [host_machine] + system = '${stdenv.targetPlatform.parsed.kernel.name}' + cpu_family = '${cpuFamily stdenv.targetPlatform}' + cpu = '${stdenv.targetPlatform.parsed.cpu.name}' + endian = ${if stdenv.targetPlatform.isLittleEndian then "'little'" else "'big'"} + + [binaries] + llvm-config = 'llvm-config-native' + ''; + crossFlags = optionals (stdenv.hostPlatform != stdenv.buildPlatform) [ + "--cross-file=${crossFile}" + ]; + in + crossFlags ++ mesonFlags; + + inherit patches; + + inherit doCheck doInstallCheck; + + inherit outputs; + } + // optionalAttrs (__contentAddressed) { + inherit __contentAddressed; + # Provide default values for outputHashMode and outputHashAlgo because + # most people won't care about these anyways + outputHashAlgo = attrs.outputHashAlgo or "sha256"; + outputHashMode = attrs.outputHashMode or "recursive"; + } + // optionalAttrs (enableParallelBuilding) { + inherit enableParallelBuilding; + enableParallelChecking = attrs.enableParallelChecking or true; + enableParallelInstalling = attrs.enableParallelInstalling or true; + } + // + optionalAttrs + ( + hardeningDisable != [ ] || hardeningEnable != [ ] || stdenv.hostPlatform.isMusl + ) + { NIX_HARDENING_ENABLE = enabledHardeningOptions; } + // + optionalAttrs (stdenv.hostPlatform.isx86_64 && stdenv.hostPlatform ? gcc.arch) + { + requiredSystemFeatures = attrs.requiredSystemFeatures or [ ] ++ [ + "gccarch-${stdenv.hostPlatform.gcc.arch}" + ]; + } + // optionalAttrs (stdenv.buildPlatform.isDarwin) { + inherit __darwinAllowLocalNetworking; + # TODO: remove `unique` once nix has a list canonicalization primitive + __sandboxProfile = + let + profiles = + [ stdenv.extraSandboxProfile ] + ++ computedSandboxProfile + ++ computedPropagatedSandboxProfile + ++ [ + propagatedSandboxProfile + sandboxProfile + ]; + final = concatStringsSep "\n" (filter (x: x != "") (unique profiles)); + in + final; + __propagatedSandboxProfile = unique ( + computedPropagatedSandboxProfile ++ [ propagatedSandboxProfile ] + ); + __impureHostDeps = + computedImpureHostDeps + ++ computedPropagatedImpureHostDeps + ++ __propagatedImpureHostDeps + ++ __impureHostDeps + ++ stdenv.__extraImpureHostDeps + ++ [ + "/dev/zero" + "/dev/random" + "/dev/urandom" + "/bin/sh" + ]; + __propagatedImpureHostDeps = + computedPropagatedImpureHostDeps ++ __propagatedImpureHostDeps; + } + // + # If we use derivations directly here, they end up as build-time dependencies. + # This is especially problematic in the case of disallowed*, since the disallowed + # derivations will be built by nix as build-time dependencies, while those + # derivations might take a very long time to build, or might not even build + # successfully on the platform used. + # We can improve on this situation by instead passing only the outPath, + # without an attached string context, to nix. The out path will be a placeholder + # which will be replaced by the actual out path if the derivation in question + # is part of the final closure (and thus needs to be built). If it is not + # part of the final closure, then the placeholder will be passed along, + # but in that case we know for a fact that the derivation is not part of the closure. + # This means that passing the out path to nix does the right thing in either + # case, both for disallowed and allowed references/requisites, and we won't + # build the derivation if it wouldn't be part of the closure, saving time and resources. + # While the problem is less severe for allowed*, since we want the derivation + # to be built eventually, we would still like to get the error early and without + # having to wait while nix builds a derivation that might not be used. + # See also https://github.com/NixOS/nix/issues/4629 + optionalAttrs (attrs ? disallowedReferences) { + disallowedReferences = + map unsafeDerivationToUntrackedOutpath + attrs.disallowedReferences; + } + // optionalAttrs (attrs ? disallowedRequisites) { + disallowedRequisites = + map unsafeDerivationToUntrackedOutpath + attrs.disallowedRequisites; + } + // optionalAttrs (attrs ? allowedReferences) { + allowedReferences = + mapNullable unsafeDerivationToUntrackedOutpath + attrs.allowedReferences; + } + // optionalAttrs (attrs ? allowedRequisites) { + allowedRequisites = + mapNullable unsafeDerivationToUntrackedOutpath + attrs.allowedRequisites; + }; + + meta = checkMeta.commonMeta { + inherit + validity + attrs + pos + references + ; + }; + validity = checkMeta.assertValidity { inherit meta attrs; }; + + checkedEnv = + let + overlappingNames = attrNames (builtins.intersectAttrs env derivationArg); + in + assert assertMsg envIsExportable + "When using structured attributes, `env` must be an attribute set of environment variables."; + assert assertMsg (overlappingNames == [ ]) + "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${ + concatStringsSep ", " overlappingNames + }"; + mapAttrs + ( + n: v: + assert assertMsg (isString v || isBool v || isInt v || isDerivation v) + "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${ + builtins.typeOf v + }."; + v + ) + env; + in + + extendDerivation validity.handled + ( + { + # A derivation that always builds successfully and whose runtime + # dependencies are the original derivations build time dependencies + # This allows easy building and distributing of all derivations + # needed to enter a nix-shell with + # nix-build shell.nix -A inputDerivation + inputDerivation = derivation ( + derivationArg + // { + # Add a name in case the original drv didn't have one + name = derivationArg.name or "inputDerivation"; + # This always only has one output + outputs = [ "out" ]; + + # Propagate the original builder and arguments, since we override + # them and they might contain references to build inputs + _derivation_original_builder = derivationArg.builder; + _derivation_original_args = derivationArg.args; + + builder = stdenv.shell; + # The bash builtin `export` dumps all current environment variables, + # which is where all build input references end up (e.g. $PATH for + # binaries). By writing this to $out, Nix can find and register + # them as runtime dependencies (since Nix greps for store paths + # through $out to find them) + args = [ + "-c" + '' + export > $out + for var in $passAsFile; do + pathVar="''${var}Path" + printf "%s" "$(< "''${!pathVar}")" >> $out + done + '' + ]; + + # inputDerivation produces the inputs; not the outputs, so any + # restrictions on what used to be the outputs don't serve a purpose + # anymore. + allowedReferences = null; + allowedRequisites = null; + disallowedReferences = [ ]; + disallowedRequisites = [ ]; + } + ); + + inherit passthru overrideAttrs; + inherit meta; + } + // + # Pass through extra attributes that are not inputs, but + # should be made available to Nix expressions using the + # derivation (e.g., in assertions). + passthru + ) + (derivation (derivationArg // optionalAttrs envIsExportable checkedEnv)); +in +fnOrAttrs: +if builtins.isFunction fnOrAttrs then + makeDerivationExtensible fnOrAttrs +else + makeDerivationExtensibleConst fnOrAttrs From 8a5109b803f0551bd930b172f1b256888153cd50 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 17 Nov 2023 15:46:45 +0100 Subject: [PATCH 076/125] Types: introduce mapLastToken This will be required for migrating some comments in function declarations --- src/Nixfmt/Types.hs | 73 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 71 insertions(+), 2 deletions(-) diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 36354e66..cd92bba5 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -4,12 +4,13 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase #-} +{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase, TupleSections #-} module Nixfmt.Types where import Prelude hiding (String) +import Data.List.NonEmpty as NonEmpty import Control.Monad.State (StateT) import Data.Bifunctor (first) import Data.Foldable (toList) @@ -56,7 +57,7 @@ newtype Items a = Items { unItems :: [Item a] } deriving (Show) instance Eq a => Eq (Items a) where - (==) = (==) `on` concatMap toList . unItems + (==) = (==) `on` concatMap Data.Foldable.toList . unItems type Leaf = Ann Token @@ -141,12 +142,47 @@ class LanguageElement a where -- returned. This is useful for getting/extracting values mapFirstToken' :: (forall b. Ann b -> (Ann b, c)) -> a -> (a, c) + -- Map the last token of that expression, no matter how deep it sits + -- in the AST. This is useful for modifying comments + mapLastToken :: (forall b. Ann b -> Ann b) -> a -> a + mapLastToken f a = fst (mapLastToken' (\x -> (f x, ())) a) + + -- Same as mapLastToken, but the mapping function also yields a value that may be + -- returned. This is useful for getting/extracting values + mapLastToken' :: (forall b. Ann b -> (Ann b, c)) -> a -> (a, c) + +instance LanguageElement (Ann a) where + mapFirstToken' f = f + mapLastToken' f = f + +instance LanguageElement SimpleSelector where + mapFirstToken' f = \case + (IDSelector name) -> first IDSelector $ f name + (InterpolSelector name) -> first InterpolSelector $ f name + (StringSelector name) -> first StringSelector $ f name + + mapLastToken' = mapFirstToken' + +instance LanguageElement Selector where + mapFirstToken' f = \case + (Selector Nothing ident def) -> first (\ident' -> Selector Nothing ident' def) $ mapFirstToken' f ident + (Selector (Just dot) ident def) -> first (\dot' -> Selector (Just dot') ident def) $ mapFirstToken' f dot + + mapLastToken' f = \case + (Selector dot ident Nothing) -> first (\ident' -> Selector dot ident' Nothing) $ mapLastToken' f ident + (Selector dot ident (Just (qmark, def))) -> first (Selector dot ident . Just . (qmark,)) $ mapLastToken' f def + instance LanguageElement Parameter where mapFirstToken' f = \case (IDParameter name) -> first IDParameter (f name) (SetParameter open items close) -> first (\open' -> SetParameter open' items close) (f open) (ContextParameter first' at second) -> first (\first'' -> ContextParameter first'' at second) (mapFirstToken' f first') + mapLastToken' f = \case + (IDParameter name) -> first IDParameter (f name) + (SetParameter open items close) -> first (SetParameter open items) (f close) + (ContextParameter first' at second) -> first (ContextParameter first' at) (mapLastToken' f second) + instance LanguageElement Term where mapFirstToken' f = \case (Token leaf) -> first Token (f leaf) @@ -158,6 +194,16 @@ instance LanguageElement Term where (Selection term selector) -> first (\term' -> Selection term' selector) (mapFirstToken' f term) (Parenthesized open expr close) -> first (\open' -> Parenthesized open' expr close) (f open) + mapLastToken' f = \case + (Token leaf) -> first Token (f leaf) + (String string) -> first String (f string) + (Path path) -> first Path (f path) + (List open items close) -> first (List open items) (f close) + (Set rec open items close) -> first (Set rec open items) (f close) + (Selection term []) -> first (\term' -> Selection term' []) (mapLastToken' f term) + (Selection term sels) -> first (Selection term . NonEmpty.toList) (mapLastToken' f $ NonEmpty.fromList sels) + (Parenthesized open expr close) -> first (Parenthesized open expr) (f close) + instance LanguageElement Expression where mapFirstToken' f = \case (Term term) -> first Term (mapFirstToken' f term) @@ -172,10 +218,33 @@ instance LanguageElement Expression where (Negation not_ expr) -> first (\not_' -> Negation not_' expr) (f not_) (Inversion tilde expr) -> first (\tilde' -> Inversion tilde' expr) (f tilde) + mapLastToken' f = \case + (Term term) -> first Term (mapLastToken' f term) + (With with expr0 semicolon expr1) -> first (With with expr0 semicolon) (mapLastToken' f expr1) + (Let let_ items in_ body) -> first (Let let_ items in_) (mapLastToken' f body) + (Assert assert cond semicolon body) -> first (Assert assert cond semicolon) (mapLastToken' f body) + (If if_ expr0 then_ expr1 else_ expr2) -> first (If if_ expr0 then_ expr1 else_) (mapLastToken' f expr2) + (Abstraction param colon body) -> first (Abstraction param colon) (mapLastToken' f body) + (Application g a) -> first (Application g) (mapLastToken' f a) + (Operation left op right) -> first (Operation left op) (mapLastToken' f right) + (MemberCheck name dot []) -> first (\dot' -> MemberCheck name dot' []) (mapLastToken' f dot) + (MemberCheck name dot sels) -> first (MemberCheck name dot . NonEmpty.toList) (mapLastToken' f $ NonEmpty.fromList sels) + (Negation not_ expr) -> first (Negation not_) (mapLastToken' f expr) + (Inversion tilde expr) -> first (Inversion tilde) (mapLastToken' f expr) + instance LanguageElement a => LanguageElement (Whole a) where mapFirstToken' f (Whole a trivia) = first (\a' -> Whole a' trivia) (mapFirstToken' f a) + mapLastToken' f (Whole a trivia) + = first (\a' -> Whole a' trivia) (mapLastToken' f a) + +instance LanguageElement a => LanguageElement (NonEmpty a) where + mapFirstToken' f (x :| _) = first pure $ mapFirstToken' f x + + mapLastToken' f (x :| []) = first pure $ mapLastToken' f x + mapLastToken' f (x :| xs) = first ((x :|) . NonEmpty.toList) $ mapLastToken' f (NonEmpty.fromList xs) + data Token = Integer Int | Float Double From 55aae759e3a554edf7eefa7ec758f278f560849d Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 17 Nov 2023 17:14:41 +0100 Subject: [PATCH 077/125] Function declarations: fixup commas and comments more The previous code was missing quite a few important edge cases, now most should be handled --- src/Nixfmt/Pretty.hs | 58 +++++++++++++++++++++++---------- test/diff/idioms_pkgs_5/out.nix | 46 +++++++++----------------- test/diff/monsters_1/out.nix | 45 +++++++++---------------- test/diff/pattern/out.nix | 6 ++-- 4 files changed, 73 insertions(+), 82 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index b15939be..fda343c9 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes, TupleSections #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes, TupleSections, LambdaCase #-} module Nixfmt.Pretty where @@ -24,7 +24,7 @@ import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), Token(..), TrailingComment(..), Trivium(..), - Whole(..), tokenText, mapFirstToken') + Whole(..), tokenText, mapFirstToken', mapLastToken') import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) prettyCommentLine :: Text -> Doc @@ -258,28 +258,49 @@ instance Pretty ParamAttr where pretty (ParamEllipsis ellipsis) = pretty ellipsis --- Move comments around and inject trailing commas everywhere -moveParamAttrComment :: ParamAttr -> ParamAttr --- Simple parameter, move comment around -- Move comments around when switching from leading comma to trailing comma style: -- `, name # foo` → `name, #foo` -moveParamAttrComment (ParamAttr (Ann trivia name (Just comment')) Nothing (Just (Ann trivia' comma Nothing))) - = ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann trivia' comma (Just comment'))) --- Simple parameter, move comment around and add trailing comma --- Same as above, but also add trailing comma -moveParamAttrComment (ParamAttr (Ann trivia name (Just comment')) Nothing Nothing) - = ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] TComma (Just comment'))) --- Other cases, just inject a trailing comma -moveParamAttrComment (ParamAttr name def Nothing) - = ParamAttr name def (Just (Ann [] TComma Nothing)) +-- This only works for lines where the comma does not already have comments associated with it +-- This assumes that all items already have a trailing comma from earlier pre-processing +moveParamAttrComment :: ParamAttr -> ParamAttr +-- Simple parameter +moveParamAttrComment (ParamAttr (Ann trivia name (Just comment')) Nothing (Just (Ann [] comma Nothing))) + = ParamAttr (Ann trivia name Nothing) Nothing (Just (Ann [] comma (Just comment'))) +-- Parameter with default value +moveParamAttrComment (ParamAttr name (Just (qmark, def)) (Just (Ann [] comma Nothing))) + = ParamAttr name (Just (qmark, def')) (Just (Ann [] comma comment')) + where + -- Extract comment at the end of the line + (def', comment') = mapLastToken' (\case + (Ann trivia t (Just comment'')) -> (Ann trivia t Nothing, Just comment'') + ann -> (ann, Nothing) + ) def moveParamAttrComment x = x -- When a `, name` entry has some line comments before it, they are actually attached to the comment -- of the preceding item. Move them to the next one +-- Also adds the trailing comma on the last element if necessary moveParamsComments :: [ParamAttr] -> [ParamAttr] moveParamsComments - ((ParamAttr name maybeDefault (Just (Ann trivia comma Nothing))) : (ParamAttr (Ann [] name' Nothing) maybeDefault' maybeComma') : xs) - = (ParamAttr name maybeDefault (Just (Ann [] comma Nothing))) : moveParamsComments ((ParamAttr (Ann trivia name' Nothing) maybeDefault' maybeComma') : xs) + -- , name1 + -- # comment + -- , name2 + ((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) +-- 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'))] +-- Inject a trailing comma on the last element if nessecary +moveParamsComments [(ParamAttr name def Nothing)] = [ParamAttr name def (Just (Ann [] TComma Nothing))] moveParamsComments (x : xs) = x : moveParamsComments xs moveParamsComments [] = [] @@ -295,10 +316,11 @@ instance Pretty Parameter where pretty (SetParameter bopen attrs bclose) = group $ pretty bopen - <> (surroundWith sep $ nest 2 (sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs)) + <> (surroundWith sep $ nest 2 $ sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) <> pretty bclose where - -- pretty all ParamAttrs, but make the trailing comma of the last element specially + -- pretty all ParamAttrs, but mark the trailing comma of the last element specially + -- This is so that the trailing comma will only be printed in the expanded form handleTrailingComma :: [ParamAttr] -> [Doc] handleTrailingComma [] = [] -- That's the case we're interested in diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 0536bf1f..4492bfb1 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -137,32 +137,20 @@ let # TODO(@Ericson2314): Stop using legacy dep attribute names # host offset -> target offset - depsBuildBuild ? [ ] # -1 -> -1 - , - depsBuildBuildPropagated ? [ ] # -1 -> -1 - , - nativeBuildInputs ? [ ] # -1 -> 0 N.B. Legacy name - , - propagatedNativeBuildInputs ? [ ] # -1 -> 0 N.B. Legacy name - , - depsBuildTarget ? [ ] # -1 -> 1 - , - depsBuildTargetPropagated ? [ ] # -1 -> 1 - , - - depsHostHost ? [ ] # 0 -> 0 - , - depsHostHostPropagated ? [ ] # 0 -> 0 - , - buildInputs ? [ ] # 0 -> 1 N.B. Legacy name - , - propagatedBuildInputs ? [ ] # 0 -> 1 N.B. Legacy name - , - - depsTargetTarget ? [ ] # 1 -> 1 - , - depsTargetTargetPropagated ? [ ] # 1 -> 1 - , + depsBuildBuild ? [ ], # -1 -> -1 + depsBuildBuildPropagated ? [ ], # -1 -> -1 + nativeBuildInputs ? [ ], # -1 -> 0 N.B. Legacy name + propagatedNativeBuildInputs ? [ ], # -1 -> 0 N.B. Legacy name + depsBuildTarget ? [ ], # -1 -> 1 + depsBuildTargetPropagated ? [ ], # -1 -> 1 + + depsHostHost ? [ ], # 0 -> 0 + depsHostHostPropagated ? [ ], # 0 -> 0 + buildInputs ? [ ], # 0 -> 1 N.B. Legacy name + propagatedBuildInputs ? [ ], # 0 -> 1 N.B. Legacy name + + depsTargetTarget ? [ ], # 1 -> 1 + depsTargetTargetPropagated ? [ ], # 1 -> 1 checkInputs ? [ ], installCheckInputs ? [ ], @@ -193,9 +181,8 @@ let # TODO(@Ericson2314): Make unconditional / resolve #33599 # InstallCheck phase - doInstallCheck ? config.doCheckByDefault or false + doInstallCheck ? config.doCheckByDefault or false, - , # TODO(@Ericson2314): Make always true and remove / resolve #178468 strictDeps ? if config.strictDepsByDefault then true @@ -236,9 +223,8 @@ let # but for anything complex, be prepared to debug if enabling. __structuredAttrs ? config.structuredAttrsByDefault or false, - env ? { } + env ? { }, - , ... }@attrs: diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index 7602ee82..f525ca29 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -1,64 +1,49 @@ { # foo - stdenv + stdenv, # foo - , # foo - lib + lib, # foo - , # foo - fetchFromGitLab + fetchFromGitLab, # foo - , # foo - cairo + cairo, # foo - , # foo - desktop-file-utils + desktop-file-utils, # foo - , # foo - gettext + gettext, # foo - , # foo - glib + glib, # foo - , # foo - gtk4 + gtk4, # foo - , # foo - libadwaita + libadwaita, # foo - , # foo - meson + meson, # foo - , # foo - ninja + ninja, # foo - , # foo - pango + pango, # foo - , # foo - pkg-config + pkg-config, # foo - , # foo - python3 + python3, # foo - , # foo - rustPlatform + rustPlatform, # foo - , # foo wrapGAppsHook4, # foo diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 8eec87ef..3bbbf076 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -638,10 +638,9 @@ ? # a # - null + null, # c # - , # d # e @@ -650,10 +649,9 @@ ? # a # - null + null, # f # - , # g # ... From 91acfa07846bd949e6c4e6cf38fa6d8fbf59aa27 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 29 Nov 2023 20:21:45 +0100 Subject: [PATCH 078/125] Tests: add interpolation test --- test/diff/string_interpol/in.nix | 30 ++++++++++++++- test/diff/string_interpol/out.nix | 61 ++++++++++++++++++++++++++++--- 2 files changed, 84 insertions(+), 7 deletions(-) diff --git a/test/diff/string_interpol/in.nix b/test/diff/string_interpol/in.nix index 29a7e92a..a861ff8e 100644 --- a/test/diff/string_interpol/in.nix +++ b/test/diff/string_interpol/in.nix @@ -1 +1,29 @@ -"${/*a*/"${/*b*/"${c}"}"/*d*/}" +[ + "${/*a*/"${/*b*/"${c}"}"/*d*/}" + { + ExecStart = "${pkgs.openarena}/bin/oa_ded +set fs_basepath ${pkgs.openarena}/openarena-0.8.8 +set fs_homepath /var/lib/openarena ${ + concatMapStringsSep (x: x) " " cfg.extraFlags + }"; + description = "${ + optionDescriptionPhrase (class: class == "noun" || class == "conjunction") t1 + } or ${ + optionDescriptionPhrase (class: class == "noun" || class == "conjunction" || class == "composite") + t2 + }"; + ruleset = '' + table ip nat { + chain port_redirects { + type nat hook prerouting priority dstnat + policy accept + + ${builtins.concatStringsSep "\n" (map (e: + "iifname \"${cfg.upstreamIface}\" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" + ) tcpPortMap)} + + ${builtins.concatStringsSep "\n" (map (e: + "ifname \"${cfg.upstreamIface}\" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" + ) udpPortMap)} + } + ''; + } +] diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index 57f4cfdc..78141709 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -1,6 +1,55 @@ -"${ -# a -"${ -# b -"${c}"}" # d -}" +[ + "${ + # a + "${ + # b + "${c}"}" # d + }" + { + ExecStart = "${pkgs.openarena}/bin/oa_ded +set fs_basepath ${pkgs.openarena}/openarena-0.8.8 +set fs_homepath /var/lib/openarena ${ + concatMapStringsSep (x: x) " " cfg.extraFlags + }"; + description = "${ + optionDescriptionPhrase (class: class == "noun" || class == "conjunction") t1 + } or ${ + optionDescriptionPhrase + (class: class == "noun" || class == "conjunction" || class == "composite") + t2 + }"; + ruleset = '' + table ip nat { + chain port_redirects { + type nat hook prerouting priority dstnat + policy accept + + ${ + builtins.concatStringsSep "\n" ( + map + ( + e: + '' + iifname "${cfg.upstreamIface}" tcp dport ${ + builtins.toString e.sourcePort + } dnat to ${e.destination}'' + ) + tcpPortMap + ) + } + + ${ + builtins.concatStringsSep "\n" ( + map + ( + e: + '' + ifname "${cfg.upstreamIface}" udp dport ${ + builtins.toString e.sourcePort + } dnat to ${e.destination}'' + ) + udpPortMap + ) + } + } + ''; + } +] From 064bf4dd0c5c7bea7defb4fe4b991fca9b95321a Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 17 Nov 2023 22:25:03 +0100 Subject: [PATCH 079/125] String interpolations: Ignore line length limits Interpolations in strings that are shorter than 30 characters will be rendered inline, even if the string exeeds the line length limit. --- src/Nixfmt/Predoc.hs | 19 ++++++++++++++++++- src/Nixfmt/Pretty.hs | 30 +++++++++++++++++++++++------- test/diff/idioms_lib_3/out.nix | 4 +--- test/diff/idioms_lib_5/out.nix | 4 +--- test/diff/idioms_nixos_2/out.nix | 12 +++--------- test/diff/idioms_pkgs_3/out.nix | 4 +--- test/diff/idioms_pkgs_5/out.nix | 4 +--- test/diff/string_interpol/out.nix | 8 ++------ 8 files changed, 50 insertions(+), 35 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 6c4352d3..8344739a 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -31,6 +31,7 @@ module Nixfmt.Predoc , Pretty , pretty , fixup + , unexpandSpacing' , layout , textWidth ) where @@ -239,7 +240,7 @@ isComment (Node _ inner) = all (\x -> isComment x || isHardSpacing x) inner isComment _ = False --- Manually force a group to its compact layout, by replacing all relevant whitespace. ---- Does recurse into inner groups. +--- Does not recurse into inner groups. unexpandSpacing :: Doc -> Doc unexpandSpacing [] = [] unexpandSpacing ((Spacing Space):xs) = Spacing Hardspace : unexpandSpacing xs @@ -252,6 +253,22 @@ unexpandSpacing (x:xs) = x : unexpandSpacing xs spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) spanEnd p = fmap reverse . span p . reverse +-- Manually force a group to its compact layout, by replacing all relevant whitespace. +-- Does recurse into inner groups. +-- An optional maximum line length limit may be specified. +-- Fails if the doc contains hardlines or exceeds the length limit +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 (Spacing Break:xs) = unexpandSpacing' n xs +unexpandSpacing' n (Spacing Softbreak:xs) = unexpandSpacing' n xs +unexpandSpacing' _ (Spacing _:_) = Nothing +unexpandSpacing' n ((Node _ xs):ys) = unexpandSpacing' n $ xs <> ys + -- | Fix up a Doc: -- - Move some spacings (those which are not relevant for group calculations) -- out of the start/end of Groups and Nests if possible. diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index fda343c9..88c6ff3f 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -14,12 +14,13 @@ import Data.Char (isSpace) import Data.Maybe (fromMaybe) import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix) import qualified Data.Text as Text - (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile) + (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile, all) -- import Debug.Trace (traceShowId) import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailing, textWidth) + nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailing, textWidth, + unexpandSpacing') import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), @@ -609,20 +610,35 @@ isSimpleString parts instance Pretty StringPart where pretty (TextPart t) = text t + + -- Absorb terms + -- This is exceedingly rare (why would one do this anyways?); one instance in the entire Nixpkgs pretty (Interpolation (Whole (Term t) [])) | isAbsorbable t = group $ text "${" <> prettyTerm t <> text "}" + -- For "simple" interpolations (see isSimple, but mostly just identifiers), + -- force onto one line, regardless of length pretty (Interpolation (Whole expr [])) | isSimple expr - = text "${" <> pretty expr <> text "}" + = text "${" <> fromMaybe (pretty expr) (unexpandSpacing' Nothing (pretty expr)) <> text "}" - pretty (Interpolation whole) - = group $ text "${" <> line' - <> nest 2 (pretty whole) <> line' - <> text "}" + -- For interpolations, we try to render the content, to see how long it will be. + -- If the interpolation is single-line and shorter than 30 characters, we force it + -- onto that line, even if this would make it go over the line limit. + pretty (Interpolation whole) = + group $ text "${" <> inner <> text "}" + where + whole' = pretty whole + inner = fromMaybe + -- default + (surroundWith line' $ nest 2 $ whole') + -- force on one line if possible + (unexpandSpacing' (Just 30) whole') instance Pretty [StringPart] where + -- When the interpolation is the only thing on the string line, + -- then absorb the content (i.e. don't surround with line') pretty [Interpolation expr] = group $ text "${" <> pretty expr <> text "}" diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 91a693e2..fc603848 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -309,9 +309,7 @@ rec { if depthLimit != null && depth > depthLimit then if throwOnDepthLimit then throw - "Exceeded maximum eval-depth limit of ${ - toString depthLimit - } while trying to evaluate with `generators.withRecursion'!" + "Exceeded maximum eval-depth limit of ${toString depthLimit} while trying to evaluate with `generators.withRecursion'!" else const "" else diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 61424dc6..33f0aa69 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -181,9 +181,7 @@ let flakeNote = "\n Note: For `nix shell`, `nix build`, `nix develop` or any other Nix 2.4+\n (Flake) command, `--impure` must be passed in order to read this\n environment variable.\n "; remediate_allowlist = allow_attr: rebuild_amendment: attrs: '' - a) To temporarily allow ${ - remediation_phrase allow_attr - }, you can use an environment variable + a) To temporarily allow ${remediation_phrase allow_attr}, you can use an environment variable for a single invocation of the nix tools. $ export ${remediation_env_var allow_attr}=1 diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 3a01554d..1a1a22af 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -756,12 +756,8 @@ in upgradeWarning = major: nixos: '' A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. - After nextcloud${ - toString major - } is installed successfully, you can safely upgrade - to ${toString (major + 1)}. The latest version available is nextcloud${ - toString latest - }. + After nextcloud${toString major} is installed successfully, you can safely upgrade + to ${toString (major + 1)}. The latest version available is nextcloud${toString latest}. Please note that Nextcloud doesn't support upgrades across multiple major versions (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). @@ -1271,9 +1267,7 @@ in add_header Referrer-Policy no-referrer; ''} ${optionalString (cfg.https) '' - add_header Strict-Transport-Security "max-age=${ - toString cfg.nginx.hstsMaxAge - }; includeSubDomains" always; + add_header Strict-Transport-Security "max-age=${toString cfg.nginx.hstsMaxAge}; includeSubDomains" always; ''} client_max_body_size ${cfg.maxUploadSize}; fastcgi_buffers 64 4K; diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index d10db2a6..d0814a23 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -564,9 +564,7 @@ buildStdenv.mkDerivation ({ ''; postFixup = lib.optionalString crashreporterSupport '' - patchelf --add-rpath "${ - lib.makeLibraryPath [ curl ] - }" $out/lib/${binaryName}/crashreporter + patchelf --add-rpath "${lib.makeLibraryPath [ curl ]}" $out/lib/${binaryName}/crashreporter ''; doInstallCheck = true; diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 4492bfb1..aed3c20d 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -748,9 +748,7 @@ let ( n: v: assert assertMsg (isString v || isBool v || isInt v || isDerivation v) - "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${ - builtins.typeOf v - }."; + "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${builtins.typeOf v}."; v ) env; diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index 78141709..645815ab 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -28,9 +28,7 @@ ( e: '' - iifname "${cfg.upstreamIface}" tcp dport ${ - builtins.toString e.sourcePort - } dnat to ${e.destination}'' + iifname "${cfg.upstreamIface}" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' ) tcpPortMap ) @@ -42,9 +40,7 @@ ( e: '' - ifname "${cfg.upstreamIface}" udp dport ${ - builtins.toString e.sourcePort - } dnat to ${e.destination}'' + ifname "${cfg.upstreamIface}" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' ) udpPortMap ) From 9d7317fdf74f5c48001728874d90c8e312af0c6f Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 18 Nov 2023 18:34:42 +0100 Subject: [PATCH 080/125] String interpolations: compact function applications Function applications up to two simple arguments are now counted as "simple" and written on a single line --- src/Nixfmt/Pretty.hs | 5 +++++ test/diff/idioms_lib_5/out.nix | 12 +++--------- test/diff/idioms_nixos_2/out.nix | 4 +--- test/diff/idioms_pkgs_3/out.nix | 4 +--- test/diff/idioms_pkgs_5/out.nix | 4 +--- test/diff/string/out.nix | 4 +--- 6 files changed, 12 insertions(+), 21 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 88c6ff3f..2c991d02 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -547,9 +547,14 @@ isSimpleSelector (Selector _ (IDSelector _) Nothing) = True isSimpleSelector _ = False isSimple :: Expression -> Bool +isSimple (Term (String (Ann [] _ Nothing))) = True +isSimple (Term (Path (Ann [] _ Nothing))) = True isSimple (Term (Token (Ann [] (Identifier _) Nothing))) = True isSimple (Term (Selection t selectors)) = isSimple (Term t) && all isSimpleSelector selectors +-- Function applications of simple terms are simple up to two arguments +isSimple (Application (Application (Application _ _) _) _) = False +isSimple (Application f a) = isSimple f && isSimple a isSimple _ = False hasQuotes :: [StringPart] -> Bool diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 33f0aa69..2e1fc333 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -246,13 +246,9 @@ let expectedOutputs; in '' - The package ${getName attrs} has set meta.outputsToInstall to: ${ - builtins.concatStringsSep ", " expectedOutputs - } + The package ${getName attrs} has set meta.outputsToInstall to: ${builtins.concatStringsSep ", " expectedOutputs} - however ${getName attrs} only has the outputs: ${ - builtins.concatStringsSep ", " actualOutputs - } + however ${getName attrs} only has the outputs: ${builtins.concatStringsSep ", " actualOutputs} and is missing the following ouputs: @@ -471,9 +467,7 @@ let { valid = "no"; reason = "non-source"; - errormsg = "contains elements not built from source (‘${ - showSourceType attrs.meta.sourceProvenance - }’)"; + errormsg = "contains elements not built from source (‘${showSourceType attrs.meta.sourceProvenance}’)"; } else if !allowBroken && attrs.meta.broken or false then { diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 1a1a22af..d54c2fc9 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -928,9 +928,7 @@ in } 'datadirectory' => '${datadir}/data', 'skeletondirectory' => '${cfg.skeletonDirectory}', - ${ - optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu'," - } + ${optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu',"} 'log_type' => '${cfg.logType}', 'loglevel' => '${builtins.toString cfg.logLevel}', ${ diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index d0814a23..fea4751f 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -387,9 +387,7 @@ buildStdenv.mkDerivation ({ "--disable-tests" "--disable-updater" "--enable-application=${application}" - "--enable-default-toolkit=cairo-gtk3${ - lib.optionalString waylandSupport "-wayland" - }" + "--enable-default-toolkit=cairo-gtk3${lib.optionalString waylandSupport "-wayland"}" "--enable-system-pixman" "--with-distribution-id=org.nixos" "--with-libclang-path=${llvmPackagesBuildBuild.libclang.lib}/lib" diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index aed3c20d..67d7cc4e 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -741,9 +741,7 @@ let assert assertMsg envIsExportable "When using structured attributes, `env` must be an attribute set of environment variables."; assert assertMsg (overlappingNames == [ ]) - "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${ - concatStringsSep ", " overlappingNames - }"; + "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; mapAttrs ( n: v: diff --git a/test/diff/string/out.nix b/test/diff/string/out.nix index 4da864da..ba505a96 100644 --- a/test/diff/string/out.nix +++ b/test/diff/string/out.nix @@ -62,9 +62,7 @@ [${mkSectionName sectName}] '' ### - "-couch_ini ${cfg.package}/etc/default.ini ${configFile} ${ - pkgs.writeText "couchdb-extra.ini" cfg.extraConfig - } ${cfg.configFile}" + "-couch_ini ${cfg.package}/etc/default.ini ${configFile} ${pkgs.writeText "couchdb-extra.ini" cfg.extraConfig} ${cfg.configFile}" ### ''exec i3-input -F "mark %s" -l 1 -P 'Mark: ' '' ### From 46d12b2a55268f9148879b8109a5d586bece7716 Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 18 Nov 2023 18:35:26 +0100 Subject: [PATCH 081/125] Function application: Compact simple functions "Simple" function applications will always be rendered on a single line. --- src/Nixfmt/Pretty.hs | 16 +++++++++++----- test/diff/idioms_lib_2/out.nix | 4 +--- test/diff/idioms_lib_3/out.nix | 3 +-- test/diff/idioms_lib_4/out.nix | 5 ++--- test/diff/idioms_pkgs_5/out.nix | 30 ++++++++---------------------- 5 files changed, 23 insertions(+), 35 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 2c991d02..adb05350 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -11,7 +11,7 @@ module Nixfmt.Pretty where import Prelude hiding (String) import Data.Char (isSpace) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix) import qualified Data.Text as Text (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile, all) @@ -378,11 +378,17 @@ prettyApp commentPre pre post commentPost f a -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing') -> (Ann [] token trailing', leading)) f - in + + renderedF = pre <> group (absorbApp fWithoutComment) + renderedFUnexpanded = unexpandSpacing' Nothing renderedF + in (if null comment' then mempty else commentPre) - <> pretty comment' <> (group' False $ - pre <> group (absorbApp fWithoutComment) <> line <> absorbLast a <> post) - <> (if null comment' then mempty else commentPost) + <> pretty comment' <> ( + if isSimple (Application f a) && isJust (renderedFUnexpanded) then + (group' False $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a <> post) + else + (group' False $ renderedF <> line <> absorbLast a <> post) + ) <> (if null comment' then mempty else commentPost) isAbstractionWithAbsorbableTerm :: Expression -> Bool isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 8d60856b..83afa15a 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -217,9 +217,7 @@ rec { else default; - nixpkgsVersion = - builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" - version; + nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version; /* Determine whether the function is being called from inside a Nix shell. diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index fc603848..b8d30794 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -308,8 +308,7 @@ rec { depth: if depthLimit != null && depth > depthLimit then if throwOnDepthLimit then - throw - "Exceeded maximum eval-depth limit of ${toString depthLimit} while trying to evaluate with `generators.withRecursion'!" + throw "Exceeded maximum eval-depth limit of ${toString depthLimit} while trying to evaluate with `generators.withRecursion'!" else const "" else diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index 3953f448..5df581a3 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -828,9 +828,8 @@ rec { abi = elemAt l 3; }; } - .${toString (length l)} or (throw - "system string has invalid number of hyphen-separated components" - ); + .${toString (length l)} + or (throw "system string has invalid number of hyphen-separated components"); # This should revert the job done by config.guess from the gcc compiler. mkSystemFromSkeleton = diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 67d7cc4e..436f046b 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -328,8 +328,7 @@ let else if isList dep then checkDependencyList' ([ index ] ++ positions) name dep else - throw - "Dependency is not of a valid type: ${ + throw "Dependency is not of a valid type: ${ concatMapStrings (ix: "element ${toString ix} of ") ([ index ] ++ positions) }${name} for ${attrs.name or attrs.pname}" ); @@ -356,12 +355,8 @@ let ++ optionals doInstallCheck installCheckInputs; nativeBuildInputs' = nativeBuildInputs - ++ - optional separateDebugInfo' - ../../build-support/setup-hooks/separate-debug-info.sh - ++ - optional stdenv.hostPlatform.isWindows - ../../build-support/setup-hooks/win-dll-link.sh + ++ optional separateDebugInfo' ../../build-support/setup-hooks/separate-debug-info.sh + ++ optional stdenv.hostPlatform.isWindows ../../build-support/setup-hooks/win-dll-link.sh ++ optionals doCheck nativeCheckInputs ++ optionals doInstallCheck nativeInstallCheckInputs; @@ -704,24 +699,16 @@ let # having to wait while nix builds a derivation that might not be used. # See also https://github.com/NixOS/nix/issues/4629 optionalAttrs (attrs ? disallowedReferences) { - disallowedReferences = - map unsafeDerivationToUntrackedOutpath - attrs.disallowedReferences; + disallowedReferences = map unsafeDerivationToUntrackedOutpath attrs.disallowedReferences; } // optionalAttrs (attrs ? disallowedRequisites) { - disallowedRequisites = - map unsafeDerivationToUntrackedOutpath - attrs.disallowedRequisites; + disallowedRequisites = map unsafeDerivationToUntrackedOutpath attrs.disallowedRequisites; } // optionalAttrs (attrs ? allowedReferences) { - allowedReferences = - mapNullable unsafeDerivationToUntrackedOutpath - attrs.allowedReferences; + allowedReferences = mapNullable unsafeDerivationToUntrackedOutpath attrs.allowedReferences; } // optionalAttrs (attrs ? allowedRequisites) { - allowedRequisites = - mapNullable unsafeDerivationToUntrackedOutpath - attrs.allowedRequisites; + allowedRequisites = mapNullable unsafeDerivationToUntrackedOutpath attrs.allowedRequisites; }; meta = checkMeta.commonMeta { @@ -738,8 +725,7 @@ let let overlappingNames = attrNames (builtins.intersectAttrs env derivationArg); in - assert assertMsg envIsExportable - "When using structured attributes, `env` must be an attribute set of environment variables."; + assert assertMsg envIsExportable "When using structured attributes, `env` must be an attribute set of environment variables."; assert assertMsg (overlappingNames == [ ]) "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; mapAttrs From 62fe12f8e04ae61c8305847b64d242a97e4a499b Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 18 Nov 2023 18:33:23 +0100 Subject: [PATCH 082/125] String interpolations: Fix indentation --- src/Nixfmt/Pretty.hs | 4 ++-- test/diff/idioms_pkgs_5/out.nix | 4 ++-- test/diff/string_interpol/out.nix | 16 ++++++++-------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index adb05350..9150255c 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -657,10 +657,10 @@ instance Pretty [StringPart] where -- interpolations, make sure to indent based on the indentation of the line -- in the string. pretty (TextPart t : parts) - = text t <> nest indentation (hcat parts) + = text t <> base (nest indentation (hcat parts)) where indentation = textWidth $ Text.takeWhile isSpace t - pretty parts = hcat parts + pretty parts = base $ hcat parts instance Pretty [[StringPart]] where pretty parts diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 436f046b..6558e245 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -329,8 +329,8 @@ let checkDependencyList' ([ index ] ++ positions) name dep else throw "Dependency is not of a valid type: ${ - concatMapStrings (ix: "element ${toString ix} of ") ([ index ] ++ positions) - }${name} for ${attrs.name or attrs.pname}" + concatMapStrings (ix: "element ${toString ix} of ") ([ index ] ++ positions) + }${name} for ${attrs.name or attrs.pname}" ); in if builtins.length erroneousHardeningFlags != 0 then diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index 645815ab..50e89762 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -7,15 +7,15 @@ }" { ExecStart = "${pkgs.openarena}/bin/oa_ded +set fs_basepath ${pkgs.openarena}/openarena-0.8.8 +set fs_homepath /var/lib/openarena ${ - concatMapStringsSep (x: x) " " cfg.extraFlags - }"; + concatMapStringsSep (x: x) " " cfg.extraFlags + }"; description = "${ - optionDescriptionPhrase (class: class == "noun" || class == "conjunction") t1 - } or ${ - optionDescriptionPhrase - (class: class == "noun" || class == "conjunction" || class == "composite") - t2 - }"; + optionDescriptionPhrase (class: class == "noun" || class == "conjunction") t1 + } or ${ + optionDescriptionPhrase + (class: class == "noun" || class == "conjunction" || class == "composite") + t2 + }"; ruleset = '' table ip nat { chain port_redirects { From 951261e4e60a02bdfe8c0313bb03634bf02507e8 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 29 Nov 2023 21:01:02 +0100 Subject: [PATCH 083/125] Strings: Fix single-line strings with double single quotes --- src/Nixfmt/Pretty.hs | 6 +++++- test/diff/idioms_nixos_2/out.nix | 5 +++-- test/diff/string_interpol/out.nix | 6 ++---- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 9150255c..a38a4806 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -702,7 +702,11 @@ prettySimpleString parts = group $ prettyIndentedString :: [[StringPart]] -> Doc prettyIndentedString parts = group $ base $ - text "''" <> line' + text "''" + -- Usually the `''` is followed by a potential line break. + -- 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 2 (sepBy newline (map (prettyLine escape unescapeInterpol) parts)) <> text "''" where escape = replaceMultiple diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index d54c2fc9..79aeb15c 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -998,8 +998,9 @@ in # will be omitted. ${if c.dbname != null then "--database-name" else null} = ''"${c.dbname}"''; ${if c.dbhost != null then "--database-host" else null} = ''"${c.dbhost}"''; - ${if c.dbport != null then "--database-port" else null} = '' - "${toString c.dbport}"''; + ${ + if c.dbport != null then "--database-port" else null + } = ''"${toString c.dbport}"''; ${if c.dbuser != null then "--database-user" else null} = ''"${c.dbuser}"''; "--database-pass" = ''"''$${dbpass.arg}"''; "--admin-user" = ''"${c.adminuser}"''; diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index 50e89762..27605563 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -27,8 +27,7 @@ map ( e: - '' - iifname "${cfg.upstreamIface}" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' + ''iifname "${cfg.upstreamIface}" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' ) tcpPortMap ) @@ -39,8 +38,7 @@ map ( e: - '' - ifname "${cfg.upstreamIface}" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' + ''ifname "${cfg.upstreamIface}" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' ) udpPortMap ) From 136edf487b0747c0dd0e59614356f306039864c9 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 29 Nov 2023 21:46:26 +0100 Subject: [PATCH 084/125] Inherit: Indent trailing semicolon again This is a manual partial revert of b86d8ea1a4da5c8fdbae9cead59bd06884a9da20 --- src/Nixfmt/Pretty.hs | 16 +-- test/diff/apply/out.nix | 4 +- test/diff/idioms_lib_2/out.nix | 2 +- test/diff/idioms_lib_5/out.nix | 2 +- test/diff/idioms_pkgs_4/out.nix | 2 +- test/diff/idioms_pkgs_5/out.nix | 6 +- test/diff/inherit/out.nix | 18 ++-- test/diff/inherit_blank_trailing/out.nix | 10 +- test/diff/inherit_comment/out.nix | 4 +- test/diff/inherit_from/out.nix | 132 +++++++++++------------ test/diff/monsters_1/out.nix | 2 +- test/diff/monsters_4/out.nix | 2 +- test/diff/monsters_5/out.nix | 8 +- 13 files changed, 105 insertions(+), 103 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index a38a4806..2aa8194a 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -101,17 +101,19 @@ instance Pretty Selector where instance Pretty Binder where -- `inherit bar` statement pretty (Inherit inherit Nothing ids semicolon) - = base $ group (pretty inherit - <> (if null ids then mempty else line <> nest 2 (sepBy (if length ids < 4 then line else hardline) ids) <> line') - <> pretty semicolon) + = base $ group $ pretty inherit + <> (if null ids then pretty semicolon else + line <> nest 2 (sepBy (if length ids < 4 then line else hardline) ids <> line' <> pretty semicolon) + ) -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) - = base $ group (pretty inherit <> nest 2 ( + = base $ group $ pretty inherit <> nest 2 ( (group' False (line <> pretty source)) - <> if null ids then mempty else line - <> sepBy (if length ids < 4 then line else hardline) ids - ) <> line' <> pretty semicolon) + <> if null ids then pretty semicolon else line + <> sepBy (if length ids < 4 then line else hardline) ids + <> line' <> pretty semicolon + ) -- `foo = bar` pretty (Assignment selectors assign expr semicolon) diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index b8788974..4ed0f429 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -225,7 +225,7 @@ mkKeyValue listsAsDuplicateKeys aaaaaaaa - ; + ; } sections ); @@ -237,7 +237,7 @@ mkKeyValue listsAsDuplicateKeys aaaaaaaa - ; + ; } sections; } diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 83afa15a..301f95bc 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -171,7 +171,7 @@ rec { seq deepSeq genericClosure - ; + ; ## nixpkgs version strings diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 2e1fc333..281b3089 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -572,7 +572,7 @@ let broken unsupported insecure - ; + ; available = validity.valid != "no" diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index 5e0a7b34..bc384da7 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -143,7 +143,7 @@ let cc overrides config - ; + ; }; in diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 6558e245..d3e152a3 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -38,7 +38,7 @@ let splitString subtractLists unique - ; + ; checkMeta = import ./check-meta.nix { inherit lib config; @@ -342,7 +342,7 @@ let hardeningDisable hardeningEnable supportedHardeningFlags - ; + ; } ) else @@ -717,7 +717,7 @@ let attrs pos references - ; + ; }; validity = checkMeta.assertValidity { inherit meta attrs; }; diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index 29988371..93a31869 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -16,7 +16,7 @@ h i j - ; + ; } { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } { inherit b d; } @@ -24,43 +24,43 @@ inherit b d # e - ; + ; } { inherit b # c d - ; + ; } { inherit b # c d # e - ; + ; } { inherit # a b d - ; + ; } { inherit # a b d # e - ; + ; } { inherit # a b # c d - ; + ; } { inherit # a b # c d # e - ; + ; } { inherit # test @@ -75,6 +75,6 @@ g h - ; + ; } ] diff --git a/test/diff/inherit_blank_trailing/out.nix b/test/diff/inherit_blank_trailing/out.nix index 4d4419e3..7e8b2469 100644 --- a/test/diff/inherit_blank_trailing/out.nix +++ b/test/diff/inherit_blank_trailing/out.nix @@ -12,7 +12,7 @@ g h - ; + ; } { inherit @@ -25,9 +25,9 @@ b # multiple newlines c # multiple comments - # comment 1 - # comment 2 - # comment 3 - ; + # comment 1 + # comment 2 + # comment 3 + ; } ] diff --git a/test/diff/inherit_comment/out.nix b/test/diff/inherit_comment/out.nix index b86a255c..45c2bb99 100644 --- a/test/diff/inherit_comment/out.nix +++ b/test/diff/inherit_comment/out.nix @@ -3,7 +3,7 @@ a # b c - ; + ; # https://github.com/kamadorueda/alejandra/issues/372 inherit (pkgs.haskell.lib) @@ -14,5 +14,5 @@ # override deps of a package # see what can be overriden - https://github.com/NixOS/nixpkgs/blob/0ba44a03f620806a2558a699dba143e6cf9858db/pkgs/development/haskell-modules/generic-builder.nix#L13 overrideCabal - ; + ; } diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index dd768e04..2264a151 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -14,7 +14,7 @@ seq deepSeq genericClosure - ; + ; } { inherit @@ -24,7 +24,7 @@ }) foo bar - ; + ; } { inherit (a) @@ -38,50 +38,50 @@ i j k - ; + ; } { inherit (c) f h; } { inherit (c) f h # i - ; + ; } { inherit (c) f # g h - ; + ; } { inherit (c) f # g h # i - ; + ; } { inherit (c) # e f h - ; + ; } { inherit (c) # e f h # i - ; + ; } { inherit (c) # e f # g h - ; + ; } { inherit (c) # e f # g h # i - ; + ; } { inherit @@ -90,7 +90,7 @@ ) f h - ; + ; } { inherit @@ -99,7 +99,7 @@ ) f h # i - ; + ; } { inherit @@ -108,7 +108,7 @@ ) f # g h - ; + ; } { inherit @@ -117,7 +117,7 @@ ) f # g h # i - ; + ; } { inherit @@ -126,7 +126,7 @@ ) # e f h - ; + ; } { inherit @@ -135,7 +135,7 @@ ) # e f h # i - ; + ; } { inherit @@ -144,7 +144,7 @@ ) # e f # g h - ; + ; } { inherit @@ -153,7 +153,7 @@ ) # e f # g h # i - ; + ; } { inherit @@ -162,7 +162,7 @@ ) f h - ; + ; } { inherit @@ -171,7 +171,7 @@ ) f h # i - ; + ; } { inherit @@ -180,7 +180,7 @@ ) f # g h - ; + ; } { inherit @@ -189,7 +189,7 @@ ) f # g h # i - ; + ; } { inherit @@ -198,7 +198,7 @@ ) # e f h - ; + ; } { inherit @@ -207,7 +207,7 @@ ) # e f h # i - ; + ; } { inherit @@ -216,7 +216,7 @@ ) # e f # g h - ; + ; } { inherit @@ -225,7 +225,7 @@ ) # e f # g h # i - ; + ; } { inherit @@ -234,7 +234,7 @@ ) f h - ; + ; } { inherit @@ -243,7 +243,7 @@ ) f h # i - ; + ; } { inherit @@ -252,7 +252,7 @@ ) f # g h - ; + ; } { inherit @@ -261,7 +261,7 @@ ) f # g h # i - ; + ; } { inherit @@ -270,7 +270,7 @@ ) # e f h - ; + ; } { inherit @@ -279,7 +279,7 @@ ) # e f h # i - ; + ; } { inherit @@ -288,7 +288,7 @@ ) # e f # g h - ; + ; } { inherit @@ -297,63 +297,63 @@ ) # e f # g h # i - ; + ; } { inherit # a (c) f h - ; + ; } { inherit # a (c) f h # i - ; + ; } { inherit # a (c) f # g h - ; + ; } { inherit # a (c) f # g h # i - ; + ; } { inherit # a (c) # e f h - ; + ; } { inherit # a (c) # e f h # i - ; + ; } { inherit # a (c) # e f # g h - ; + ; } { inherit # a (c) # e f # g h # i - ; + ; } { inherit # a @@ -362,7 +362,7 @@ ) f h - ; + ; } { inherit # a @@ -371,7 +371,7 @@ ) f h # i - ; + ; } { inherit # a @@ -380,7 +380,7 @@ ) f # g h - ; + ; } { inherit # a @@ -389,7 +389,7 @@ ) f # g h # i - ; + ; } { inherit # a @@ -398,7 +398,7 @@ ) # e f h - ; + ; } { inherit # a @@ -407,7 +407,7 @@ ) # e f h # i - ; + ; } { inherit # a @@ -416,7 +416,7 @@ ) # e f # g h - ; + ; } { inherit # a @@ -425,7 +425,7 @@ ) # e f # g h # i - ; + ; } { inherit # a @@ -434,7 +434,7 @@ ) f h - ; + ; } { inherit # a @@ -443,7 +443,7 @@ ) f h # i - ; + ; } { inherit # a @@ -452,7 +452,7 @@ ) f # g h - ; + ; } { inherit # a @@ -461,7 +461,7 @@ ) f # g h # i - ; + ; } { inherit # a @@ -470,7 +470,7 @@ ) # e f h - ; + ; } { inherit # a @@ -479,7 +479,7 @@ ) # e f h # i - ; + ; } { inherit # a @@ -488,7 +488,7 @@ ) # e f # g h - ; + ; } { inherit # a @@ -497,7 +497,7 @@ ) # e f # g h # i - ; + ; } { inherit # a @@ -506,7 +506,7 @@ ) f h - ; + ; } { inherit # a @@ -515,7 +515,7 @@ ) f h # i - ; + ; } { inherit # a @@ -524,7 +524,7 @@ ) f # g h - ; + ; } { inherit # a @@ -533,7 +533,7 @@ ) f # g h # i - ; + ; } { inherit # a @@ -542,7 +542,7 @@ ) # e f h - ; + ; } { inherit # a @@ -551,7 +551,7 @@ ) # e f h # i - ; + ; } { inherit # a @@ -560,7 +560,7 @@ ) # e f # g h - ; + ; } { inherit # a @@ -569,6 +569,6 @@ ) # e f # g h # i - ; + ; } ] diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index f525ca29..7d8c596b 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -124,7 +124,7 @@ stdenv.mkDerivation inherit # foo src - ; + ; # foo name # foo diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 71d0fdc7..d330900d 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -72,7 +72,7 @@ stdenv.mkDerivation # Foo # Foo inherit # Foo src - ; # Foo + ; # Foo name # Foo = # Foo "${pname}-${version}"; # Foo diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index d64c4253..288584f9 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -21,7 +21,7 @@ let (config.boot) kernelPatches - ; + ; inherit @@ -30,14 +30,14 @@ let features randstructSeed - ; + ; inherit (config.boot.kernelPackages) kernel - ; + ; kernelModulesConf @@ -163,7 +163,7 @@ in inherit randstructSeed - ; + ; kernelPatches From 206653bf165c341efe4db81922d159a6d230ea12 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 29 Nov 2023 22:16:02 +0100 Subject: [PATCH 085/125] List, Attrset: Remove surrounding spaces --- src/Nixfmt/Pretty.hs | 22 +++---- test/diff/apply/out.nix | 28 ++++---- test/diff/attr_set/out.nix | 28 ++++---- test/diff/idioms_lib_2/out.nix | 8 +-- test/diff/idioms_lib_3/out.nix | 56 ++++++++-------- test/diff/idioms_lib_4/out.nix | 68 +++++++++---------- test/diff/idioms_lib_5/out.nix | 48 +++++++------- test/diff/idioms_nixos_1/out.nix | 32 ++++----- test/diff/idioms_nixos_2/out.nix | 68 ++++++++++--------- test/diff/idioms_pkgs_1/out.nix | 4 +- test/diff/idioms_pkgs_2/out.nix | 6 +- test/diff/idioms_pkgs_3/out.nix | 32 ++++----- test/diff/idioms_pkgs_4/out.nix | 32 ++++----- test/diff/idioms_pkgs_5/out.nix | 110 +++++++++++++++---------------- test/diff/if_else/out.nix | 2 +- test/diff/inherit/out.nix | 4 +- test/diff/inherit_from/out.nix | 2 +- test/diff/key_value/out.nix | 8 +-- test/diff/lambda/out.nix | 20 +++--- test/diff/lists/out.nix | 10 +-- test/diff/monsters_2/out.nix | 2 +- test/diff/monsters_3/out.nix | 2 +- test/diff/monsters_5/out.nix | 6 +- test/diff/operation/out.nix | 26 ++++---- test/diff/pat_bind/out.nix | 16 ++--- test/diff/pattern/out.nix | 24 +++---- test/diff/with/out.nix | 10 +-- 27 files changed, 333 insertions(+), 341 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 2aa8194a..769a6007 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -172,7 +172,7 @@ instance Pretty Binder where prettySet :: Bool -> (Maybe Leaf, Leaf, Items Binder, Leaf) -> Doc -- Empty, non-recursive attribute set prettySet _ (Nothing, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) - = pretty paropen <> hardspace <> pretty parclose + = pretty paropen <> pretty parclose -- Singleton sets are allowed to fit onto one line, -- but apart from that always expand. prettySet wide (krec, Ann pre paropen post, binders, parclose) @@ -181,7 +181,7 @@ prettySet wide (krec, Ann pre paropen post, binders, parclose) <> (surroundWith sep $ nest 2 $ pretty post <> prettyItems hardline binders) <> pretty parclose where - sep = if wide && not (null (unItems binders)) then hardline else line + sep = if wide && not (null (unItems binders)) then hardline else line' prettyTermWide :: Term -> Doc prettyTermWide (Set krec paropen items parclose) = prettySet True (krec, paropen, items, parclose) @@ -202,13 +202,13 @@ prettyTerm (Selection term selectors) = pretty term <> line' <> hcat selectors -- Empty list prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing')) - = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing' + = pretty leading <> pretty paropen <> pretty parclose <> pretty trailing' -- General list -- Always expand if len > 1 prettyTerm (List (Ann pre paropen post) items parclose) = base $ pretty (Ann pre paropen Nothing) - <> (surroundWith line $ nest 2 $ pretty post <> prettyItems hardline items) + <> (surroundWith line' $ nest 2 $ pretty post <> prettyItems hardline items) <> pretty parclose prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) @@ -313,13 +313,13 @@ instance Pretty Parameter where -- {}: pretty (SetParameter bopen [] bclose) - = group $ pretty bopen <> hardspace <> pretty bclose + = group $ pretty bopen <> pretty bclose -- { stuff }: pretty (SetParameter bopen attrs bclose) = group $ pretty bopen - <> (surroundWith sep $ nest 2 $ sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) + <> (surroundWith sep $ nest 2 $ sepBy (sep<>hardspace) $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) <> pretty bclose where -- pretty all ParamAttrs, but mark the trailing comma of the last element specially @@ -333,12 +333,12 @@ instance Pretty Parameter where sep = case attrs of [] -> line - [ParamEllipsis _] -> line + [ParamEllipsis _] -> line' -- Attributes must be without default - [ParamAttr _ Nothing _] -> line - [ParamAttr _ Nothing _, ParamEllipsis _] -> line - [ParamAttr _ Nothing _, ParamAttr _ Nothing _] -> line - [ParamAttr _ Nothing _, ParamAttr _ Nothing _, ParamEllipsis _] -> line + [ParamAttr _ Nothing _] -> line' + [ParamAttr _ Nothing _, ParamEllipsis _] -> line' + [ParamAttr _ Nothing _, ParamAttr _ Nothing _] -> line' + [ParamAttr _ Nothing _, ParamAttr _ Nothing _, ParamEllipsis _] -> line' _ -> hardline pretty (ContextParameter param1 at param2) diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 4ed0f429..241e6ad8 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -118,14 +118,14 @@ } '' { - name1 = function arg { asdf = 1; }; + name1 = function arg {asdf = 1;}; - name2 = function arg { asdf = 1; } argument; + name2 = function arg {asdf = 1;} argument; - name3 = function arg { asdf = 1; } { qwer = 12345; } argument; + name3 = function arg {asdf = 1;} {qwer = 12345;} argument; } { - name1 = function arg { asdf = 1; }; + name1 = function arg {asdf = 1;}; name2 = function arg @@ -141,12 +141,12 @@ asdf = 1; # multiline } - { qwer = 12345; } + {qwer = 12345;} argument; } { name4 = - function arg { asdf = 1; } + function arg {asdf = 1;} { qwer = 12345; qwer2 = 54321; @@ -155,7 +155,7 @@ } { option1 = - function arg { asdf = 1; } + function arg {asdf = 1;} { qwer = 12345; qwer2 = 54321; @@ -163,7 +163,7 @@ lastArg; option2 = - function arg { asdf = 1; } + function arg {asdf = 1;} { qwer = 12345; qwer2 = 54321; @@ -171,7 +171,7 @@ lastArg; option3 = - function arg { asdf = 1; } + function arg {asdf = 1;} { qwer = 12345; qwer2 = 54321; @@ -181,9 +181,9 @@ # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { outputs = - { utils }: + {utils}: # For each supported platform, - utils.lib.eachDefaultSystem (system: { }); + utils.lib.eachDefaultSystem (system: {}); } { escapeSingleline = libStr.escape [ @@ -209,9 +209,9 @@ 2 3 ] - [ ] - { } - [ ] + [] + {} + [] [ 1 2 diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 77774632..af4246c8 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -1,12 +1,12 @@ [ - { } + {} { # a } - { a = 1; } - { a = 1; } + {a = 1;} + {a = 1;} - { b = 1; } + {b = 1;} { b = 1; # c } @@ -19,7 +19,7 @@ b = 1; # c } - rec { c = 1; } + rec {c = 1;} rec { c = 1; # d } @@ -60,7 +60,7 @@ a = rec { a = { a = rec { - a = { }; + a = {}; }; }; }; @@ -123,13 +123,13 @@ some flags # multiline ] - ++ [ short ] + ++ [short] ++ [ more stuff # multiline ] - ++ (if foo then [ bar ] else [ baz ]) - ++ [ ] + ++ (if foo then [bar] else [baz]) + ++ [] ++ (optionals condition [ more items @@ -142,13 +142,9 @@ ]; } { - systemd.initrdBi = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; - systemd.initrdBin = lib.mkIf config.boot.initrd.services.lvm.enable [ - pkgs.vdo - ]; - systemd.initrdBin_ = lib.mkIf config.boot.initrd.services.lvm.enable [ - pkgs.vdo - ]; + systemd.initrdBi = lib.mkIf config.boot.initrd.services.lvm.enable [pkgs.vdo]; + systemd.initrdBin = lib.mkIf config.boot.initrd.services.lvm.enable [pkgs.vdo]; + systemd.initrdBin_ = lib.mkIf config.boot.initrd.services.lvm.enable [pkgs.vdo]; systemd.initrdBin__ = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 301f95bc..3fb18838 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -1,4 +1,4 @@ -{ lib }: +{lib}: rec { @@ -389,7 +389,7 @@ rec { let unexpected = lib.subtractLists valid given; in - lib.throwIfNot (unexpected == [ ]) + lib.throwIfNot (unexpected == []) "${msg}: ${ builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) } unexpected; valid ones: ${ @@ -481,13 +481,13 @@ rec { go = i: if i < base then - [ i ] + [i] else let r = i - ((i / base) * base); q = (i - r) / base; in - [ r ] ++ go q; + [r] ++ go q; in assert (base >= 2); assert (i >= 0); diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index b8d30794..80088031 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -12,7 +12,7 @@ # # Tests can be found in ./tests/misc.nix # Documentation in the manual, #sec-generators -{ lib }: +{lib}: with (lib).trivial; let libStr = lib.strings; @@ -28,14 +28,14 @@ rec { # The builtin `toString` function has some strange defaults, # suitable for bash scripts but not much else. mkValueStringDefault = - { }: + {}: v: with builtins; let err = t: v: abort ( - "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}" + "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty {} v}" ); in if isInt v then @@ -81,10 +81,10 @@ rec { # > "f\:oo:bar" mkKeyValueDefault = { - mkValueString ? mkValueStringDefault { }, + mkValueString ? mkValueStringDefault {}, }: sep: k: v: - "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; + "${libStr.escape [sep] k}${sep}${mkValueString v}"; ## -- FILE FORMAT GENERATORS -- @@ -93,16 +93,16 @@ rec { # mkKeyValue is the same as in toINI. toKeyValue = { - mkKeyValue ? mkKeyValueDefault { } "=", + mkKeyValue ? mkKeyValueDefault {} "=", listsAsDuplicateKeys ? false, }: let mkLine = k: v: mkKeyValue k v + "\n"; mkLines = if listsAsDuplicateKeys then - k: v: map (mkLine k) (if lib.isList v then v else [ v ]) + k: v: map (mkLine k) (if lib.isList v then v else [v]) else - k: v: [ (mkLine k v) ]; + k: v: [(mkLine k v)]; in attrs: libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); @@ -139,7 +139,7 @@ rec { name ), # format a setting line from key and value - mkKeyValue ? mkKeyValueDefault { } "=", + mkKeyValue ? mkKeyValueDefault {} "=", # allow lists as values for duplicate keys listsAsDuplicateKeys ? false, }: @@ -154,7 +154,7 @@ rec { '' [${mkSectionName sectName}] '' - + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; + + toKeyValue {inherit mkKeyValue listsAsDuplicateKeys;} sectValues; in # map input to ini sections mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; @@ -202,18 +202,18 @@ rec { name ), # format a setting line from key and value - mkKeyValue ? mkKeyValueDefault { } "=", + mkKeyValue ? mkKeyValueDefault {} "=", # allow lists as values for duplicate keys listsAsDuplicateKeys ? false, }: - { globalSection, sections }: + {globalSection, sections}: ( - if globalSection == { } then + if globalSection == {} then "" else - (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" + (toKeyValue {inherit mkKeyValue listsAsDuplicateKeys;} globalSection) + "\n" ) - + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections); + + (toINI {inherit mkSectionName mkKeyValue listsAsDuplicateKeys;} sections); # Generate a git-config file from an attrset. # @@ -245,7 +245,7 @@ rec { subsections = tail sections; subsection = concatStringsSep "." subsections; in - if containsQuote || subsections == [ ] then + if containsQuote || subsections == [] then name else ''${section} "${subsection}"''; @@ -254,7 +254,7 @@ rec { mkKeyValue = k: v: let - mkKeyValue = mkKeyValueDefault { } " = " k; + mkKeyValue = mkKeyValueDefault {} " = " k; in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)); @@ -264,22 +264,22 @@ rec { recurse = path: value: if isAttrs value && !lib.isDerivation value then - lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) value + lib.mapAttrsToList (name: value: recurse ([name] ++ path) value) value else if length path > 1 then - { ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = value; } + {${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = value;} else - { ${head path} = value; }; + {${head path} = value;}; in attrs: - lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); + lib.foldl lib.recursiveUpdate {} (lib.flatten (recurse [] attrs)); - toINI_ = toINI { inherit mkKeyValue mkSectionName; }; + toINI_ = toINI {inherit mkKeyValue mkSectionName;}; in toINI_ (gitFlattenAttrs attrs); # Generates JSON from an arbitrary (non-function) value. # For more information see the documentation of the builtin. - toJSON = { }: builtins.toJSON; + toJSON = {}: builtins.toJSON; # YAML has been a strict superset of JSON since 1.2, so we # use toJSON. Before it only had a few differences referring @@ -416,7 +416,7 @@ rec { else if isPath v then toString v else if isList v then - if v == [ ] then + if v == [] then "[ ]" else "[" @@ -432,12 +432,12 @@ rec { fna ); in - if fna == { } then "" else "" + if fna == {} then "" else "" else if isAttrs v then # apply pretty values if allowed if allowPrettyValues && v ? __pretty && v ? val then v.__pretty v.val - else if v == { } then + else if v == {} then "{ }" else if v ? type && v.type == "derivation" then "" @@ -465,7 +465,7 @@ rec { # PLIST handling toPlist = - { }: + {}: v: let isFloat = builtins.isFloat or (x: false); @@ -547,7 +547,7 @@ rec { # Note that integers are translated to Integer and never # the Natural type. toDhall = - { }@args: + {}@args: v: with builtins; let diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index 5df581a3..b2390592 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -14,12 +14,12 @@ # e.g. exhaustive cases. Its more a sanity check to make sure nobody defines # systems that overlap with existing ones and won't notice something amiss. # -{ lib }: +{lib}: with lib.lists; with lib.types; with lib.attrsets; with lib.strings; -with (import ./inspect.nix { inherit lib; }).predicates; +with (import ./inspect.nix {inherit lib;}).predicates; let inherit (lib.options) mergeOneOption; @@ -29,7 +29,7 @@ let mapAttrs ( name: value: assert type.check value; - setType type.name ({ inherit name; } // value) + setType type.name ({inherit name;} // value) ); in @@ -46,8 +46,8 @@ rec { types.significantByte = enum (attrValues significantBytes); significantBytes = setTypes types.openSignificantByte { - bigEndian = { }; - littleEndian = { }; + bigEndian = {}; + littleEndian = {}; }; ################################################################################ @@ -453,14 +453,14 @@ rec { types.vendor = enum (attrValues vendors); vendors = setTypes types.openVendor { - apple = { }; - pc = { }; + apple = {}; + pc = {}; # Actually matters, unlocking some MinGW-w64-specific options in GCC. See # bottom of https://sourceforge.net/p/mingw-w64/wiki2/Unicode%20apps/ - w64 = { }; + w64 = {}; - none = { }; - unknown = { }; + none = {}; + unknown = {}; }; ################################################################################ @@ -474,13 +474,13 @@ rec { types.execFormat = enum (attrValues execFormats); execFormats = setTypes types.openExecFormat { - aout = { }; # a.out - elf = { }; - macho = { }; - pe = { }; - wasm = { }; + aout = {}; # a.out + elf = {}; + macho = {}; + pe = {}; + wasm = {}; - unknown = { }; + unknown = {}; }; ################################################################################ @@ -494,8 +494,8 @@ rec { types.kernelFamily = enum (attrValues kernelFamilies); kernelFamilies = setTypes types.openKernelFamily { - bsd = { }; - darwin = { }; + bsd = {}; + darwin = {}; }; ################################################################################ @@ -552,7 +552,7 @@ rec { }; linux = { execFormat = elf; - families = { }; + families = {}; }; netbsd = { execFormat = elf; @@ -562,7 +562,7 @@ rec { }; none = { execFormat = unknown; - families = { }; + families = {}; }; openbsd = { execFormat = elf; @@ -572,31 +572,31 @@ rec { }; solaris = { execFormat = elf; - families = { }; + families = {}; }; wasi = { execFormat = wasm; - families = { }; + families = {}; }; redox = { execFormat = elf; - families = { }; + families = {}; }; windows = { execFormat = pe; - families = { }; + families = {}; }; ghcjs = { execFormat = unknown; - families = { }; + families = {}; }; genode = { execFormat = elf; - families = { }; + families = {}; }; mmixware = { execFormat = unknown; - families = { }; + families = {}; }; } // { @@ -619,8 +619,8 @@ rec { types.abi = enum (attrValues abis); abis = setTypes types.openAbi { - cygnus = { }; - msvc = { }; + cygnus = {}; + msvc = {}; # Note: eabi is specific to ARM and PowerPC. # On PowerPC, this corresponds to PPCEABI. @@ -633,9 +633,9 @@ rec { }; # Other architectures should use ELF in embedded situations. - elf = { }; + elf = {}; - androideabi = { }; + androideabi = {}; android = { assertions = [ { @@ -699,7 +699,7 @@ rec { musleabihf = { float = "hard"; }; - musl = { }; + musl = {}; uclibceabi = { float = "soft"; @@ -707,9 +707,9 @@ rec { uclibceabihf = { float = "hard"; }; - uclibc = { }; + uclibc = {}; - unknown = { }; + unknown = {}; }; ################################################################################ diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 281b3089..84b2ad82 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -30,8 +30,8 @@ let in if envVar != "" then envVar != "0" else config.allowNonSource or true; - allowlist = config.allowlistedLicenses or config.whitelistedLicenses or [ ]; - blocklist = config.blocklistedLicenses or config.blacklistedLicenses or [ ]; + allowlist = config.allowlistedLicenses or config.whitelistedLicenses or []; + blocklist = config.blocklistedLicenses or config.blacklistedLicenses or []; areLicenseListsValid = if lib.mutuallyExclusive allowlist blocklist then @@ -76,7 +76,7 @@ let hasUnsupportedPlatform = pkg: !(lib.meta.availableOn hostPlatform pkg); - isMarkedInsecure = attrs: (attrs.meta.knownVulnerabilities or [ ]) != [ ]; + isMarkedInsecure = attrs: (attrs.meta.knownVulnerabilities or []) != []; # Alow granular checks to allow only some unfree packages # Example: @@ -94,7 +94,7 @@ let attrs: hasUnfreeLicense attrs && !allowUnfree && !allowUnfreePredicate attrs; allowInsecureDefaultPredicate = - x: builtins.elem (getName x) (config.permittedInsecurePackages or [ ]); + x: builtins.elem (getName x) (config.permittedInsecurePackages or []); allowInsecurePredicate = x: (config.allowInsecurePredicate or allowInsecureDefaultPredicate) x; @@ -239,8 +239,8 @@ let remediateOutputsToInstall = attrs: let - expectedOutputs = attrs.meta.outputsToInstall or [ ]; - actualOutputs = attrs.outputs or [ "out" ]; + expectedOutputs = attrs.meta.outputsToInstall or []; + actualOutputs = attrs.outputs or ["out"]; missingOutputs = builtins.filter (output: !builtins.elem output actualOutputs) expectedOutputs; @@ -256,7 +256,7 @@ let ''; handleEvalIssue = - { meta, attrs }: + {meta, attrs}: { reason, errormsg ? "", @@ -278,7 +278,7 @@ let handler msg; handleEvalWarning = - { meta, attrs }: + {meta, attrs}: { reason, errormsg ? "", @@ -302,7 +302,7 @@ let typeCheck = type: value: let - merged = lib.mergeDefinitions [ ] type [ + merged = lib.mergeDefinitions [] type [ { file = lib.unknownModule; inherit value; @@ -344,7 +344,7 @@ let name = "test"; check = x: - x == { } + x == {} || ( # Accept {} for tests that are unsupported isDerivation x && x ? meta.timeout ); @@ -383,7 +383,7 @@ let else '' key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got - ${lib.generators.toPretty { indent = " "; } v}'' + ${lib.generators.toPretty {indent = " ";} v}'' else '' key 'meta.${k}' is unrecognized; expected one of: @@ -397,8 +397,8 @@ let checkOutputsToInstall = attrs: let - expectedOutputs = attrs.meta.outputsToInstall or [ ]; - actualOutputs = attrs.outputs or [ "out" ]; + expectedOutputs = attrs.meta.outputsToInstall or []; + actualOutputs = attrs.outputs or ["out"]; missingOutputs = builtins.filter (output: !builtins.elem output actualOutputs) expectedOutputs; @@ -418,9 +418,9 @@ let # Check meta attribute types first, to make sure it is always called even when there are other issues # Note that this is not a full type check and functions below still need to by careful about their inputs! let - res = checkMeta (attrs.meta or { }); + res = checkMeta (attrs.meta or {}); in - if res != [ ] then + if res != [] then { valid = "no"; reason = "unknown-meta"; @@ -488,8 +488,8 @@ let errormsg = '' is not available on the requested hostPlatform: hostPlatform.config = "${hostPlatform.config}" - package.meta.platforms = ${toPretty (attrs.meta.platforms or [ ])} - package.meta.badPlatforms = ${toPretty (attrs.meta.badPlatforms or [ ])} + package.meta.platforms = ${toPretty (attrs.meta.platforms or [])} + package.meta.badPlatforms = ${toPretty (attrs.meta.badPlatforms or [])} ''; } else if !(hasAllowedInsecure attrs) then @@ -509,7 +509,7 @@ let } # ----- else - { valid = "yes"; } + {valid = "yes";} ); # The meta attribute is passed in the resulting attribute set, @@ -524,10 +524,10 @@ let validity, attrs, pos ? null, - references ? [ ], + references ? [], }: let - outputs = attrs.outputs or [ "out" ]; + outputs = attrs.outputs or ["out"]; in { # `name` derivation attribute includes cross-compilation cruft, @@ -560,7 +560,7 @@ let ] ++ lib.optional (hasOutput "man") "man"; } - // attrs.meta or { } + // attrs.meta or {} # Fill `meta.position` to identify the source location of the package. // lib.optionalAttrs (pos != null) { position = pos.file + ":" + toString pos.line; @@ -585,7 +585,7 @@ let }; assertValidity = - { meta, attrs }: + {meta, attrs}: let validity = checkValidity attrs; in @@ -595,10 +595,10 @@ let # or, alternatively, just output a warning message. handled = { - no = handleEvalIssue { inherit meta attrs; } { + no = handleEvalIssue {inherit meta attrs;} { inherit (validity) reason errormsg; }; - warn = handleEvalWarning { inherit meta attrs; } { + warn = handleEvalWarning {inherit meta attrs;} { inherit (validity) reason errormsg; }; yes = true; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 2d26acba..88e327ae 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -25,7 +25,7 @@ in options = { boot.kernel.features = mkOption { - default = { }; + default = {}; example = literalExpression "{ debug = true; }"; internal = true; description = '' @@ -49,7 +49,7 @@ in kernel = super.kernel.override ( originalArgs: { inherit randstructSeed; - kernelPatches = (originalArgs.kernelPatches or [ ]) ++ kernelPatches; + kernelPatches = (originalArgs.kernelPatches or []) ++ kernelPatches; features = lib.recursiveUpdate super.kernel.features features; } ); @@ -75,7 +75,7 @@ in boot.kernelPatches = mkOption { type = types.listOf types.attrs; - default = [ ]; + default = []; example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; description = "A list of additional patches to apply to the kernel."; }; @@ -101,7 +101,7 @@ in description = "string, with spaces inside double quotes"; } ); - default = [ ]; + default = []; description = "Parameters added to the kernel command line."; }; @@ -129,14 +129,14 @@ in boot.extraModulePackages = mkOption { type = types.listOf types.package; - default = [ ]; + default = []; example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; description = "A list of additional packages supplying kernel modules."; }; boot.kernelModules = mkOption { type = types.listOf types.str; - default = [ ]; + default = []; description = '' The set of kernel modules to be loaded in the second stage of the boot process. Note that modules that are needed to @@ -148,7 +148,7 @@ in boot.initrd.availableKernelModules = mkOption { type = types.listOf types.str; - default = [ ]; + default = []; example = [ "sata_nv" "ext3" @@ -172,7 +172,7 @@ in boot.initrd.kernelModules = mkOption { type = types.listOf types.str; - default = [ ]; + default = []; description = "List of modules that are always loaded by the initrd."; }; @@ -189,7 +189,7 @@ in system.modulesTree = mkOption { type = types.listOf types.path; internal = true; - default = [ ]; + default = []; description = '' Tree of kernel modules. This includes the kernel, plus modules built outside of the kernel. Combine these into a single tree of @@ -200,7 +200,7 @@ in }; system.requiredKernelConfig = mkOption { - default = [ ]; + default = []; example = literalExpression '' with config.lib.kernelConfig; [ (isYes "MODULES") @@ -289,12 +289,12 @@ in inherit kernel; }; - system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; + system.modulesTree = [kernel] ++ config.boot.extraModulePackages; # Implement consoleLogLevel both in early boot and using sysctl # (so you don't need to reboot to have changes take effect). boot.kernelParams = - [ "loglevel=${toString config.boot.consoleLogLevel}" ] + ["loglevel=${toString config.boot.consoleLogLevel}"] ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" @@ -308,7 +308,7 @@ in ]; # The Linux kernel >= 2.6.27 provides firmware. - hardware.firmware = [ kernel ]; + hardware.firmware = [kernel]; # Create /etc/modules-load.d/nixos.conf, which is read by # systemd-modules-load.service to load required kernel modules. @@ -317,8 +317,8 @@ in }; systemd.services.systemd-modules-load = { - wantedBy = [ "multi-user.target" ]; - restartTriggers = [ kernelModulesConf ]; + wantedBy = ["multi-user.target"]; + restartTriggers = [kernelModulesConf]; serviceConfig = { # Ignore failed module loads. Typically some of the # modules in ‘boot.kernelModules’ are "nice to have but @@ -376,7 +376,7 @@ in # nixpkgs kernels are assumed to have all required features assertions = if config.boot.kernelPackages.kernel ? features then - [ ] + [] else let cfg = config.boot.kernelPackages.kernel.config; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 79aeb15c..e72a47ae 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -11,13 +11,13 @@ let cfg = config.services.nextcloud; fpm = config.services.phpfpm.pools.nextcloud; - jsonFormat = pkgs.formats.json { }; + jsonFormat = pkgs.formats.json {}; inherit (cfg) datadir; phpPackage = cfg.phpPackage.buildEnv { extensions = - { enabled, all }: + {enabled, all}: ( with all; # disable default openssl extension @@ -27,9 +27,9 @@ let # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. ++ ( if cfg.enableBrokenCiphersForSSE then - [ cfg.phpPackage.extensions.openssl-legacy ] + [cfg.phpPackage.extensions.openssl-legacy] else - [ cfg.phpPackage.extensions.openssl ] + [cfg.phpPackage.extensions.openssl] ) ++ optional cfg.enableImagemagick imagick # Optionally enabled depending on caching settings @@ -42,16 +42,14 @@ let }; toKeyValue = generators.toKeyValue { - mkKeyValue = generators.mkKeyValueDefault { } " = "; + mkKeyValue = generators.mkKeyValueDefault {} " = "; }; - phpOptions = - { - upload_max_filesize = cfg.maxUploadSize; - post_max_size = cfg.maxUploadSize; - memory_limit = cfg.maxUploadSize; - } - // cfg.phpOptions // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; }; + phpOptions = { + upload_max_filesize = cfg.maxUploadSize; + post_max_size = cfg.maxUploadSize; + memory_limit = cfg.maxUploadSize; + } // cfg.phpOptions // optionalAttrs cfg.caching.apcu {"apc.enable_cli" = "1";}; occ = pkgs.writeScriptBin "nextcloud-occ" '' #! ${pkgs.runtimeShell} @@ -182,7 +180,7 @@ in }; extraApps = mkOption { type = types.attrsOf types.package; - default = { }; + default = {}; description = lib.mdDoc '' Extra apps to install. Should be an attrSet of appid to packages generated by fetchNextcloudApp. The appid must be identical to the "id" value in the apps appinfo/info.xml. @@ -299,7 +297,7 @@ in phpExtraExtensions = mkOption { type = with types; functionTo (listOf package); - default = all: [ ]; + default = all: []; defaultText = literalExpression "all: []"; description = lib.mdDoc '' Additional PHP extensions to use for nextcloud. @@ -449,7 +447,7 @@ in extraTrustedDomains = mkOption { type = types.listOf types.str; - default = [ ]; + default = []; description = lib.mdDoc '' Trusted domains, from which the nextcloud installation will be accessible. You don't need to add @@ -459,7 +457,7 @@ in trustedProxies = mkOption { type = types.listOf types.str; - default = [ ]; + default = []; description = lib.mdDoc '' Trusted proxies, to provide if the nextcloud installation is being proxied to secure against e.g. spoofing. @@ -701,7 +699,7 @@ in extraOptions = mkOption { type = jsonFormat.type; - default = { }; + default = {}; description = lib.mdDoc '' Extra options which should be appended to nextcloud's config.php file. ''; @@ -832,20 +830,20 @@ in { systemd.timers.nextcloud-cron = { - wantedBy = [ "timers.target" ]; - after = [ "nextcloud-setup.service" ]; + wantedBy = ["timers.target"]; + after = ["nextcloud-setup.service"]; timerConfig.OnBootSec = "5m"; timerConfig.OnUnitActiveSec = "5m"; timerConfig.Unit = "nextcloud-cron.service"; }; - systemd.tmpfiles.rules = [ "d ${cfg.home} 0750 nextcloud nextcloud" ]; + systemd.tmpfiles.rules = ["d ${cfg.home} 0750 nextcloud nextcloud"]; systemd.services = { # When upgrading the Nextcloud package, Nextcloud can report errors such as # "The files of the app [all apps in /var/lib/nextcloud/apps] were not replaced correctly" # Restarting phpfpm on Nextcloud package update fixes these issues (but this is a workaround). - phpfpm-nextcloud.restartTriggers = [ cfg.package ]; + phpfpm-nextcloud.restartTriggers = [cfg.package]; nextcloud-setup = let @@ -878,7 +876,7 @@ in ] ''; - showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; + showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != {}; renderedAppStoreSetting = let x = cfg.appstoreEnable; @@ -916,7 +914,7 @@ in $CONFIG = [ 'apps_paths' => [ ${ - optionalString (cfg.extraApps != { }) + optionalString (cfg.extraApps != {}) "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," } [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], @@ -952,7 +950,7 @@ in } 'dbtype' => '${c.dbtype}', 'trusted_domains' => ${ - writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) + writePhpArray ([cfg.hostName] ++ c.extraTrustedDomains) }, 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, ${ @@ -980,7 +978,7 @@ in ''; occInstallCmd = let - mkExport = { arg, value }: "export ${arg}=${value}"; + mkExport = {arg, value}: "export ${arg}=${value}"; dbpass = { arg = "DBPASS"; value = @@ -1021,13 +1019,13 @@ in ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ ${toString i} --value="${toString v}" '') - ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) + ([cfg.hostName] ++ cfg.config.extraTrustedDomains) ); in { - wantedBy = [ "multi-user.target" ]; - before = [ "phpfpm-nextcloud.service" ]; - path = [ occ ]; + wantedBy = ["multi-user.target"]; + before = ["phpfpm-nextcloud.service"]; + path = [occ]; script = '' ${optionalString (c.dbpassFile != null) '' if [ ! -r "${c.dbpassFile}" ]; then @@ -1054,7 +1052,7 @@ in ln -sfT \ ${ pkgs.linkFarm "nix-apps" ( - mapAttrsToList (name: path: { inherit name path; }) cfg.extraApps + mapAttrsToList (name: path: {inherit name path;}) cfg.extraApps ) } \ ${cfg.home}/nix-apps @@ -1080,7 +1078,7 @@ in ${occ}/bin/nextcloud-occ config:system:delete trusted_domains - ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != {}) '' # Try to enable apps ${occ}/bin/nextcloud-occ app:enable ${ concatStringsSep " " (attrNames cfg.extraApps) @@ -1098,14 +1096,14 @@ in "false"; }; nextcloud-cron = { - after = [ "nextcloud-setup.service" ]; + after = ["nextcloud-setup.service"]; environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; serviceConfig.Type = "oneshot"; serviceConfig.User = "nextcloud"; serviceConfig.ExecStart = "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; }; nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { - after = [ "nextcloud-setup.service" ]; + after = ["nextcloud-setup.service"]; serviceConfig.Type = "oneshot"; serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; serviceConfig.User = "nextcloud"; @@ -1142,12 +1140,12 @@ in config.services.nginx.user ]; - environment.systemPackages = [ occ ]; + environment.systemPackages = [occ]; services.mysql = lib.mkIf cfg.database.createLocally { enable = true; package = lib.mkDefault pkgs.mariadb; - ensureDatabases = [ cfg.config.dbname ]; + ensureDatabases = [cfg.config.dbname]; ensureUsers = [ { name = cfg.config.dbuser; diff --git a/test/diff/idioms_pkgs_1/out.nix b/test/diff/idioms_pkgs_1/out.nix index afdbed26..2e418f66 100644 --- a/test/diff/idioms_pkgs_1/out.nix +++ b/test/diff/idioms_pkgs_1/out.nix @@ -8,9 +8,9 @@ stdenv.mkDerivation rec { pname = "test"; version = "0.0"; - src = fetchFrom { url = "example/${version}"; }; + src = fetchFrom {url = "example/${version}";}; meta = with lib; { - maintainers = with maintainers; [ someone ]; + maintainers = with maintainers; [someone]; description = "something"; }; } diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index 84f50d54..f78b9902 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -20,12 +20,12 @@ stdenv.mkDerivation rec { doCheck = true; passthru.tests = { - version = testVersion { package = hello; }; + version = testVersion {package = hello;}; invariant-under-noXlibs = testEqualDerivation "hello must not be rebuilt when environment.noXlibs is set." hello - (nixos { environment.noXlibs = true; }).pkgs.hello; + (nixos {environment.noXlibs = true;}).pkgs.hello; }; meta = with lib; { @@ -37,7 +37,7 @@ stdenv.mkDerivation rec { homepage = "https://www.gnu.org/software/hello/manual/"; changelog = "https://git.savannah.gnu.org/cgit/hello.git/plain/NEWS?h=v${version}"; license = licenses.gpl3Plus; - maintainers = [ maintainers.eelco ]; + maintainers = [maintainers.eelco]; platforms = platforms.all; }; } diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index fea4751f..f7b6e6f3 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -9,14 +9,14 @@ branding ? null, src, unpackPhase ? null, - extraPatches ? [ ], + extraPatches ? [], extraPostPatch ? "", - extraNativeBuildInputs ? [ ], - extraConfigureFlags ? [ ], - extraBuildInputs ? [ ], - extraMakeFlags ? [ ], - extraPassthru ? { }, - tests ? [ ], + extraNativeBuildInputs ? [], + extraConfigureFlags ? [], + extraBuildInputs ? [], + extraMakeFlags ? [], + extraPassthru ? {}, + tests ? [], }: { @@ -188,7 +188,7 @@ let # Compile the wasm32 sysroot to build the RLBox Sandbox # https://hacks.mozilla.org/2021/12/webassembly-and-back-again-fine-grained-sandboxing-in-firefox-95/ # We only link c++ libs here, our compiler wrapper can find wasi libc and crt itself. - wasiSysRoot = runCommand "wasi-sysroot" { } '' + wasiSysRoot = runCommand "wasi-sysroot" {} '' mkdir -p $out/lib/wasm32-wasi for lib in ${pkgsCross.wasi32.llvmPackages.libcxx}/lib/* ${pkgsCross.wasi32.llvmPackages.libcxxabi}/lib/*; do ln -s $lib $out/lib/wasm32-wasi @@ -196,7 +196,7 @@ let ''; distributionIni = pkgs.writeText "distribution.ini" ( - lib.generators.toINI { } { + lib.generators.toINI {} { # Some light branding indicating this build uses our distro preferences Global = { id = "nixos"; @@ -237,7 +237,7 @@ buildStdenv.mkDerivation ({ inherit src unpackPhase meta; - outputs = [ "out" ] ++ lib.optionals crashreporterSupport [ "symbols" ]; + outputs = ["out"] ++ lib.optionals crashreporterSupport ["symbols"]; # Add another configure-build-profiling run before the final configure phase if we build with pgo preConfigurePhases = lib.optionals pgoSupport [ @@ -305,7 +305,7 @@ buildStdenv.mkDerivation ({ dump_syms patchelf ] - ++ lib.optionals pgoSupport [ xvfb-run ] + ++ lib.optionals pgoSupport [xvfb-run] ++ extraNativeBuildInputs; setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. @@ -380,7 +380,7 @@ buildStdenv.mkDerivation ({ ''; # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags - configurePlatforms = [ ]; + configurePlatforms = []; configureFlags = [ @@ -485,7 +485,7 @@ buildStdenv.mkDerivation ({ zip zlib ] - ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] + ++ [(if (lib.versionAtLeast version "103") then nss_latest else nss_esr)] ++ lib.optional alsaSupport alsa-lib ++ lib.optional jackSupport libjack2 ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed @@ -562,7 +562,7 @@ buildStdenv.mkDerivation ({ ''; postFixup = lib.optionalString crashreporterSupport '' - patchelf --add-rpath "${lib.makeLibraryPath [ curl ]}" $out/lib/${binaryName}/crashreporter + patchelf --add-rpath "${lib.makeLibraryPath [curl]}" $out/lib/${binaryName}/crashreporter ''; doInstallCheck = true; @@ -587,7 +587,7 @@ buildStdenv.mkDerivation ({ inherit wasiSysRoot; } // extraPassthru; - hardeningDisable = [ "format" ]; # -Werror=format-security + hardeningDisable = ["format"]; # -Werror=format-security # the build system verifies checksums of the bundled rust sources # ./third_party/rust is be patched by our libtool fixup code in stdenv @@ -602,5 +602,5 @@ buildStdenv.mkDerivation ({ # on aarch64 this is also required dontUpdateAutotoolsGnuConfigScripts = true; - requiredSystemFeatures = [ "big-parallel" ]; + requiredSystemFeatures = ["big-parallel"]; }) diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index bc384da7..470b38bf 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -4,7 +4,7 @@ crossSystem, config, overlays, - crossOverlays ? [ ], + crossOverlays ? [], }: assert crossSystem == localSystem; @@ -19,9 +19,9 @@ let "/bin/bash"; path = - (lib.optionals (system == "i686-solaris") [ "/usr/gnu" ]) - ++ (lib.optionals (system == "i686-netbsd") [ "/usr/pkg" ]) - ++ (lib.optionals (system == "x86_64-solaris") [ "/opt/local/gnu" ]) + (lib.optionals (system == "i686-solaris") ["/usr/gnu"]) + ++ (lib.optionals (system == "i686-netbsd") ["/usr/pkg"]) + ++ (lib.optionals (system == "x86_64-solaris") ["/opt/local/gnu"]) ++ [ "/" "/usr" @@ -84,11 +84,11 @@ let ] ++ ( if system == "i686-cygwin" then - [ ../cygwin/rebase-i686.sh ] + [../cygwin/rebase-i686.sh] else if system == "x86_64-cygwin" then - [ ../cygwin/rebase-x86_64.sh ] + [../cygwin/rebase-x86_64.sh] else - [ ] + [] ); # A function that builds a "native" stdenv (one that uses tools in @@ -97,9 +97,9 @@ let { cc, fetchurl, - extraPath ? [ ], - overrides ? (self: super: { }), - extraNativeBuildInputs ? [ ], + extraPath ? [], + overrides ? (self: super: {}), + extraNativeBuildInputs ? [], }: import ../generic { @@ -131,7 +131,7 @@ let else if system == "x86_64-cygwin" then extraNativeBuildInputsCygwin else - [ ] + [] ); initialPath = extraPath ++ path; @@ -150,7 +150,7 @@ in [ ( - { }: + {}: rec { __raw = true; @@ -195,7 +195,7 @@ in # First build a stdenv based only on tools outside the store. (prevStage: { inherit config overlays; - stdenv = makeStdenv { inherit (prevStage) cc fetchurl; } // { + stdenv = makeStdenv {inherit (prevStage) cc fetchurl;} // { inherit (prevStage) fetchurl; }; }) @@ -206,10 +206,10 @@ in inherit config overlays; stdenv = makeStdenv { inherit (prevStage.stdenv) cc fetchurl; - extraPath = [ prevStage.xz ]; - overrides = self: super: { inherit (prevStage) xz; }; + extraPath = [prevStage.xz]; + overrides = self: super: {inherit (prevStage) xz;}; extraNativeBuildInputs = - if localSystem.isLinux then [ prevStage.patchelf ] else [ ]; + if localSystem.isLinux then [prevStage.patchelf] else []; }; }) ] diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index d3e152a3..b34bc226 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -1,4 +1,4 @@ -{ lib, config }: +{lib, config}: stdenv: @@ -56,7 +56,7 @@ let # separate lines, because Nix would only show the last line of the comment. # An infinite recursion here can be caused by having the attribute names of expression `e` in `.overrideAttrs(finalAttrs: previousAttrs: e)` depend on `finalAttrs`. Only the attribute values of `e` can depend on `finalAttrs`. - args = rattrs (args // { inherit finalPackage overrideAttrs; }); + args = rattrs (args // {inherit finalPackage overrideAttrs;}); # ^^^^ overrideAttrs = @@ -137,30 +137,30 @@ let # TODO(@Ericson2314): Stop using legacy dep attribute names # host offset -> target offset - depsBuildBuild ? [ ], # -1 -> -1 - depsBuildBuildPropagated ? [ ], # -1 -> -1 - nativeBuildInputs ? [ ], # -1 -> 0 N.B. Legacy name - propagatedNativeBuildInputs ? [ ], # -1 -> 0 N.B. Legacy name - depsBuildTarget ? [ ], # -1 -> 1 - depsBuildTargetPropagated ? [ ], # -1 -> 1 - - depsHostHost ? [ ], # 0 -> 0 - depsHostHostPropagated ? [ ], # 0 -> 0 - buildInputs ? [ ], # 0 -> 1 N.B. Legacy name - propagatedBuildInputs ? [ ], # 0 -> 1 N.B. Legacy name - - depsTargetTarget ? [ ], # 1 -> 1 - depsTargetTargetPropagated ? [ ], # 1 -> 1 - - checkInputs ? [ ], - installCheckInputs ? [ ], - nativeCheckInputs ? [ ], - nativeInstallCheckInputs ? [ ], + depsBuildBuild ? [], # -1 -> -1 + depsBuildBuildPropagated ? [], # -1 -> -1 + nativeBuildInputs ? [], # -1 -> 0 N.B. Legacy name + propagatedNativeBuildInputs ? [], # -1 -> 0 N.B. Legacy name + depsBuildTarget ? [], # -1 -> 1 + depsBuildTargetPropagated ? [], # -1 -> 1 + + depsHostHost ? [], # 0 -> 0 + depsHostHostPropagated ? [], # 0 -> 0 + buildInputs ? [], # 0 -> 1 N.B. Legacy name + propagatedBuildInputs ? [], # 0 -> 1 N.B. Legacy name + + depsTargetTarget ? [], # 1 -> 1 + depsTargetTargetPropagated ? [], # 1 -> 1 + + checkInputs ? [], + installCheckInputs ? [], + nativeCheckInputs ? [], + nativeInstallCheckInputs ? [], # Configure Phase - configureFlags ? [ ], - cmakeFlags ? [ ], - mesonFlags ? [ ], + configureFlags ? [], + cmakeFlags ? [], + mesonFlags ? [], # Target is not included by default because most programs don't care. # Including it then would cause needless mass rebuilds. # @@ -191,8 +191,8 @@ let enableParallelBuilding ? config.enableParallelBuildingByDefault, - meta ? { }, - passthru ? { }, + meta ? {}, + passthru ? {}, pos ? # position used in error messages and for meta.position ( if attrs.meta.description or null != null then @@ -203,17 +203,17 @@ let builtins.unsafeGetAttrPos "name" attrs ), separateDebugInfo ? false, - outputs ? [ "out" ], + outputs ? ["out"], __darwinAllowLocalNetworking ? false, - __impureHostDeps ? [ ], - __propagatedImpureHostDeps ? [ ], + __impureHostDeps ? [], + __propagatedImpureHostDeps ? [], sandboxProfile ? "", propagatedSandboxProfile ? "", - hardeningEnable ? [ ], - hardeningDisable ? [ ], + hardeningEnable ? [], + hardeningDisable ? [], - patches ? [ ], + patches ? [], __contentAddressed ? (!attrs ? outputHash) # Fixed-output drvs can't be content addressed too @@ -223,7 +223,7 @@ let # but for anything complex, be prepared to debug if enabling. __structuredAttrs ? config.structuredAttrsByDefault or false, - env ? { }, + env ? {}, ... }@attrs: @@ -277,7 +277,7 @@ let any (x: x == "fortify") hardeningDisable # disabling fortify implies fortify3 should also be disabled then - unique (hardeningDisable ++ [ "fortify3" ]) + unique (hardeningDisable ++ ["fortify3"]) else hardeningDisable; supportedHardeningFlags = [ @@ -308,7 +308,7 @@ let remove "pie" supportedHardeningFlags; enabledHardeningOptions = if builtins.elem "all" hardeningDisable' then - [ ] + [] else subtractLists hardeningDisable' (defaultHardeningFlags ++ hardeningEnable); # hardeningDisable additionally supports "all". @@ -316,7 +316,7 @@ let hardeningEnable ++ remove "all" hardeningDisable ); - checkDependencyList = checkDependencyList' [ ]; + checkDependencyList = checkDependencyList' []; checkDependencyList' = positions: name: deps: flip imap1 deps ( @@ -326,17 +326,17 @@ let then dep else if isList dep then - checkDependencyList' ([ index ] ++ positions) name dep + checkDependencyList' ([index] ++ positions) name dep else throw "Dependency is not of a valid type: ${ - concatMapStrings (ix: "element ${toString ix} of ") ([ index ] ++ positions) + concatMapStrings (ix: "element ${toString ix} of ") ([index] ++ positions) }${name} for ${attrs.name or attrs.pname}" ); in if builtins.length erroneousHardeningFlags != 0 then abort ( "mkDerivation was called with unsupported hardening flags: " - + lib.generators.toPretty { } { + + lib.generators.toPretty {} { inherit erroneousHardeningFlags hardeningDisable @@ -422,7 +422,7 @@ let ]; computedSandboxProfile = - concatMap (input: input.__propagatedSandboxProfile or [ ]) + concatMap (input: input.__propagatedSandboxProfile or []) ( stdenv.extraNativeBuildInputs ++ stdenv.extraBuildInputs @@ -430,11 +430,11 @@ let ); computedPropagatedSandboxProfile = - concatMap (input: input.__propagatedSandboxProfile or [ ]) + concatMap (input: input.__propagatedSandboxProfile or []) (concatLists propagatedDependencies); computedImpureHostDeps = unique ( - concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( + concatMap (input: input.__propagatedImpureHostDeps or []) ( stdenv.extraNativeBuildInputs ++ stdenv.extraBuildInputs ++ concatLists dependencies @@ -442,7 +442,7 @@ let ); computedPropagatedImpureHostDeps = unique ( - concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( + concatMap (input: input.__propagatedImpureHostDeps or []) ( concatLists propagatedDependencies ) ); @@ -498,7 +498,7 @@ let "${attrs.pname}${staticMarker}${hostSuffix}-${attrs.version}" ); }) - // optionalAttrs __structuredAttrs { env = checkedEnv; } + // optionalAttrs __structuredAttrs {env = checkedEnv;} // { builder = attrs.realBuilder or stdenv.shell; args = @@ -634,14 +634,12 @@ let } // optionalAttrs - ( - hardeningDisable != [ ] || hardeningEnable != [ ] || stdenv.hostPlatform.isMusl - ) - { NIX_HARDENING_ENABLE = enabledHardeningOptions; } + (hardeningDisable != [] || hardeningEnable != [] || stdenv.hostPlatform.isMusl) + {NIX_HARDENING_ENABLE = enabledHardeningOptions;} // optionalAttrs (stdenv.hostPlatform.isx86_64 && stdenv.hostPlatform ? gcc.arch) { - requiredSystemFeatures = attrs.requiredSystemFeatures or [ ] ++ [ + requiredSystemFeatures = attrs.requiredSystemFeatures or [] ++ [ "gccarch-${stdenv.hostPlatform.gcc.arch}" ]; } @@ -651,7 +649,7 @@ let __sandboxProfile = let profiles = - [ stdenv.extraSandboxProfile ] + [stdenv.extraSandboxProfile] ++ computedSandboxProfile ++ computedPropagatedSandboxProfile ++ [ @@ -662,7 +660,7 @@ let in final; __propagatedSandboxProfile = unique ( - computedPropagatedSandboxProfile ++ [ propagatedSandboxProfile ] + computedPropagatedSandboxProfile ++ [propagatedSandboxProfile] ); __impureHostDeps = computedImpureHostDeps @@ -719,14 +717,14 @@ let references ; }; - validity = checkMeta.assertValidity { inherit meta attrs; }; + validity = checkMeta.assertValidity {inherit meta attrs;}; checkedEnv = let overlappingNames = attrNames (builtins.intersectAttrs env derivationArg); in assert assertMsg envIsExportable "When using structured attributes, `env` must be an attribute set of environment variables."; - assert assertMsg (overlappingNames == [ ]) + assert assertMsg (overlappingNames == []) "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; mapAttrs ( @@ -752,7 +750,7 @@ let # Add a name in case the original drv didn't have one name = derivationArg.name or "inputDerivation"; # This always only has one output - outputs = [ "out" ]; + outputs = ["out"]; # Propagate the original builder and arguments, since we override # them and they might contain references to build inputs @@ -781,8 +779,8 @@ let # anymore. allowedReferences = null; allowedRequisites = null; - disallowedReferences = [ ]; - disallowedRequisites = [ ]; + disallowedReferences = []; + disallowedRequisites = []; } ); diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index a30e7e2e..b1ac3eb5 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -1,5 +1,5 @@ [ - (if true then { version = "1.2.3"; } else { version = "3.2.1"; }) + (if true then {version = "1.2.3";} else {version = "3.2.1";}) ( if true then '' diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index 93a31869..a823c878 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -18,8 +18,8 @@ j ; } - { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } - { inherit b d; } + {inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa;} + {inherit b d;} { inherit b diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 2264a151..ae9217ef 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -40,7 +40,7 @@ k ; } - { inherit (c) f h; } + {inherit (c) f h;} { inherit (c) f diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index a3868e02..bbbd14d0 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -41,7 +41,7 @@ rec { 1 # d ; }; - j = a: { b = 1; }; + j = a: {b = 1;}; k = a: { b = 1; c = 2; @@ -55,8 +55,8 @@ rec { b = 1; c = 2; }; - n = pkgs: { }; - o = { pkgs, ... }: { }; + n = pkgs: {}; + o = {pkgs, ...}: {}; a # b @@ -66,5 +66,5 @@ rec { # d ; - p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a; + p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa {} a; } diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 42d4b05b..e383114a 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -3,7 +3,7 @@ let in [ ( - { lib }: + {lib}: let foo = 1; in @@ -13,7 +13,7 @@ in /* Collection of functions useful for debugging Some comment */ - { lib }: + {lib}: let foo = 1; in @@ -24,13 +24,13 @@ in d ) ( - { }: + {}: b: # c d ) ( a: - { }: # c + {}: # c d ) (a: d) @@ -52,27 +52,27 @@ in (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) ( { - pkgs ? import ./.. { }, + pkgs ? import ./.. {}, locationsXml, }: null ) ( a: b: c: - { }: + {}: a: b: c: a ) ( - { pkgs, ... }: + {pkgs, ...}: { # Stuff } ) ( - { pkgs, ... }: + {pkgs, ...}: let in pkgs @@ -80,7 +80,7 @@ in ( a: - { b, ... }: + {b, ...}: c: { # Stuff } @@ -88,7 +88,7 @@ in ( a: - { b, c, ... }: + {b, c, ...}: d: { # Stuff } diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 75ffcf4d..1987f449 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -14,9 +14,9 @@ baz ) ] - [ 1 ] + [1] - [ 1 ] + [1] [ b @@ -80,12 +80,12 @@ line ] ] - [ [ [ singleton ] ] ] - [ [ [ { } ] ] ] + [[[singleton]]] + [[[{}]]] [ [ [ - { } + {} multiline ] ] diff --git a/test/diff/monsters_2/out.nix b/test/diff/monsters_2/out.nix index 09f521f8..926682b1 100644 --- a/test/diff/monsters_2/out.nix +++ b/test/diff/monsters_2/out.nix @@ -15,7 +15,7 @@ options = { boot.kernel.features = mkOption { - default = { }; + default = {}; example = literalExpression "{ debug = true; }"; internal = true; description = '' diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index 063dc219..2bf7e744 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -62,7 +62,7 @@ stdenv.mkDerivation rec { description = "Checks whether the contrast between two colors meet the WCAG requirements"; homepage = "https://gitlab.gnome.org/World/design/contrast"; license = licenses.gpl3Plus; - maintainers = with maintainers; [ jtojnar ]; + maintainers = with maintainers; [jtojnar]; platforms = platforms.unix; }; } diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 288584f9..31e23692 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -74,7 +74,7 @@ in = - { }; + {}; example @@ -173,7 +173,7 @@ in or - [ ] + [] ) ++ @@ -251,7 +251,7 @@ in = - [ ]; + []; example diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 95be0fee..d5466c0d 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -2,7 +2,7 @@ ( # To find infinite recursion in NixOS option docs: # builtins.trace opt.loc - [ docOption ] ++ optionals subOptionsVisible subOptions + [docOption] ++ optionals subOptionsVisible subOptions ) ( # Filter out git @@ -37,7 +37,7 @@ # comment on operator inside || baseName == "tests.nix" # comment absorbable term - || { } + || {} # comment absorbable term 2 || { foo = "bar"; # multiline @@ -68,13 +68,13 @@ ( # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. - if actualPlugins == [ ] then - terraform.overrideAttrs (orig: { passthru = orig.passthru // passthru; }) + if actualPlugins == [] then + terraform.overrideAttrs (orig: {passthru = orig.passthru // passthru;}) else lib.appendToName "with-plugins" ( stdenv.mkDerivation { inherit (terraform) meta pname version; - nativeBuildInputs = [ makeWrapper ]; + nativeBuildInputs = [makeWrapper]; } ) ) @@ -159,13 +159,13 @@ some flags # multiline ] - ++ [ short ] + ++ [short] ++ [ more stuff # multiline ] - ++ (if foo then [ bar ] else [ baz ]) - ++ [ ] + ++ (if foo then [bar] else [baz]) + ++ [] ++ (optionals condition [ more items @@ -195,14 +195,14 @@ || cccccccccccccccccccc && ddddddddddddddddd || eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff then - [ ] + [] else if aaaaaaaaaaaaaaaaaaaaa || bbbbbbbbbbbbbbbbbbb && cccccccccccccccccccccccccccccccc || ddddddddddddddddd && eeeeeeeeeeeeeeeeeeee || fffffffffffffffffffffffffff then - [ ] + [] else if aaaaaaaaaaaaaa && bbbbbbbbbbbb && aaaaaaaaaaaaaa && bbbbbbbbbbbb || @@ -216,9 +216,9 @@ && eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff then - [ ] + [] else - { } + {} ) # Indentation @@ -228,7 +228,7 @@ zip zlib ] - ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] + ++ [(if (lib.versionAtLeast version "103") then nss_latest else nss_esr)] ) # Indentation with parenthesized multiline function call diff --git a/test/diff/pat_bind/out.nix b/test/diff/pat_bind/out.nix index 7105a893..1ea1f833 100644 --- a/test/diff/pat_bind/out.nix +++ b/test/diff/pat_bind/out.nix @@ -1,11 +1,11 @@ [ - ({ }@a: _) - ({ }@a: _) - ({ }@a: _) - ({ }@a: _) + ({}@a: _) + ({}@a: _) + ({}@a: _) + ({}@a: _) - (a@{ }: _) - (a@{ }: _) - (a@{ }: _) - (a@{ }: _) + (a@{}: _) + (a@{}: _) + (a@{}: _) + (a@{}: _) ] diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 3bbbf076..7d7e90a9 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -6,7 +6,7 @@ # Some comment baz, }: - { } + {} ) ( { @@ -14,7 +14,7 @@ bar, # Some comment baz, # More comment }: - { } + {} ) ( { @@ -23,14 +23,14 @@ # Some comment baz, }: - { } + {} ) ( { foo, bar, # Some comment }: - { } + {} ) ( a@{ @@ -61,15 +61,15 @@ }: _ ) - ({ }: _) - ({ a }: _) - ({ }: _) - ({ ... }: _) - ({ ... }: _) - ({ ... }: _) - ({ ... }: _) + ({}: _) + ({a}: _) + ({}: _) + ({...}: _) + ({...}: _) + ({...}: _) + ({...}: _) - ({ b, e, ... }: _) + ({b, e, ...}: _) ( { b, diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 413c3b48..01021da3 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -16,9 +16,9 @@ ) (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) - { a = with b; 1; } - { a = with b; 1 + 1; } - { a = with b; { c = 1; }; } + {a = with b; 1;} + {a = with b; 1 + 1;} + {a = with b; {c = 1;};} { a = with b; { c = 1; @@ -36,7 +36,7 @@ a = with b; 1; # comment } - (with a; with b; with c; { a = 1; }) + (with a; with b; with c; {a = 1;}) ( with a; with b; @@ -53,7 +53,7 @@ b = 2; } ) - { a = with b; with b; with b; 1; } + {a = with b; with b; with b; 1;} { binPath = with pkgs; From 27ce9961de991dc0816996f40e204bf506a40203 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 1 Dec 2023 23:37:46 +0100 Subject: [PATCH 086/125] Fix idempotency, enable --verify in tests The basic issue is that we must not emit a trailing comment at +2 of the current indentation. This is because, that comment will then be parsed as a leading comment to the next line, instead of a trailing comment to the current line, leading to a different output. Input: ```nix foo bar baz ( # comment b ) ``` Output 1: ```nix foo bar baz ( # comment b ) ``` Output 2: ```nix foo bar baz ( # comment b ) ``` Simply guaranteeing that all comments will be moved up such that such an emission never happens is not feasible, due to a large number of edge cases. Instead, the currently implemented solution is to track trailing comments specially in the intermediate representation, and let the renderer handle this. The render will check for such a situation, and insert an additional space to avoid it: ```nix foo bar baz ( # comment b ) ``` This may look ugly, but in real-world code it should be sufficiently rare. Most of the time, moving comments up already happens and thus eliminates a lot of potential cases entirely. This is merely a fallback. Most of the time, the output code will look like this instead: ```nix foo bar baz # comment (b) ``` The double space before a trailing comment is most likely to occur with single-letter identifiers. --- src/Nixfmt.hs | 12 ++++-- src/Nixfmt/Parser.hs | 3 +- src/Nixfmt/Predoc.hs | 73 +++++++++++++++++++++++++--------- src/Nixfmt/Pretty.hs | 4 +- src/Nixfmt/Types.hs | 22 +++++++++- test/diff/apply/out.nix | 2 +- test/diff/inherit_from/out.nix | 64 ++++++++++++++--------------- test/diff/key_value/out.nix | 8 ++-- test/diff/monsters_4/out.nix | 2 +- test/diff/paren/out.nix | 30 +++++++------- test/diff/pattern/out.nix | 70 ++++++++++++++++---------------- test/test.sh | 2 +- 12 files changed, 176 insertions(+), 116 deletions(-) diff --git a/src/Nixfmt.hs b/src/Nixfmt.hs index ab83aa79..3c2619d3 100644 --- a/src/Nixfmt.hs +++ b/src/Nixfmt.hs @@ -11,6 +11,7 @@ module Nixfmt , formatVerify ) where +import Data.Function ((&)) import Data.Bifunctor (bimap, first) import Data.Text (Text, unpack) import qualified Text.Megaparsec as Megaparsec (parse) @@ -35,13 +36,16 @@ formatVerify :: Width -> FilePath -> Text -> Either String Text formatVerify width path unformatted = do unformattedParsed <- parse unformatted let formattedOnce = layout width unformattedParsed - formattedOnceParsed <- parse formattedOnce + formattedOnceParsed <- flip first (parse formattedOnce) $ + (\x -> pleaseReport "Fails to parse after formatting.\n" <> x <> "\n\nAfter Formatting:\n" <> unpack formattedOnce) let formattedTwice = layout width formattedOnceParsed if formattedOnceParsed /= unformattedParsed - then pleaseReport "Parses differently after formatting." + then Left $ pleaseReport "Parses differently after formatting." & + \x -> (x <> "\n\nBefore formatting:\n" <> (show unformattedParsed) <> "\n\nAfter formatting:\n" <> (show formattedOnceParsed)) else if formattedOnce /= formattedTwice - then flip first (pleaseReport "Nixfmt is not idempotent.") $ \x -> (x <> "\nAfter one formatting:\n" <> unpack formattedOnce <> "\nAfter two:\n" <> unpack formattedTwice) + then Left $ pleaseReport "Nixfmt is not idempotent." & + \x -> (x <> "\n\nAfter one formatting:\n" <> unpack formattedOnce <> "\n\nAfter two:\n" <> unpack formattedTwice) else Right formattedOnce where parse = first errorBundlePretty . Megaparsec.parse file path - pleaseReport x = Left $ path <> ": " <> x <> " This is a bug in nixfmt. Please report it at https://github.com/serokell/nixfmt" + pleaseReport x = path <> ": " <> x <> " This is a bug in nixfmt. Please report it at https://github.com/serokell/nixfmt" diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index 694bde64..ba323d19 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -146,9 +146,10 @@ isEmptyLine [TextPart t] = isSpaces t isEmptyLine _ = False -- | Drop the first line of a string if it is empty. +-- However, don't drop it if it is the only line (empty string) fixFirstLine :: [[StringPart]] -> [[StringPart]] fixFirstLine [] = [] -fixFirstLine (x : xs) = if isEmptyLine x' then xs else x' : xs +fixFirstLine (x : xs) = if isEmptyLine x' && not (null xs) then xs else x' : xs where x' = normalizeLine x -- | Empty the last line if it contains only spaces. diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 8344739a..763b22cd 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -11,6 +11,7 @@ module Nixfmt.Predoc ( text , comment + , trailingComment , trailing , sepBy , surroundWith @@ -95,7 +96,10 @@ data DocAnn -- Comments do not count towards some line length limits -- Trailing tokens have the property that they will only exist in expanded groups, and "swallowed" in compact groups -data TextAnn = Regular | Comment | Trailing +-- Trailing comments are like comments, but marked differently for special treatment further down the line +-- (The difference is that trailing comments are guaranteed to be single "# text" tokens, while all other comments +-- may be composite and multi-line) +data TextAnn = Regular | Comment | TrailingComment | Trailing deriving (Show, Eq) -- | Single document element. Documents are modeled as lists of these elements @@ -132,6 +136,11 @@ comment :: Text -> Doc comment "" = [] comment t = [Text Comment t] +-- Comment at the end of a line +trailingComment :: Text -> Doc +trailingComment "" = [] +trailingComment t = [Text TrailingComment t] + -- Text tokens that are only needed in expanded groups trailing :: Text -> Doc trailing "" = [] @@ -236,6 +245,7 @@ isHardSpacing _ = False -- Therefore nodes are counted as comments if they only contain comments or hard spacings isComment :: DocE -> Bool isComment (Text Comment _) = True +isComment (Text TrailingComment _) = True isComment (Node _ inner) = all (\x -> isComment x || isHardSpacing x) inner isComment _ = False @@ -340,31 +350,36 @@ textWidth :: Text -> Int textWidth = Text.length -- | Attempt to fit a list of documents in a single line of a specific width. -fits :: Int -> Doc -> Maybe Text -fits c _ | c < 0 = Nothing -fits _ [] = Just "" +-- ni — next indentation. Only used for trailing comment calculations +-- c — allowed width +fits :: Int -> Int -> Doc -> Maybe Text +fits _ c _ | c < 0 = Nothing +fits _ _ [] = Just "" -- This case is impossible in the input thanks to fixup, but may happen -- due to our recursion on nodes below -fits c (Spacing a:Spacing b:xs) = fits c (Spacing (mergeSpacings a b):xs) -fits c (x:xs) = case x of - Text Regular t -> (t<>) <$> fits (c - textWidth t) xs - Text Comment t -> (t<>) <$> fits c xs - Text Trailing _ -> fits c xs - Spacing Softbreak -> fits c xs - Spacing Break -> fits c xs - Spacing Softspace -> (" "<>) <$> fits (c - 1) xs - Spacing Space -> (" "<>) <$> fits (c - 1) xs - Spacing Hardspace -> (" "<>) <$> fits (c - 1) xs +fits ni c (Spacing a:Spacing b:xs) = fits ni c (Spacing (mergeSpacings a b):xs) +fits ni c (x:xs) = case x of + Text Regular t -> (t<>) <$> fits (ni - textWidth t) (c - textWidth t) xs + Text Comment t -> (t<>) <$> fits ni c xs + Text TrailingComment t | ni == 0 -> ((" " <> t) <>) <$> fits ni c xs + | otherwise -> (t<>) <$> fits ni c xs + Text Trailing _ -> fits ni c xs + Spacing Softbreak -> fits ni c xs + Spacing Break -> fits ni c xs + Spacing Softspace -> (" "<>) <$> fits (ni - 1) (c - 1) xs + Spacing Space -> (" "<>) <$> fits (ni - 1) (c - 1) xs + Spacing Hardspace -> (" "<>) <$> fits (ni - 1) (c - 1) xs Spacing Hardline -> Nothing Spacing Emptyline -> Nothing Spacing (Newlines _) -> Nothing - Node _ ys -> fits c $ ys ++ xs + Node _ ys -> fits ni c $ ys ++ xs -- | Find the width of the first line in a list of documents, using target -- width 0, which always forces line breaks when possible. firstLineWidth :: Doc -> Int firstLineWidth [] = 0 firstLineWidth (Text Comment _ : xs) = firstLineWidth xs +firstLineWidth (Text TrailingComment _ : xs) = firstLineWidth xs firstLineWidth (Text _ t : xs) = textWidth t + firstLineWidth xs -- This case is impossible in the input thanks to fixup, but may happen -- due to our recursion on nodes below @@ -387,20 +402,41 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth go c (Node (Group _) ys : xs) = - case fits (c - firstLineWidth xs) ys of + case fits 0 (c - firstLineWidth xs) ys of Nothing -> go c (ys ++ xs) Just t -> go (c - textWidth t) xs go c (Node _ ys : xs) = go c (ys ++ xs) -- Calculate the amount of indentation until the first token +-- This assumes the input to be an unexpanded group at the start of a new line firstLineIndent :: Doc -> Int firstLineIndent ((Node (Nest n) xs) : _) = n + firstLineIndent xs firstLineIndent ((Node _ xs) : _) = firstLineIndent xs firstLineIndent _ = 0 +-- From a current indent and following tokens, calculate the effective indent of the next text token +nextIndent :: Int -> [Chunk] -> Int +nextIndent _ (Chunk ti (Text _ _) : _) = ti +nextIndent _ (Chunk _ (Spacing s) : Chunk ti (Node (Nest l) ys) : xs) + | s == Break || s == Space || s == Hardline + = nextIndent (ti + l) (map (Chunk (ti+l)) ys ++ xs) +nextIndent _ (Chunk ti (Spacing s) : xs) + | s == Break || s == Space || s == Hardline + = nextIndent ti xs +nextIndent _ (Chunk _ (Spacing Emptyline) : _) = 0 +nextIndent _ (Chunk _ (Spacing (Newlines _)) : _) = 0 +nextIndent _ (Chunk ti (Spacing Softbreak) : xs) = nextIndent ti xs +nextIndent _ (Chunk ti (Spacing Softspace) : xs) = nextIndent ti xs +nextIndent ci (Chunk ti (Node (Nest l) ys) : xs) = nextIndent ci (map (Chunk (ti+l)) ys ++ xs) +nextIndent ci (Chunk _ (Node Base ys) : xs) = nextIndent ci (map (Chunk ci) ys ++ xs) +nextIndent ci (Chunk ti (Node _ ys) : xs) = nextIndent ci (map (Chunk ti) ys ++ xs) +nextIndent ci (_:xs) = nextIndent ci xs +nextIndent _ [] = 0 + -- | A document element with target indentation data Chunk = Chunk Int DocE + deriving (Show) -- | Create `n` newlines newlines :: Int -> Text @@ -447,6 +483,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) putText ts = put (cc + sum (map textWidth ts), ci) $> ts putNL = put (0, ti) in case x of + Text TrailingComment t | not needsIndent && cc == nextIndent ci xs -> putText [" ", t] Text _ t -> putText [lineStart, t] -- This code treats whitespace as "expanded" @@ -522,8 +559,8 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) _ -> grp i = ti + firstLineIndent grp' in - fits (tw - firstLineWidth rest) grp' + fits ((nextIndent ci (map (Chunk ci) rest)) - ci) (tw - firstLineWidth rest) grp' <&> \t -> ([indent i, t], (i + textWidth t, ci)) else - fits (tw + (ci - cc) - firstLineWidth rest) grp + fits ((nextIndent ci (map (Chunk ci) rest)) - cc) (tw + (ci - cc) - firstLineWidth rest) grp <&> \t -> ([t], (cc + textWidth t, ci)) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 769a6007..ca8d02f0 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -19,7 +19,7 @@ import qualified Data.Text as Text -- import Debug.Trace (traceShowId) import Nixfmt.Predoc (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailing, textWidth, + nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailingComment, trailing, textWidth, unexpandSpacing') import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, @@ -47,7 +47,7 @@ moveTrailingCommentUp a = a instance Pretty TrailingComment where pretty (TrailingComment c) - = hardspace <> comment ("# " <> c) <> hardline + = hardspace <> trailingComment ("# " <> c) <> hardline instance Pretty Trivium where pretty EmptyLine = emptyline diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index cd92bba5..e3719ab5 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -37,13 +37,16 @@ newtype TrailingComment = TrailingComment Text deriving (Eq, Show) data Ann a = Ann Trivia a (Maybe TrailingComment) - deriving (Show) -- | Equality of annotated syntax is defined as equality of their corresponding -- semantics, thus ignoring the annotations. instance Eq a => Eq (Ann a) where Ann _ x _ == Ann _ y _ = x == y +-- Trivia is ignored for Eq, so also don't show +instance Show a => Show (Ann a) where + show (Ann _ a _) = show a + data Item a -- | An item with a list of line comments that apply to it. There is no -- empty line between the comments and the stuff it applies to. @@ -106,7 +109,22 @@ data Parameter = IDParameter Leaf | SetParameter Leaf [ParamAttr] Leaf | ContextParameter Parameter Leaf Parameter - deriving (Eq, Show) + deriving (Show) + +instance Eq Parameter where + (IDParameter l) == (IDParameter r) = l == r + (SetParameter l1 l2 l3) == (SetParameter r1 r2 r3) = + l1 == r1 + && cmp l2 r2 + && l3 == r3 + 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 (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 + _ == _ = False data Expression = Term Term diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 241e6ad8..b0267920 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -91,7 +91,7 @@ ) ( # a - b # c + b # c d # e ) ) diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index ae9217ef..88cce4ae 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -157,7 +157,7 @@ } { inherit - ( # b + ( # b c ) f @@ -166,7 +166,7 @@ } { inherit - ( # b + ( # b c ) f @@ -175,7 +175,7 @@ } { inherit - ( # b + ( # b c ) f # g @@ -184,7 +184,7 @@ } { inherit - ( # b + ( # b c ) f # g @@ -193,7 +193,7 @@ } { inherit - ( # b + ( # b c ) # e f @@ -202,7 +202,7 @@ } { inherit - ( # b + ( # b c ) # e f @@ -211,7 +211,7 @@ } { inherit - ( # b + ( # b c ) # e f # g @@ -220,7 +220,7 @@ } { inherit - ( # b + ( # b c ) # e f # g @@ -229,7 +229,7 @@ } { inherit - ( # b + ( # b c # d ) f @@ -238,7 +238,7 @@ } { inherit - ( # b + ( # b c # d ) f @@ -247,7 +247,7 @@ } { inherit - ( # b + ( # b c # d ) f # g @@ -256,7 +256,7 @@ } { inherit - ( # b + ( # b c # d ) f # g @@ -265,7 +265,7 @@ } { inherit - ( # b + ( # b c # d ) # e f @@ -274,7 +274,7 @@ } { inherit - ( # b + ( # b c # d ) # e f @@ -283,7 +283,7 @@ } { inherit - ( # b + ( # b c # d ) # e f # g @@ -292,7 +292,7 @@ } { inherit - ( # b + ( # b c # d ) # e f # g @@ -429,7 +429,7 @@ } { inherit # a - ( # b + ( # b c ) f @@ -438,7 +438,7 @@ } { inherit # a - ( # b + ( # b c ) f @@ -447,7 +447,7 @@ } { inherit # a - ( # b + ( # b c ) f # g @@ -456,7 +456,7 @@ } { inherit # a - ( # b + ( # b c ) f # g @@ -465,7 +465,7 @@ } { inherit # a - ( # b + ( # b c ) # e f @@ -474,7 +474,7 @@ } { inherit # a - ( # b + ( # b c ) # e f @@ -483,7 +483,7 @@ } { inherit # a - ( # b + ( # b c ) # e f # g @@ -492,7 +492,7 @@ } { inherit # a - ( # b + ( # b c ) # e f # g @@ -501,7 +501,7 @@ } { inherit # a - ( # b + ( # b c # d ) f @@ -510,7 +510,7 @@ } { inherit # a - ( # b + ( # b c # d ) f @@ -519,7 +519,7 @@ } { inherit # a - ( # b + ( # b c # d ) f # g @@ -528,7 +528,7 @@ } { inherit # a - ( # b + ( # b c # d ) f # g @@ -537,7 +537,7 @@ } { inherit # a - ( # b + ( # b c # d ) # e f @@ -546,7 +546,7 @@ } { inherit # a - ( # b + ( # b c # d ) # e f @@ -555,7 +555,7 @@ } { inherit # a - ( # b + ( # b c # d ) # e f # g @@ -564,7 +564,7 @@ } { inherit # a - ( # b + ( # b c # d ) # e f # g diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index bbbd14d0..571c14ac 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -22,21 +22,21 @@ rec { ; }; e = { - a # b + a # b = 1; }; f = { - a # b + a # b = 1 # d ; }; h = { - a # b + a # b = # c 1; }; i = { - a # b + a # b = # c 1 # d ; diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index d330900d..632b1113 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -1,4 +1,4 @@ -{ # Foo +{ # Foo stdenv # Foo , # Foo lib # Foo diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 02cce54f..9f467190 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -30,59 +30,59 @@ ) # e ) ( - ( # b + ( # b c ) ) ( - ( # b + ( # b c ) # e ) ( - ( # b + ( # b c # d ) ) ( - ( # b + ( # b c # d ) # e ) - ( # a + ( # a (c) ) - ( # a + ( # a (c) # e ) - ( # a + ( # a ( c # d ) ) - ( # a + ( # a ( c # d ) # e ) - ( # a - ( # b + ( # a + ( # b c ) ) - ( # a - ( # b + ( # a + ( # b c ) # e ) - ( # a - ( # b + ( # a + ( # b c # d ) ) ( # a - ( # b + ( # b c # d ) # e ) diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 7d7e90a9..1887e296 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -335,7 +335,7 @@ _ ) ( - { # a + { # a b, e, ... @@ -343,7 +343,7 @@ _ ) ( - { # a + { # a b, e, ... # h @@ -351,7 +351,7 @@ _ ) ( - { # a + { # a b, e, # g ... @@ -359,7 +359,7 @@ _ ) ( - { # a + { # a b, e, # g ... # h @@ -367,7 +367,7 @@ _ ) ( - { # a + { # a b, e, # f ... @@ -375,7 +375,7 @@ _ ) ( - { # a + { # a b, e, # f ... # h @@ -383,7 +383,7 @@ _ ) ( - { # a + { # a b, e # f , # g @@ -392,7 +392,7 @@ _ ) ( - { # a + { # a b, e # f , # g @@ -401,7 +401,7 @@ _ ) ( - { # a + { # a b, # d e, ... @@ -409,7 +409,7 @@ _ ) ( - { # a + { # a b, # d e, ... # h @@ -417,7 +417,7 @@ _ ) ( - { # a + { # a b, # d e, # g ... @@ -425,7 +425,7 @@ _ ) ( - { # a + { # a b, # d e, # g ... # h @@ -433,7 +433,7 @@ _ ) ( - { # a + { # a b, # d e, # f ... @@ -441,7 +441,7 @@ _ ) ( - { # a + { # a b, # d e, # f ... # h @@ -449,7 +449,7 @@ _ ) ( - { # a + { # a b, # d e # f , # g @@ -458,7 +458,7 @@ _ ) ( - { # a + { # a b, # d e # f , # g @@ -467,7 +467,7 @@ _ ) ( - { # a + { # a b, # c e, ... @@ -475,7 +475,7 @@ _ ) ( - { # a + { # a b, # c e, ... # h @@ -483,7 +483,7 @@ _ ) ( - { # a + { # a b, # c e, # g ... @@ -491,7 +491,7 @@ _ ) ( - { # a + { # a b, # c e, # g ... # h @@ -499,7 +499,7 @@ _ ) ( - { # a + { # a b, # c e, # f ... @@ -507,7 +507,7 @@ _ ) ( - { # a + { # a b, # c e, # f ... # h @@ -515,7 +515,7 @@ _ ) ( - { # a + { # a b, # c e # f , # g @@ -524,7 +524,7 @@ _ ) ( - { # a + { # a b, # c e # f , # g @@ -533,7 +533,7 @@ _ ) ( - { # a + { # a b # c , # d e, @@ -542,7 +542,7 @@ _ ) ( - { # a + { # a b # c , # d e, @@ -551,7 +551,7 @@ _ ) ( - { # a + { # a b # c , # d e, # g @@ -560,7 +560,7 @@ _ ) ( - { # a + { # a b # c , # d e, # g @@ -569,7 +569,7 @@ _ ) ( - { # a + { # a b # c , # d e, # f @@ -578,7 +578,7 @@ _ ) ( - { # a + { # a b # c , # d e, # f @@ -587,7 +587,7 @@ _ ) ( - { # a + { # a b # c , # d e # f @@ -597,7 +597,7 @@ _ ) ( - { # a + { # a b # c , # d e # f @@ -614,13 +614,13 @@ _ ) ( - { # a + { # a b # a - ? # a + ? # a null # c , # d e # a - ? # a + ? # a null # f , # g ... # h diff --git a/test/test.sh b/test/test.sh index 74977086..63befab4 100755 --- a/test/test.sh +++ b/test/test.sh @@ -41,7 +41,7 @@ for file in test/diff/**/in.nix; do outfile="$(dirname "$file")/out.nix" echo "Checking $file …" - out="$(nixfmt < "$file")" + out="$(nixfmt --verify < "$file")" if diff --color=always --unified "$outfile" <(echo "$out"); then echo "[OK]" From 21ef16e7fe9011ecd77ba05fa5873287e4c0d2a4 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 1 Dec 2023 23:51:46 +0100 Subject: [PATCH 087/125] Move some more comments up --- src/Nixfmt/Pretty.hs | 10 +-- test/diff/apply/out.nix | 9 +-- test/diff/idioms_lib_5/out.nix | 6 +- test/diff/inherit_from/out.nix | 128 ++++++++++++++++----------------- test/diff/monsters_4/out.nix | 47 ++++++------ test/diff/paren/out.nix | 55 +++++++------- test/diff/pattern/out.nix | 104 +++++++++++++++++---------- 7 files changed, 198 insertions(+), 161 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index ca8d02f0..6220e323 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -224,7 +224,7 @@ prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = base $ group $ pretty paropen <> lineL <> nest 2 (group expr) <> lineR <> pretty parclose + = base $ group $ pretty (moveTrailingCommentUp paropen) <> lineL <> nest 2 (group expr) <> lineR <> pretty parclose where (lineL, lineR) = case expr of @@ -313,12 +313,12 @@ instance Pretty Parameter where -- {}: pretty (SetParameter bopen [] bclose) - = group $ pretty bopen <> pretty bclose + = group $ pretty (moveTrailingCommentUp bopen) <> pretty bclose -- { stuff }: pretty (SetParameter bopen attrs bclose) = group $ - pretty bopen + pretty (moveTrailingCommentUp bopen) <> (surroundWith sep $ nest 2 $ sepBy (sep<>hardspace) $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) <> pretty bclose where @@ -379,7 +379,9 @@ prettyApp commentPre pre post commentPost f a absorbLast arg = group' False $ nest 2 $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded - (fWithoutComment, comment') = mapFirstToken' (\(Ann leading token trailing') -> (Ann [] token trailing', leading)) f + (fWithoutComment, comment') = mapFirstToken' + ((\(Ann leading token trailing') -> (Ann [] token trailing', leading)) . moveTrailingCommentUp) + f renderedF = pre <> group (absorbApp fWithoutComment) renderedFUnexpanded = unexpandSpacing' Nothing renderedF diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index b0267920..7433fc3f 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -86,13 +86,14 @@ ] (a b) ((a b) (a b) - (a # b - c + ( + # b + a c ) ( # a - b # c - d # e + # c + b d # e ) ) '' diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 84b2ad82..735c6a1f 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -345,9 +345,9 @@ let check = x: x == {} - || ( # Accept {} for tests that are unsupported - isDerivation x && x ? meta.timeout - ); + || + # Accept {} for tests that are unsupported + (isDerivation x && x ? meta.timeout); merge = lib.options.mergeOneOption; } ); diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 88cce4ae..4dbd6154 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -157,79 +157,72 @@ } { inherit - ( # b - c - ) + # b + (c) f h ; } { inherit - ( # b - c - ) + # b + (c) f h # i ; } { inherit - ( # b - c - ) + # b + (c) f # g h ; } { inherit - ( # b - c - ) + # b + (c) f # g h # i ; } { inherit - ( # b - c - ) # e + # b + (c) # e f h ; } { inherit - ( # b - c - ) # e + # b + (c) # e f h # i ; } { inherit - ( # b - c - ) # e + # b + (c) # e f # g h ; } { inherit - ( # b - c - ) # e + # b + (c) # e f # g h # i ; } { inherit - ( # b + # b + ( c # d ) f @@ -238,7 +231,8 @@ } { inherit - ( # b + # b + ( c # d ) f @@ -247,7 +241,8 @@ } { inherit - ( # b + # b + ( c # d ) f # g @@ -256,7 +251,8 @@ } { inherit - ( # b + # b + ( c # d ) f # g @@ -265,7 +261,8 @@ } { inherit - ( # b + # b + ( c # d ) # e f @@ -274,7 +271,8 @@ } { inherit - ( # b + # b + ( c # d ) # e f @@ -283,7 +281,8 @@ } { inherit - ( # b + # b + ( c # d ) # e f # g @@ -292,7 +291,8 @@ } { inherit - ( # b + # b + ( c # d ) # e f # g @@ -429,79 +429,72 @@ } { inherit # a - ( # b - c - ) + # b + (c) f h ; } { inherit # a - ( # b - c - ) + # b + (c) f h # i ; } { inherit # a - ( # b - c - ) + # b + (c) f # g h ; } { inherit # a - ( # b - c - ) + # b + (c) f # g h # i ; } { inherit # a - ( # b - c - ) # e + # b + (c) # e f h ; } { inherit # a - ( # b - c - ) # e + # b + (c) # e f h # i ; } { inherit # a - ( # b - c - ) # e + # b + (c) # e f # g h ; } { inherit # a - ( # b - c - ) # e + # b + (c) # e f # g h # i ; } { inherit # a - ( # b + # b + ( c # d ) f @@ -510,7 +503,8 @@ } { inherit # a - ( # b + # b + ( c # d ) f @@ -519,7 +513,8 @@ } { inherit # a - ( # b + # b + ( c # d ) f # g @@ -528,7 +523,8 @@ } { inherit # a - ( # b + # b + ( c # d ) f # g @@ -537,7 +533,8 @@ } { inherit # a - ( # b + # b + ( c # d ) # e f @@ -546,7 +543,8 @@ } { inherit # a - ( # b + # b + ( c # d ) # e f @@ -555,7 +553,8 @@ } { inherit # a - ( # b + # b + ( c # d ) # e f # g @@ -564,7 +563,8 @@ } { inherit # a - ( # b + # b + ( c # d ) # e f # g diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index 632b1113..c24bf122 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -1,4 +1,5 @@ -{ # Foo +# Foo +{ stdenv # Foo , # Foo lib # Foo @@ -43,28 +44,28 @@ stdenv.mkDerivation # Foo "0.0.5"; # Foo src # Foo = # Foo - fetchFromGitLab # Foo - { - # Foo - domain # Foo - = # Foo - "gitlab.gnome.org"; # Foo - group # Foo - = # Foo - "World"; # Foo - owner # Foo - = # Foo - "design"; # Foo - repo # Foo - = # Foo - "contrast"; # Foo - rev # Foo - = # Foo - version; # Foo - sha256 # Foo - = # Foo - "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo - }; # Foo + # Foo + fetchFromGitLab { + # Foo + domain # Foo + = # Foo + "gitlab.gnome.org"; # Foo + group # Foo + = # Foo + "World"; # Foo + owner # Foo + = # Foo + "design"; # Foo + repo # Foo + = # Foo + "contrast"; # Foo + rev # Foo + = # Foo + version; # Foo + sha256 # Foo + = # Foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo + }; # Foo cargoDeps # Foo = # Foo rustPlatform.fetchCargoTarball # Foo diff --git a/test/diff/paren/out.nix b/test/diff/paren/out.nix index 9f467190..ae628d76 100644 --- a/test/diff/paren/out.nix +++ b/test/diff/paren/out.nix @@ -30,59 +30,64 @@ ) # e ) ( - ( # b - c - ) + # b + (c) ) ( - ( # b - c - ) # e + # b + (c) # e ) ( - ( # b + # b + ( c # d ) ) ( - ( # b + # b + ( c # d ) # e ) - ( # a - (c) - ) - ( # a + # a + ((c)) + # a + ( (c) # e ) - ( # a + # a + ( ( c # d ) ) - ( # a + # a + ( ( c # d ) # e ) - ( # a - ( # b - c - ) + # a + ( + # b + (c) ) - ( # a - ( # b - c - ) # e + # a + ( + # b + (c) # e ) - ( # a - ( # b + # a + ( + # b + ( c # d ) ) ( # a - ( # b + # b + ( c # d ) # e ) diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 1887e296..bf0b9300 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -335,15 +335,12 @@ _ ) ( - { # a - b, - e, - ... - }: - _ + # a + {b, e, ...}: _ ) ( - { # a + # a + { b, e, ... # h @@ -351,7 +348,8 @@ _ ) ( - { # a + # a + { b, e, # g ... @@ -359,7 +357,8 @@ _ ) ( - { # a + # a + { b, e, # g ... # h @@ -367,7 +366,8 @@ _ ) ( - { # a + # a + { b, e, # f ... @@ -375,7 +375,8 @@ _ ) ( - { # a + # a + { b, e, # f ... # h @@ -383,7 +384,8 @@ _ ) ( - { # a + # a + { b, e # f , # g @@ -392,7 +394,8 @@ _ ) ( - { # a + # a + { b, e # f , # g @@ -401,7 +404,8 @@ _ ) ( - { # a + # a + { b, # d e, ... @@ -409,7 +413,8 @@ _ ) ( - { # a + # a + { b, # d e, ... # h @@ -417,7 +422,8 @@ _ ) ( - { # a + # a + { b, # d e, # g ... @@ -425,7 +431,8 @@ _ ) ( - { # a + # a + { b, # d e, # g ... # h @@ -433,7 +440,8 @@ _ ) ( - { # a + # a + { b, # d e, # f ... @@ -441,7 +449,8 @@ _ ) ( - { # a + # a + { b, # d e, # f ... # h @@ -449,7 +458,8 @@ _ ) ( - { # a + # a + { b, # d e # f , # g @@ -458,7 +468,8 @@ _ ) ( - { # a + # a + { b, # d e # f , # g @@ -467,7 +478,8 @@ _ ) ( - { # a + # a + { b, # c e, ... @@ -475,7 +487,8 @@ _ ) ( - { # a + # a + { b, # c e, ... # h @@ -483,7 +496,8 @@ _ ) ( - { # a + # a + { b, # c e, # g ... @@ -491,7 +505,8 @@ _ ) ( - { # a + # a + { b, # c e, # g ... # h @@ -499,7 +514,8 @@ _ ) ( - { # a + # a + { b, # c e, # f ... @@ -507,7 +523,8 @@ _ ) ( - { # a + # a + { b, # c e, # f ... # h @@ -515,7 +532,8 @@ _ ) ( - { # a + # a + { b, # c e # f , # g @@ -524,7 +542,8 @@ _ ) ( - { # a + # a + { b, # c e # f , # g @@ -533,7 +552,8 @@ _ ) ( - { # a + # a + { b # c , # d e, @@ -542,7 +562,8 @@ _ ) ( - { # a + # a + { b # c , # d e, @@ -551,7 +572,8 @@ _ ) ( - { # a + # a + { b # c , # d e, # g @@ -560,7 +582,8 @@ _ ) ( - { # a + # a + { b # c , # d e, # g @@ -569,7 +592,8 @@ _ ) ( - { # a + # a + { b # c , # d e, # f @@ -578,7 +602,8 @@ _ ) ( - { # a + # a + { b # c , # d e, # f @@ -587,7 +612,8 @@ _ ) ( - { # a + # a + { b # c , # d e # f @@ -597,7 +623,8 @@ _ ) ( - { # a + # a + { b # c , # d e # f @@ -614,7 +641,8 @@ _ ) ( - { # a + # a + { b # a ? # a null # c From fda8afa358aed04c09e1cd1e899f2d38e2303f9a Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 10 Dec 2023 17:09:23 +0100 Subject: [PATCH 088/125] Function application: Fix indentation with multiline function arguments --- src/Nixfmt/Predoc.hs | 12 ++++++-- src/Nixfmt/Pretty.hs | 49 ++++++++++++++++++-------------- test/diff/apply/in.nix | 40 ++++++++++++++++++++++++++ test/diff/apply/out.nix | 50 +++++++++++++++++++++++++++++++++ test/diff/idioms_pkgs_5/out.nix | 22 +++++++-------- 5 files changed, 138 insertions(+), 35 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 763b22cd..0c8ca809 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -41,10 +41,11 @@ import Data.List (intersperse) import Data.Function ((&)) import Data.Functor ((<&>), ($>)) import Data.Functor.Identity (runIdentity) +import Data.Bifunctor (second) import Data.Maybe (fromMaybe) import Data.Text as Text (Text, concat, length, replicate, strip) import GHC.Stack (HasCallStack) --- import Debug.Trace (traceShow, traceShowId) +import Debug.Trace (traceShow, traceShowId) import Control.Applicative ((<|>)) import Control.Monad.Trans.State.Strict (State, StateT, StateT(..), mapStateT, state, runState, evalState, get, put) @@ -279,6 +280,11 @@ unexpandSpacing' n (Spacing Softbreak:xs) = unexpandSpacing' n xs unexpandSpacing' _ (Spacing _:_) = Nothing unexpandSpacing' n ((Node _ xs):ys) = unexpandSpacing' n $ xs <> ys +simplifyNode :: DocAnn -> Doc -> Doc +simplifyNode _ [] = [] +simplifyNode (Group False) [Node (Group False) body] = body +simplifyNode _ x = x + -- | Fix up a Doc: -- - Move some spacings (those which are not relevant for group calculations) -- out of the start/end of Groups and Nests if possible. @@ -303,7 +309,7 @@ fixup (a@(Spacing _) : Node 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 || (moveComment && isComment x)) $ fixup xs - (post, body) = spanEnd isHardSpacing rest + (post, body) = (second $ simplifyNode ann) $ spanEnd isHardSpacing rest in if null body then -- Dissolve empty node fixup $ (a : pre) ++ post ++ ys @@ -314,7 +320,7 @@ fixup (Node ann xs : ys) = let moveComment = case ann of { Nest _ -> False; _ -> True } (pre, rest) = span (\x -> isHardSpacing x || (moveComment && isComment x)) $ fixup xs - (post, body) = spanEnd isHardSpacing rest + (post, body) = (second $ simplifyNode ann) $ spanEnd isHardSpacing rest in if null body then fixup $ pre ++ post ++ ys else diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 6220e323..c62eaacb 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -11,10 +11,10 @@ module Nixfmt.Pretty where import Prelude hiding (String) import Data.Char (isSpace) -import Data.Maybe (fromMaybe, isJust, fromJust) +import Data.Maybe (fromMaybe, isJust, fromJust, maybeToList) import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix) import qualified Data.Text as Text - (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile, all) + (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile) -- import Debug.Trace (traceShowId) import Nixfmt.Predoc @@ -25,7 +25,7 @@ import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), Token(..), TrailingComment(..), Trivium(..), - Whole(..), tokenText, mapFirstToken', mapLastToken') + Whole(..), tokenText, mapFirstToken, mapFirstToken', mapLastToken') import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) prettyCommentLine :: Text -> Doc @@ -134,7 +134,7 @@ instance Pretty Binder where (Term _) -> group' False (line <> pretty expr) -- Function call -- Absorb if all arguments except the last fit into the line, start on new line otherwise - (Application f a) -> prettyApp hardline line mempty mempty f a + (Application f a) -> prettyApp False line False f a -- Absorb function declarations but only those with simple parameter(s) (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise @@ -148,7 +148,7 @@ instance Pretty Binder where group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp hardline (pretty TUpdate <> hardspace) mempty mempty f a + line <> (group l) <> line <> prettyApp False (pretty TUpdate <> hardspace) False f a -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> @@ -158,7 +158,7 @@ instance Pretty Binder where group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TConcat Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp hardline (pretty TConcat <> hardspace) mempty mempty f a + line <> (group l) <> line <> prettyApp False (pretty TConcat <> 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) @@ -214,12 +214,9 @@ prettyTerm (List (Ann pre paropen post) items parclose) = prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) -- Parenthesized application -prettyTerm (Parenthesized (Ann pre paropen post) (Application f a) parclose) - = base $ group $ pretty (Ann pre paropen Nothing) <> nest 2 ( - -- Move comment trailing on '(' to next line, combine with comment from application - case pretty post of { [] -> []; c -> hardline <> c } - <> base (prettyApp hardline mempty line' hardline f a) - <> case pretty post of { [] -> mempty; _ -> hardline } +prettyTerm (Parenthesized paropen (Application f a) parclose) + = base $ group $ pretty (moveTrailingCommentUp paropen) <> nest 2 ( + base $ prettyApp True mempty True f a ) <> pretty parclose -- Parentheses @@ -364,17 +361,24 @@ instance Pretty Parameter where -- then start on a new line instead". -- Out of necessity, callers may also inject `commentPre` and `commentPost`, which will be added before/after the entire -- thing if the function has a comment associated with its first token -prettyApp :: Doc -> Doc -> Doc -> Doc -> Expression -> Expression -> Doc -prettyApp commentPre pre post commentPost f a +prettyApp :: Bool -> Doc -> Bool -> Expression -> Expression -> Doc +prettyApp indentFunction pre hasPost f a = let absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest 2 (group a')) - absorbApp expr = pretty expr + absorbApp expr + | indentFunction && (null comment') = nest 2 $ group' False $ line' <> pretty expr + | otherwise = pretty expr absorbLast (Term t) | isAbsorbable t = group' True $ nest 2 $ prettyTerm t absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) - <> (surroundWith line' $ group $ nest 2 $ pretty post' <> pretty expr) + -- Move any tryiling comments on the opening parenthesis down into the body + <> (surroundWith line' $ group $ nest 2 $ base $ + mapFirstToken + (\(Ann leading token trailing') -> (Ann (maybeToList (toLineComment <$> post') ++ leading) token trailing')) + expr + ) <> pretty close absorbLast arg = group' False $ nest 2 $ pretty arg @@ -385,14 +389,17 @@ prettyApp commentPre pre post commentPost f a renderedF = pre <> group (absorbApp fWithoutComment) renderedFUnexpanded = unexpandSpacing' Nothing renderedF + + post = if hasPost then line' else mempty in - (if null comment' then mempty else commentPre) - <> pretty comment' <> ( + pretty comment' + <> ( if isSimple (Application f a) && isJust (renderedFUnexpanded) then (group' False $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a <> post) else (group' False $ renderedF <> line <> absorbLast a <> post) - ) <> (if null comment' then mempty else commentPost) + ) + <> (if hasPost && not (null comment') then hardline else mempty) isAbstractionWithAbsorbableTerm :: Expression -> Bool isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True @@ -498,7 +505,7 @@ instance Pretty Expression where = pretty param <> pretty colon <> line <> pretty body pretty (Application f a) - = prettyApp mempty mempty mempty mempty f a + = base $ prettyApp False mempty False f a -- not chainable binary operators: <, >, <=, >=, ==, != pretty (Operation a op@(Ann _ op' _) b) @@ -520,7 +527,7 @@ instance Pretty Expression where -- Force nested operations to start on a new line absorbOperation x@(Operation _ _ _) = group' False $ 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 hardline line mempty mempty f a + absorbOperation (Application f a) = group $ prettyApp False line False f a absorbOperation x = hardspace <> pretty x prettyOperation :: (Maybe Leaf, Expression) -> Doc diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index b775381e..6611984f 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -266,4 +266,44 @@ ] ; } + # Function calls with multiline functions + { + foo = + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs ( + prevAttrs: { + # stuff here + } + ); + # Variant with a selection on the function without parentheses + foo2 = + { + # A lot of values here + }.overrideAttrs ( + prevAttrs: { + # stuff here + } + ); + # Also test within parenthesized function instead of just attribute sets + foo3 = ( + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs stuff ( + prevAttrs: { + # stuff here + } + ) + ); + # Add a comment at a bad place + foo4 = ( + (/* comment */ callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs stuff ( + prevAttrs: { + # stuff here + } + ) + ); + } ] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 7433fc3f..dead3d2f 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -340,4 +340,54 @@ (map (x: ''"'' + x + ''"'')) ]; } + # Function calls with multiline functions + { + foo = + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs + ( + prevAttrs: { + # stuff here + } + ); + # Variant with a selection on the function without parentheses + foo2 = + { + # A lot of values here + } + .overrideAttrs + ( + prevAttrs: { + # stuff here + } + ); + # Also test within parenthesized function instead of just attribute sets + foo3 = + ( + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs + stuff + ( + prevAttrs: { + # stuff here + } + ) + ); + # Add a comment at a bad place + foo4 = + ( + # comment + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs + stuff + ( + prevAttrs: { + # stuff here + } + ) + ); + } ] diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index b34bc226..f7e39d9a 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -166,14 +166,14 @@ let # # TODO(@Ericson2314): Make [ "build" "host" ] always the default / resolve #87909 configurePlatforms ? optionals - ( - stdenv.hostPlatform != stdenv.buildPlatform - || config.configurePlatformsByDefault - ) - [ - "build" - "host" - ], + ( + stdenv.hostPlatform != stdenv.buildPlatform + || config.configurePlatformsByDefault + ) + [ + "build" + "host" + ], # TODO(@Ericson2314): Make unconditional / resolve #33599 # Check phase @@ -494,7 +494,7 @@ let else # we cannot coerce null to a string below assert assertMsg (attrs ? version && attrs.version != null) - "The ‘version’ attribute cannot be null."; + "The ‘version’ attribute cannot be null."; "${attrs.pname}${staticMarker}${hostSuffix}-${attrs.version}" ); }) @@ -725,12 +725,12 @@ let in assert assertMsg envIsExportable "When using structured attributes, `env` must be an attribute set of environment variables."; assert assertMsg (overlappingNames == []) - "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; + "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; mapAttrs ( n: v: assert assertMsg (isString v || isBool v || isInt v || isDerivation v) - "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${builtins.typeOf v}."; + "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${builtins.typeOf v}."; v ) env; From 0a8c246723bdd16207bb03681614892fa1d2f9b5 Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 13 Dec 2023 10:36:26 +0100 Subject: [PATCH 089/125] Revert "List, Attrset: Remove surrounding spaces" This reverts commit 206653bf165c341efe4db81922d159a6d230ea12. --- src/Nixfmt/Pretty.hs | 22 +++---- test/diff/apply/out.nix | 28 ++++---- test/diff/attr_set/out.nix | 28 ++++---- test/diff/idioms_lib_2/out.nix | 8 +-- test/diff/idioms_lib_3/out.nix | 56 ++++++++-------- test/diff/idioms_lib_4/out.nix | 68 +++++++++---------- test/diff/idioms_lib_5/out.nix | 48 +++++++------- test/diff/idioms_nixos_1/out.nix | 32 ++++----- test/diff/idioms_nixos_2/out.nix | 68 +++++++++---------- test/diff/idioms_pkgs_1/out.nix | 4 +- test/diff/idioms_pkgs_2/out.nix | 6 +- test/diff/idioms_pkgs_3/out.nix | 32 ++++----- test/diff/idioms_pkgs_4/out.nix | 32 ++++----- test/diff/idioms_pkgs_5/out.nix | 110 ++++++++++++++++--------------- test/diff/if_else/out.nix | 2 +- test/diff/inherit/out.nix | 4 +- test/diff/inherit_from/out.nix | 2 +- test/diff/key_value/out.nix | 8 +-- test/diff/lambda/out.nix | 20 +++--- test/diff/lists/out.nix | 10 +-- test/diff/monsters_2/out.nix | 2 +- test/diff/monsters_3/out.nix | 2 +- test/diff/monsters_5/out.nix | 6 +- test/diff/operation/out.nix | 26 ++++---- test/diff/pat_bind/out.nix | 16 ++--- test/diff/pattern/out.nix | 26 ++++---- test/diff/with/out.nix | 10 +-- 27 files changed, 342 insertions(+), 334 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index c62eaacb..58b1db41 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -172,7 +172,7 @@ instance Pretty Binder where prettySet :: Bool -> (Maybe Leaf, Leaf, Items Binder, Leaf) -> Doc -- Empty, non-recursive attribute set prettySet _ (Nothing, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) - = pretty paropen <> pretty parclose + = pretty paropen <> hardspace <> pretty parclose -- Singleton sets are allowed to fit onto one line, -- but apart from that always expand. prettySet wide (krec, Ann pre paropen post, binders, parclose) @@ -181,7 +181,7 @@ prettySet wide (krec, Ann pre paropen post, binders, parclose) <> (surroundWith sep $ nest 2 $ pretty post <> prettyItems hardline binders) <> pretty parclose where - sep = if wide && not (null (unItems binders)) then hardline else line' + sep = if wide && not (null (unItems binders)) then hardline else line prettyTermWide :: Term -> Doc prettyTermWide (Set krec paropen items parclose) = prettySet True (krec, paropen, items, parclose) @@ -202,13 +202,13 @@ prettyTerm (Selection term selectors) = pretty term <> line' <> hcat selectors -- Empty list prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing')) - = pretty leading <> pretty paropen <> pretty parclose <> pretty trailing' + = pretty leading <> pretty paropen <> hardspace <> pretty parclose <> pretty trailing' -- General list -- Always expand if len > 1 prettyTerm (List (Ann pre paropen post) items parclose) = base $ pretty (Ann pre paropen Nothing) - <> (surroundWith line' $ nest 2 $ pretty post <> prettyItems hardline items) + <> (surroundWith line $ nest 2 $ pretty post <> prettyItems hardline items) <> pretty parclose prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) @@ -310,13 +310,13 @@ instance Pretty Parameter where -- {}: pretty (SetParameter bopen [] bclose) - = group $ pretty (moveTrailingCommentUp bopen) <> pretty bclose + = group $ pretty (moveTrailingCommentUp bopen) <> hardspace <> pretty bclose -- { stuff }: pretty (SetParameter bopen attrs bclose) = group $ pretty (moveTrailingCommentUp bopen) - <> (surroundWith sep $ nest 2 $ sepBy (sep<>hardspace) $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) + <> (surroundWith sep $ nest 2 $ sepBy sep $ handleTrailingComma $ map moveParamAttrComment $ moveParamsComments $ attrs) <> pretty bclose where -- pretty all ParamAttrs, but mark the trailing comma of the last element specially @@ -330,12 +330,12 @@ instance Pretty Parameter where sep = case attrs of [] -> line - [ParamEllipsis _] -> line' + [ParamEllipsis _] -> line -- Attributes must be without default - [ParamAttr _ Nothing _] -> line' - [ParamAttr _ Nothing _, ParamEllipsis _] -> line' - [ParamAttr _ Nothing _, ParamAttr _ Nothing _] -> line' - [ParamAttr _ Nothing _, ParamAttr _ Nothing _, ParamEllipsis _] -> line' + [ParamAttr _ Nothing _] -> line + [ParamAttr _ Nothing _, ParamEllipsis _] -> line + [ParamAttr _ Nothing _, ParamAttr _ Nothing _] -> line + [ParamAttr _ Nothing _, ParamAttr _ Nothing _, ParamEllipsis _] -> line _ -> hardline pretty (ContextParameter param1 at param2) diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index dead3d2f..5c8aaa29 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -119,14 +119,14 @@ } '' { - name1 = function arg {asdf = 1;}; + name1 = function arg { asdf = 1; }; - name2 = function arg {asdf = 1;} argument; + name2 = function arg { asdf = 1; } argument; - name3 = function arg {asdf = 1;} {qwer = 12345;} argument; + name3 = function arg { asdf = 1; } { qwer = 12345; } argument; } { - name1 = function arg {asdf = 1;}; + name1 = function arg { asdf = 1; }; name2 = function arg @@ -142,12 +142,12 @@ asdf = 1; # multiline } - {qwer = 12345;} + { qwer = 12345; } argument; } { name4 = - function arg {asdf = 1;} + function arg { asdf = 1; } { qwer = 12345; qwer2 = 54321; @@ -156,7 +156,7 @@ } { option1 = - function arg {asdf = 1;} + function arg { asdf = 1; } { qwer = 12345; qwer2 = 54321; @@ -164,7 +164,7 @@ lastArg; option2 = - function arg {asdf = 1;} + function arg { asdf = 1; } { qwer = 12345; qwer2 = 54321; @@ -172,7 +172,7 @@ lastArg; option3 = - function arg {asdf = 1;} + function arg { asdf = 1; } { qwer = 12345; qwer2 = 54321; @@ -182,9 +182,9 @@ # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { outputs = - {utils}: + { utils }: # For each supported platform, - utils.lib.eachDefaultSystem (system: {}); + utils.lib.eachDefaultSystem (system: { }); } { escapeSingleline = libStr.escape [ @@ -210,9 +210,9 @@ 2 3 ] - [] - {} - [] + [ ] + { } + [ ] [ 1 2 diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index af4246c8..77774632 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -1,12 +1,12 @@ [ - {} + { } { # a } - {a = 1;} - {a = 1;} + { a = 1; } + { a = 1; } - {b = 1;} + { b = 1; } { b = 1; # c } @@ -19,7 +19,7 @@ b = 1; # c } - rec {c = 1;} + rec { c = 1; } rec { c = 1; # d } @@ -60,7 +60,7 @@ a = rec { a = { a = rec { - a = {}; + a = { }; }; }; }; @@ -123,13 +123,13 @@ some flags # multiline ] - ++ [short] + ++ [ short ] ++ [ more stuff # multiline ] - ++ (if foo then [bar] else [baz]) - ++ [] + ++ (if foo then [ bar ] else [ baz ]) + ++ [ ] ++ (optionals condition [ more items @@ -142,9 +142,13 @@ ]; } { - systemd.initrdBi = lib.mkIf config.boot.initrd.services.lvm.enable [pkgs.vdo]; - systemd.initrdBin = lib.mkIf config.boot.initrd.services.lvm.enable [pkgs.vdo]; - systemd.initrdBin_ = lib.mkIf config.boot.initrd.services.lvm.enable [pkgs.vdo]; + systemd.initrdBi = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; + systemd.initrdBin = lib.mkIf config.boot.initrd.services.lvm.enable [ + pkgs.vdo + ]; + systemd.initrdBin_ = lib.mkIf config.boot.initrd.services.lvm.enable [ + pkgs.vdo + ]; systemd.initrdBin__ = lib.mkIf config.boot.initrd.services.lvm.enable [ pkgs.vdo ]; diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 3fb18838..301f95bc 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -1,4 +1,4 @@ -{lib}: +{ lib }: rec { @@ -389,7 +389,7 @@ rec { let unexpected = lib.subtractLists valid given; in - lib.throwIfNot (unexpected == []) + lib.throwIfNot (unexpected == [ ]) "${msg}: ${ builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) } unexpected; valid ones: ${ @@ -481,13 +481,13 @@ rec { go = i: if i < base then - [i] + [ i ] else let r = i - ((i / base) * base); q = (i - r) / base; in - [r] ++ go q; + [ r ] ++ go q; in assert (base >= 2); assert (i >= 0); diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index 80088031..b8d30794 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -12,7 +12,7 @@ # # Tests can be found in ./tests/misc.nix # Documentation in the manual, #sec-generators -{lib}: +{ lib }: with (lib).trivial; let libStr = lib.strings; @@ -28,14 +28,14 @@ rec { # The builtin `toString` function has some strange defaults, # suitable for bash scripts but not much else. mkValueStringDefault = - {}: + { }: v: with builtins; let err = t: v: abort ( - "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty {} v}" + "generators.mkValueStringDefault: " + "${t} not supported: ${toPretty { } v}" ); in if isInt v then @@ -81,10 +81,10 @@ rec { # > "f\:oo:bar" mkKeyValueDefault = { - mkValueString ? mkValueStringDefault {}, + mkValueString ? mkValueStringDefault { }, }: sep: k: v: - "${libStr.escape [sep] k}${sep}${mkValueString v}"; + "${libStr.escape [ sep ] k}${sep}${mkValueString v}"; ## -- FILE FORMAT GENERATORS -- @@ -93,16 +93,16 @@ rec { # mkKeyValue is the same as in toINI. toKeyValue = { - mkKeyValue ? mkKeyValueDefault {} "=", + mkKeyValue ? mkKeyValueDefault { } "=", listsAsDuplicateKeys ? false, }: let mkLine = k: v: mkKeyValue k v + "\n"; mkLines = if listsAsDuplicateKeys then - k: v: map (mkLine k) (if lib.isList v then v else [v]) + k: v: map (mkLine k) (if lib.isList v then v else [ v ]) else - k: v: [(mkLine k v)]; + k: v: [ (mkLine k v) ]; in attrs: libStr.concatStrings (lib.concatLists (libAttr.mapAttrsToList mkLines attrs)); @@ -139,7 +139,7 @@ rec { name ), # format a setting line from key and value - mkKeyValue ? mkKeyValueDefault {} "=", + mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys listsAsDuplicateKeys ? false, }: @@ -154,7 +154,7 @@ rec { '' [${mkSectionName sectName}] '' - + toKeyValue {inherit mkKeyValue listsAsDuplicateKeys;} sectValues; + + toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } sectValues; in # map input to ini sections mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; @@ -202,18 +202,18 @@ rec { name ), # format a setting line from key and value - mkKeyValue ? mkKeyValueDefault {} "=", + mkKeyValue ? mkKeyValueDefault { } "=", # allow lists as values for duplicate keys listsAsDuplicateKeys ? false, }: - {globalSection, sections}: + { globalSection, sections }: ( - if globalSection == {} then + if globalSection == { } then "" else - (toKeyValue {inherit mkKeyValue listsAsDuplicateKeys;} globalSection) + "\n" + (toKeyValue { inherit mkKeyValue listsAsDuplicateKeys; } globalSection) + "\n" ) - + (toINI {inherit mkSectionName mkKeyValue listsAsDuplicateKeys;} sections); + + (toINI { inherit mkSectionName mkKeyValue listsAsDuplicateKeys; } sections); # Generate a git-config file from an attrset. # @@ -245,7 +245,7 @@ rec { subsections = tail sections; subsection = concatStringsSep "." subsections; in - if containsQuote || subsections == [] then + if containsQuote || subsections == [ ] then name else ''${section} "${subsection}"''; @@ -254,7 +254,7 @@ rec { mkKeyValue = k: v: let - mkKeyValue = mkKeyValueDefault {} " = " k; + mkKeyValue = mkKeyValueDefault { } " = " k; in concatStringsSep "\n" (map (kv: " " + mkKeyValue kv) (lib.toList v)); @@ -264,22 +264,22 @@ rec { recurse = path: value: if isAttrs value && !lib.isDerivation value then - lib.mapAttrsToList (name: value: recurse ([name] ++ path) value) value + lib.mapAttrsToList (name: value: recurse ([ name ] ++ path) value) value else if length path > 1 then - {${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = value;} + { ${concatStringsSep "." (lib.reverseList (tail path))}.${head path} = value; } else - {${head path} = value;}; + { ${head path} = value; }; in attrs: - lib.foldl lib.recursiveUpdate {} (lib.flatten (recurse [] attrs)); + lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); - toINI_ = toINI {inherit mkKeyValue mkSectionName;}; + toINI_ = toINI { inherit mkKeyValue mkSectionName; }; in toINI_ (gitFlattenAttrs attrs); # Generates JSON from an arbitrary (non-function) value. # For more information see the documentation of the builtin. - toJSON = {}: builtins.toJSON; + toJSON = { }: builtins.toJSON; # YAML has been a strict superset of JSON since 1.2, so we # use toJSON. Before it only had a few differences referring @@ -416,7 +416,7 @@ rec { else if isPath v then toString v else if isList v then - if v == [] then + if v == [ ] then "[ ]" else "[" @@ -432,12 +432,12 @@ rec { fna ); in - if fna == {} then "" else "" + if fna == { } then "" else "" else if isAttrs v then # apply pretty values if allowed if allowPrettyValues && v ? __pretty && v ? val then v.__pretty v.val - else if v == {} then + else if v == { } then "{ }" else if v ? type && v.type == "derivation" then "" @@ -465,7 +465,7 @@ rec { # PLIST handling toPlist = - {}: + { }: v: let isFloat = builtins.isFloat or (x: false); @@ -547,7 +547,7 @@ rec { # Note that integers are translated to Integer and never # the Natural type. toDhall = - {}@args: + { }@args: v: with builtins; let diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index b2390592..5df581a3 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -14,12 +14,12 @@ # e.g. exhaustive cases. Its more a sanity check to make sure nobody defines # systems that overlap with existing ones and won't notice something amiss. # -{lib}: +{ lib }: with lib.lists; with lib.types; with lib.attrsets; with lib.strings; -with (import ./inspect.nix {inherit lib;}).predicates; +with (import ./inspect.nix { inherit lib; }).predicates; let inherit (lib.options) mergeOneOption; @@ -29,7 +29,7 @@ let mapAttrs ( name: value: assert type.check value; - setType type.name ({inherit name;} // value) + setType type.name ({ inherit name; } // value) ); in @@ -46,8 +46,8 @@ rec { types.significantByte = enum (attrValues significantBytes); significantBytes = setTypes types.openSignificantByte { - bigEndian = {}; - littleEndian = {}; + bigEndian = { }; + littleEndian = { }; }; ################################################################################ @@ -453,14 +453,14 @@ rec { types.vendor = enum (attrValues vendors); vendors = setTypes types.openVendor { - apple = {}; - pc = {}; + apple = { }; + pc = { }; # Actually matters, unlocking some MinGW-w64-specific options in GCC. See # bottom of https://sourceforge.net/p/mingw-w64/wiki2/Unicode%20apps/ - w64 = {}; + w64 = { }; - none = {}; - unknown = {}; + none = { }; + unknown = { }; }; ################################################################################ @@ -474,13 +474,13 @@ rec { types.execFormat = enum (attrValues execFormats); execFormats = setTypes types.openExecFormat { - aout = {}; # a.out - elf = {}; - macho = {}; - pe = {}; - wasm = {}; + aout = { }; # a.out + elf = { }; + macho = { }; + pe = { }; + wasm = { }; - unknown = {}; + unknown = { }; }; ################################################################################ @@ -494,8 +494,8 @@ rec { types.kernelFamily = enum (attrValues kernelFamilies); kernelFamilies = setTypes types.openKernelFamily { - bsd = {}; - darwin = {}; + bsd = { }; + darwin = { }; }; ################################################################################ @@ -552,7 +552,7 @@ rec { }; linux = { execFormat = elf; - families = {}; + families = { }; }; netbsd = { execFormat = elf; @@ -562,7 +562,7 @@ rec { }; none = { execFormat = unknown; - families = {}; + families = { }; }; openbsd = { execFormat = elf; @@ -572,31 +572,31 @@ rec { }; solaris = { execFormat = elf; - families = {}; + families = { }; }; wasi = { execFormat = wasm; - families = {}; + families = { }; }; redox = { execFormat = elf; - families = {}; + families = { }; }; windows = { execFormat = pe; - families = {}; + families = { }; }; ghcjs = { execFormat = unknown; - families = {}; + families = { }; }; genode = { execFormat = elf; - families = {}; + families = { }; }; mmixware = { execFormat = unknown; - families = {}; + families = { }; }; } // { @@ -619,8 +619,8 @@ rec { types.abi = enum (attrValues abis); abis = setTypes types.openAbi { - cygnus = {}; - msvc = {}; + cygnus = { }; + msvc = { }; # Note: eabi is specific to ARM and PowerPC. # On PowerPC, this corresponds to PPCEABI. @@ -633,9 +633,9 @@ rec { }; # Other architectures should use ELF in embedded situations. - elf = {}; + elf = { }; - androideabi = {}; + androideabi = { }; android = { assertions = [ { @@ -699,7 +699,7 @@ rec { musleabihf = { float = "hard"; }; - musl = {}; + musl = { }; uclibceabi = { float = "soft"; @@ -707,9 +707,9 @@ rec { uclibceabihf = { float = "hard"; }; - uclibc = {}; + uclibc = { }; - unknown = {}; + unknown = { }; }; ################################################################################ diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 735c6a1f..001fa955 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -30,8 +30,8 @@ let in if envVar != "" then envVar != "0" else config.allowNonSource or true; - allowlist = config.allowlistedLicenses or config.whitelistedLicenses or []; - blocklist = config.blocklistedLicenses or config.blacklistedLicenses or []; + allowlist = config.allowlistedLicenses or config.whitelistedLicenses or [ ]; + blocklist = config.blocklistedLicenses or config.blacklistedLicenses or [ ]; areLicenseListsValid = if lib.mutuallyExclusive allowlist blocklist then @@ -76,7 +76,7 @@ let hasUnsupportedPlatform = pkg: !(lib.meta.availableOn hostPlatform pkg); - isMarkedInsecure = attrs: (attrs.meta.knownVulnerabilities or []) != []; + isMarkedInsecure = attrs: (attrs.meta.knownVulnerabilities or [ ]) != [ ]; # Alow granular checks to allow only some unfree packages # Example: @@ -94,7 +94,7 @@ let attrs: hasUnfreeLicense attrs && !allowUnfree && !allowUnfreePredicate attrs; allowInsecureDefaultPredicate = - x: builtins.elem (getName x) (config.permittedInsecurePackages or []); + x: builtins.elem (getName x) (config.permittedInsecurePackages or [ ]); allowInsecurePredicate = x: (config.allowInsecurePredicate or allowInsecureDefaultPredicate) x; @@ -239,8 +239,8 @@ let remediateOutputsToInstall = attrs: let - expectedOutputs = attrs.meta.outputsToInstall or []; - actualOutputs = attrs.outputs or ["out"]; + expectedOutputs = attrs.meta.outputsToInstall or [ ]; + actualOutputs = attrs.outputs or [ "out" ]; missingOutputs = builtins.filter (output: !builtins.elem output actualOutputs) expectedOutputs; @@ -256,7 +256,7 @@ let ''; handleEvalIssue = - {meta, attrs}: + { meta, attrs }: { reason, errormsg ? "", @@ -278,7 +278,7 @@ let handler msg; handleEvalWarning = - {meta, attrs}: + { meta, attrs }: { reason, errormsg ? "", @@ -302,7 +302,7 @@ let typeCheck = type: value: let - merged = lib.mergeDefinitions [] type [ + merged = lib.mergeDefinitions [ ] type [ { file = lib.unknownModule; inherit value; @@ -344,7 +344,7 @@ let name = "test"; check = x: - x == {} + x == { } || # Accept {} for tests that are unsupported (isDerivation x && x ? meta.timeout); @@ -383,7 +383,7 @@ let else '' key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got - ${lib.generators.toPretty {indent = " ";} v}'' + ${lib.generators.toPretty { indent = " "; } v}'' else '' key 'meta.${k}' is unrecognized; expected one of: @@ -397,8 +397,8 @@ let checkOutputsToInstall = attrs: let - expectedOutputs = attrs.meta.outputsToInstall or []; - actualOutputs = attrs.outputs or ["out"]; + expectedOutputs = attrs.meta.outputsToInstall or [ ]; + actualOutputs = attrs.outputs or [ "out" ]; missingOutputs = builtins.filter (output: !builtins.elem output actualOutputs) expectedOutputs; @@ -418,9 +418,9 @@ let # Check meta attribute types first, to make sure it is always called even when there are other issues # Note that this is not a full type check and functions below still need to by careful about their inputs! let - res = checkMeta (attrs.meta or {}); + res = checkMeta (attrs.meta or { }); in - if res != [] then + if res != [ ] then { valid = "no"; reason = "unknown-meta"; @@ -488,8 +488,8 @@ let errormsg = '' is not available on the requested hostPlatform: hostPlatform.config = "${hostPlatform.config}" - package.meta.platforms = ${toPretty (attrs.meta.platforms or [])} - package.meta.badPlatforms = ${toPretty (attrs.meta.badPlatforms or [])} + package.meta.platforms = ${toPretty (attrs.meta.platforms or [ ])} + package.meta.badPlatforms = ${toPretty (attrs.meta.badPlatforms or [ ])} ''; } else if !(hasAllowedInsecure attrs) then @@ -509,7 +509,7 @@ let } # ----- else - {valid = "yes";} + { valid = "yes"; } ); # The meta attribute is passed in the resulting attribute set, @@ -524,10 +524,10 @@ let validity, attrs, pos ? null, - references ? [], + references ? [ ], }: let - outputs = attrs.outputs or ["out"]; + outputs = attrs.outputs or [ "out" ]; in { # `name` derivation attribute includes cross-compilation cruft, @@ -560,7 +560,7 @@ let ] ++ lib.optional (hasOutput "man") "man"; } - // attrs.meta or {} + // attrs.meta or { } # Fill `meta.position` to identify the source location of the package. // lib.optionalAttrs (pos != null) { position = pos.file + ":" + toString pos.line; @@ -585,7 +585,7 @@ let }; assertValidity = - {meta, attrs}: + { meta, attrs }: let validity = checkValidity attrs; in @@ -595,10 +595,10 @@ let # or, alternatively, just output a warning message. handled = { - no = handleEvalIssue {inherit meta attrs;} { + no = handleEvalIssue { inherit meta attrs; } { inherit (validity) reason errormsg; }; - warn = handleEvalWarning {inherit meta attrs;} { + warn = handleEvalWarning { inherit meta attrs; } { inherit (validity) reason errormsg; }; yes = true; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 88e327ae..2d26acba 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -25,7 +25,7 @@ in options = { boot.kernel.features = mkOption { - default = {}; + default = { }; example = literalExpression "{ debug = true; }"; internal = true; description = '' @@ -49,7 +49,7 @@ in kernel = super.kernel.override ( originalArgs: { inherit randstructSeed; - kernelPatches = (originalArgs.kernelPatches or []) ++ kernelPatches; + kernelPatches = (originalArgs.kernelPatches or [ ]) ++ kernelPatches; features = lib.recursiveUpdate super.kernel.features features; } ); @@ -75,7 +75,7 @@ in boot.kernelPatches = mkOption { type = types.listOf types.attrs; - default = []; + default = [ ]; example = literalExpression "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; description = "A list of additional patches to apply to the kernel."; }; @@ -101,7 +101,7 @@ in description = "string, with spaces inside double quotes"; } ); - default = []; + default = [ ]; description = "Parameters added to the kernel command line."; }; @@ -129,14 +129,14 @@ in boot.extraModulePackages = mkOption { type = types.listOf types.package; - default = []; + default = [ ]; example = literalExpression "[ config.boot.kernelPackages.nvidia_x11 ]"; description = "A list of additional packages supplying kernel modules."; }; boot.kernelModules = mkOption { type = types.listOf types.str; - default = []; + default = [ ]; description = '' The set of kernel modules to be loaded in the second stage of the boot process. Note that modules that are needed to @@ -148,7 +148,7 @@ in boot.initrd.availableKernelModules = mkOption { type = types.listOf types.str; - default = []; + default = [ ]; example = [ "sata_nv" "ext3" @@ -172,7 +172,7 @@ in boot.initrd.kernelModules = mkOption { type = types.listOf types.str; - default = []; + default = [ ]; description = "List of modules that are always loaded by the initrd."; }; @@ -189,7 +189,7 @@ in system.modulesTree = mkOption { type = types.listOf types.path; internal = true; - default = []; + default = [ ]; description = '' Tree of kernel modules. This includes the kernel, plus modules built outside of the kernel. Combine these into a single tree of @@ -200,7 +200,7 @@ in }; system.requiredKernelConfig = mkOption { - default = []; + default = [ ]; example = literalExpression '' with config.lib.kernelConfig; [ (isYes "MODULES") @@ -289,12 +289,12 @@ in inherit kernel; }; - system.modulesTree = [kernel] ++ config.boot.extraModulePackages; + system.modulesTree = [ kernel ] ++ config.boot.extraModulePackages; # Implement consoleLogLevel both in early boot and using sysctl # (so you don't need to reboot to have changes take effect). boot.kernelParams = - ["loglevel=${toString config.boot.consoleLogLevel}"] + [ "loglevel=${toString config.boot.consoleLogLevel}" ] ++ optionals config.boot.vesa [ "vga=0x317" "nomodeset" @@ -308,7 +308,7 @@ in ]; # The Linux kernel >= 2.6.27 provides firmware. - hardware.firmware = [kernel]; + hardware.firmware = [ kernel ]; # Create /etc/modules-load.d/nixos.conf, which is read by # systemd-modules-load.service to load required kernel modules. @@ -317,8 +317,8 @@ in }; systemd.services.systemd-modules-load = { - wantedBy = ["multi-user.target"]; - restartTriggers = [kernelModulesConf]; + wantedBy = [ "multi-user.target" ]; + restartTriggers = [ kernelModulesConf ]; serviceConfig = { # Ignore failed module loads. Typically some of the # modules in ‘boot.kernelModules’ are "nice to have but @@ -376,7 +376,7 @@ in # nixpkgs kernels are assumed to have all required features assertions = if config.boot.kernelPackages.kernel ? features then - [] + [ ] else let cfg = config.boot.kernelPackages.kernel.config; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index e72a47ae..79aeb15c 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -11,13 +11,13 @@ let cfg = config.services.nextcloud; fpm = config.services.phpfpm.pools.nextcloud; - jsonFormat = pkgs.formats.json {}; + jsonFormat = pkgs.formats.json { }; inherit (cfg) datadir; phpPackage = cfg.phpPackage.buildEnv { extensions = - {enabled, all}: + { enabled, all }: ( with all; # disable default openssl extension @@ -27,9 +27,9 @@ let # TODO: remove when https://github.com/nextcloud/server/issues/32003 is fixed. ++ ( if cfg.enableBrokenCiphersForSSE then - [cfg.phpPackage.extensions.openssl-legacy] + [ cfg.phpPackage.extensions.openssl-legacy ] else - [cfg.phpPackage.extensions.openssl] + [ cfg.phpPackage.extensions.openssl ] ) ++ optional cfg.enableImagemagick imagick # Optionally enabled depending on caching settings @@ -42,14 +42,16 @@ let }; toKeyValue = generators.toKeyValue { - mkKeyValue = generators.mkKeyValueDefault {} " = "; + mkKeyValue = generators.mkKeyValueDefault { } " = "; }; - phpOptions = { - upload_max_filesize = cfg.maxUploadSize; - post_max_size = cfg.maxUploadSize; - memory_limit = cfg.maxUploadSize; - } // cfg.phpOptions // optionalAttrs cfg.caching.apcu {"apc.enable_cli" = "1";}; + phpOptions = + { + upload_max_filesize = cfg.maxUploadSize; + post_max_size = cfg.maxUploadSize; + memory_limit = cfg.maxUploadSize; + } + // cfg.phpOptions // optionalAttrs cfg.caching.apcu { "apc.enable_cli" = "1"; }; occ = pkgs.writeScriptBin "nextcloud-occ" '' #! ${pkgs.runtimeShell} @@ -180,7 +182,7 @@ in }; extraApps = mkOption { type = types.attrsOf types.package; - default = {}; + default = { }; description = lib.mdDoc '' Extra apps to install. Should be an attrSet of appid to packages generated by fetchNextcloudApp. The appid must be identical to the "id" value in the apps appinfo/info.xml. @@ -297,7 +299,7 @@ in phpExtraExtensions = mkOption { type = with types; functionTo (listOf package); - default = all: []; + default = all: [ ]; defaultText = literalExpression "all: []"; description = lib.mdDoc '' Additional PHP extensions to use for nextcloud. @@ -447,7 +449,7 @@ in extraTrustedDomains = mkOption { type = types.listOf types.str; - default = []; + default = [ ]; description = lib.mdDoc '' Trusted domains, from which the nextcloud installation will be accessible. You don't need to add @@ -457,7 +459,7 @@ in trustedProxies = mkOption { type = types.listOf types.str; - default = []; + default = [ ]; description = lib.mdDoc '' Trusted proxies, to provide if the nextcloud installation is being proxied to secure against e.g. spoofing. @@ -699,7 +701,7 @@ in extraOptions = mkOption { type = jsonFormat.type; - default = {}; + default = { }; description = lib.mdDoc '' Extra options which should be appended to nextcloud's config.php file. ''; @@ -830,20 +832,20 @@ in { systemd.timers.nextcloud-cron = { - wantedBy = ["timers.target"]; - after = ["nextcloud-setup.service"]; + wantedBy = [ "timers.target" ]; + after = [ "nextcloud-setup.service" ]; timerConfig.OnBootSec = "5m"; timerConfig.OnUnitActiveSec = "5m"; timerConfig.Unit = "nextcloud-cron.service"; }; - systemd.tmpfiles.rules = ["d ${cfg.home} 0750 nextcloud nextcloud"]; + systemd.tmpfiles.rules = [ "d ${cfg.home} 0750 nextcloud nextcloud" ]; systemd.services = { # When upgrading the Nextcloud package, Nextcloud can report errors such as # "The files of the app [all apps in /var/lib/nextcloud/apps] were not replaced correctly" # Restarting phpfpm on Nextcloud package update fixes these issues (but this is a workaround). - phpfpm-nextcloud.restartTriggers = [cfg.package]; + phpfpm-nextcloud.restartTriggers = [ cfg.package ]; nextcloud-setup = let @@ -876,7 +878,7 @@ in ] ''; - showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != {}; + showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; renderedAppStoreSetting = let x = cfg.appstoreEnable; @@ -914,7 +916,7 @@ in $CONFIG = [ 'apps_paths' => [ ${ - optionalString (cfg.extraApps != {}) + optionalString (cfg.extraApps != { }) "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," } [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], @@ -950,7 +952,7 @@ in } 'dbtype' => '${c.dbtype}', 'trusted_domains' => ${ - writePhpArray ([cfg.hostName] ++ c.extraTrustedDomains) + writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) }, 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, ${ @@ -978,7 +980,7 @@ in ''; occInstallCmd = let - mkExport = {arg, value}: "export ${arg}=${value}"; + mkExport = { arg, value }: "export ${arg}=${value}"; dbpass = { arg = "DBPASS"; value = @@ -1019,13 +1021,13 @@ in ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ ${toString i} --value="${toString v}" '') - ([cfg.hostName] ++ cfg.config.extraTrustedDomains) + ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) ); in { - wantedBy = ["multi-user.target"]; - before = ["phpfpm-nextcloud.service"]; - path = [occ]; + wantedBy = [ "multi-user.target" ]; + before = [ "phpfpm-nextcloud.service" ]; + path = [ occ ]; script = '' ${optionalString (c.dbpassFile != null) '' if [ ! -r "${c.dbpassFile}" ]; then @@ -1052,7 +1054,7 @@ in ln -sfT \ ${ pkgs.linkFarm "nix-apps" ( - mapAttrsToList (name: path: {inherit name path;}) cfg.extraApps + mapAttrsToList (name: path: { inherit name path; }) cfg.extraApps ) } \ ${cfg.home}/nix-apps @@ -1078,7 +1080,7 @@ in ${occ}/bin/nextcloud-occ config:system:delete trusted_domains - ${optionalString (cfg.extraAppsEnable && cfg.extraApps != {}) '' + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' # Try to enable apps ${occ}/bin/nextcloud-occ app:enable ${ concatStringsSep " " (attrNames cfg.extraApps) @@ -1096,14 +1098,14 @@ in "false"; }; nextcloud-cron = { - after = ["nextcloud-setup.service"]; + after = [ "nextcloud-setup.service" ]; environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; serviceConfig.Type = "oneshot"; serviceConfig.User = "nextcloud"; serviceConfig.ExecStart = "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; }; nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { - after = ["nextcloud-setup.service"]; + after = [ "nextcloud-setup.service" ]; serviceConfig.Type = "oneshot"; serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; serviceConfig.User = "nextcloud"; @@ -1140,12 +1142,12 @@ in config.services.nginx.user ]; - environment.systemPackages = [occ]; + environment.systemPackages = [ occ ]; services.mysql = lib.mkIf cfg.database.createLocally { enable = true; package = lib.mkDefault pkgs.mariadb; - ensureDatabases = [cfg.config.dbname]; + ensureDatabases = [ cfg.config.dbname ]; ensureUsers = [ { name = cfg.config.dbuser; diff --git a/test/diff/idioms_pkgs_1/out.nix b/test/diff/idioms_pkgs_1/out.nix index 2e418f66..afdbed26 100644 --- a/test/diff/idioms_pkgs_1/out.nix +++ b/test/diff/idioms_pkgs_1/out.nix @@ -8,9 +8,9 @@ stdenv.mkDerivation rec { pname = "test"; version = "0.0"; - src = fetchFrom {url = "example/${version}";}; + src = fetchFrom { url = "example/${version}"; }; meta = with lib; { - maintainers = with maintainers; [someone]; + maintainers = with maintainers; [ someone ]; description = "something"; }; } diff --git a/test/diff/idioms_pkgs_2/out.nix b/test/diff/idioms_pkgs_2/out.nix index f78b9902..84f50d54 100644 --- a/test/diff/idioms_pkgs_2/out.nix +++ b/test/diff/idioms_pkgs_2/out.nix @@ -20,12 +20,12 @@ stdenv.mkDerivation rec { doCheck = true; passthru.tests = { - version = testVersion {package = hello;}; + version = testVersion { package = hello; }; invariant-under-noXlibs = testEqualDerivation "hello must not be rebuilt when environment.noXlibs is set." hello - (nixos {environment.noXlibs = true;}).pkgs.hello; + (nixos { environment.noXlibs = true; }).pkgs.hello; }; meta = with lib; { @@ -37,7 +37,7 @@ stdenv.mkDerivation rec { homepage = "https://www.gnu.org/software/hello/manual/"; changelog = "https://git.savannah.gnu.org/cgit/hello.git/plain/NEWS?h=v${version}"; license = licenses.gpl3Plus; - maintainers = [maintainers.eelco]; + maintainers = [ maintainers.eelco ]; platforms = platforms.all; }; } diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index f7b6e6f3..fea4751f 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -9,14 +9,14 @@ branding ? null, src, unpackPhase ? null, - extraPatches ? [], + extraPatches ? [ ], extraPostPatch ? "", - extraNativeBuildInputs ? [], - extraConfigureFlags ? [], - extraBuildInputs ? [], - extraMakeFlags ? [], - extraPassthru ? {}, - tests ? [], + extraNativeBuildInputs ? [ ], + extraConfigureFlags ? [ ], + extraBuildInputs ? [ ], + extraMakeFlags ? [ ], + extraPassthru ? { }, + tests ? [ ], }: { @@ -188,7 +188,7 @@ let # Compile the wasm32 sysroot to build the RLBox Sandbox # https://hacks.mozilla.org/2021/12/webassembly-and-back-again-fine-grained-sandboxing-in-firefox-95/ # We only link c++ libs here, our compiler wrapper can find wasi libc and crt itself. - wasiSysRoot = runCommand "wasi-sysroot" {} '' + wasiSysRoot = runCommand "wasi-sysroot" { } '' mkdir -p $out/lib/wasm32-wasi for lib in ${pkgsCross.wasi32.llvmPackages.libcxx}/lib/* ${pkgsCross.wasi32.llvmPackages.libcxxabi}/lib/*; do ln -s $lib $out/lib/wasm32-wasi @@ -196,7 +196,7 @@ let ''; distributionIni = pkgs.writeText "distribution.ini" ( - lib.generators.toINI {} { + lib.generators.toINI { } { # Some light branding indicating this build uses our distro preferences Global = { id = "nixos"; @@ -237,7 +237,7 @@ buildStdenv.mkDerivation ({ inherit src unpackPhase meta; - outputs = ["out"] ++ lib.optionals crashreporterSupport ["symbols"]; + outputs = [ "out" ] ++ lib.optionals crashreporterSupport [ "symbols" ]; # Add another configure-build-profiling run before the final configure phase if we build with pgo preConfigurePhases = lib.optionals pgoSupport [ @@ -305,7 +305,7 @@ buildStdenv.mkDerivation ({ dump_syms patchelf ] - ++ lib.optionals pgoSupport [xvfb-run] + ++ lib.optionals pgoSupport [ xvfb-run ] ++ extraNativeBuildInputs; setOutputFlags = false; # `./mach configure` doesn't understand `--*dir=` flags. @@ -380,7 +380,7 @@ buildStdenv.mkDerivation ({ ''; # firefox has a different definition of configurePlatforms from nixpkgs, see configureFlags - configurePlatforms = []; + configurePlatforms = [ ]; configureFlags = [ @@ -485,7 +485,7 @@ buildStdenv.mkDerivation ({ zip zlib ] - ++ [(if (lib.versionAtLeast version "103") then nss_latest else nss_esr)] + ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] ++ lib.optional alsaSupport alsa-lib ++ lib.optional jackSupport libjack2 ++ lib.optional pulseaudioSupport libpulseaudio # only headers are needed @@ -562,7 +562,7 @@ buildStdenv.mkDerivation ({ ''; postFixup = lib.optionalString crashreporterSupport '' - patchelf --add-rpath "${lib.makeLibraryPath [curl]}" $out/lib/${binaryName}/crashreporter + patchelf --add-rpath "${lib.makeLibraryPath [ curl ]}" $out/lib/${binaryName}/crashreporter ''; doInstallCheck = true; @@ -587,7 +587,7 @@ buildStdenv.mkDerivation ({ inherit wasiSysRoot; } // extraPassthru; - hardeningDisable = ["format"]; # -Werror=format-security + hardeningDisable = [ "format" ]; # -Werror=format-security # the build system verifies checksums of the bundled rust sources # ./third_party/rust is be patched by our libtool fixup code in stdenv @@ -602,5 +602,5 @@ buildStdenv.mkDerivation ({ # on aarch64 this is also required dontUpdateAutotoolsGnuConfigScripts = true; - requiredSystemFeatures = ["big-parallel"]; + requiredSystemFeatures = [ "big-parallel" ]; }) diff --git a/test/diff/idioms_pkgs_4/out.nix b/test/diff/idioms_pkgs_4/out.nix index 470b38bf..bc384da7 100644 --- a/test/diff/idioms_pkgs_4/out.nix +++ b/test/diff/idioms_pkgs_4/out.nix @@ -4,7 +4,7 @@ crossSystem, config, overlays, - crossOverlays ? [], + crossOverlays ? [ ], }: assert crossSystem == localSystem; @@ -19,9 +19,9 @@ let "/bin/bash"; path = - (lib.optionals (system == "i686-solaris") ["/usr/gnu"]) - ++ (lib.optionals (system == "i686-netbsd") ["/usr/pkg"]) - ++ (lib.optionals (system == "x86_64-solaris") ["/opt/local/gnu"]) + (lib.optionals (system == "i686-solaris") [ "/usr/gnu" ]) + ++ (lib.optionals (system == "i686-netbsd") [ "/usr/pkg" ]) + ++ (lib.optionals (system == "x86_64-solaris") [ "/opt/local/gnu" ]) ++ [ "/" "/usr" @@ -84,11 +84,11 @@ let ] ++ ( if system == "i686-cygwin" then - [../cygwin/rebase-i686.sh] + [ ../cygwin/rebase-i686.sh ] else if system == "x86_64-cygwin" then - [../cygwin/rebase-x86_64.sh] + [ ../cygwin/rebase-x86_64.sh ] else - [] + [ ] ); # A function that builds a "native" stdenv (one that uses tools in @@ -97,9 +97,9 @@ let { cc, fetchurl, - extraPath ? [], - overrides ? (self: super: {}), - extraNativeBuildInputs ? [], + extraPath ? [ ], + overrides ? (self: super: { }), + extraNativeBuildInputs ? [ ], }: import ../generic { @@ -131,7 +131,7 @@ let else if system == "x86_64-cygwin" then extraNativeBuildInputsCygwin else - [] + [ ] ); initialPath = extraPath ++ path; @@ -150,7 +150,7 @@ in [ ( - {}: + { }: rec { __raw = true; @@ -195,7 +195,7 @@ in # First build a stdenv based only on tools outside the store. (prevStage: { inherit config overlays; - stdenv = makeStdenv {inherit (prevStage) cc fetchurl;} // { + stdenv = makeStdenv { inherit (prevStage) cc fetchurl; } // { inherit (prevStage) fetchurl; }; }) @@ -206,10 +206,10 @@ in inherit config overlays; stdenv = makeStdenv { inherit (prevStage.stdenv) cc fetchurl; - extraPath = [prevStage.xz]; - overrides = self: super: {inherit (prevStage) xz;}; + extraPath = [ prevStage.xz ]; + overrides = self: super: { inherit (prevStage) xz; }; extraNativeBuildInputs = - if localSystem.isLinux then [prevStage.patchelf] else []; + if localSystem.isLinux then [ prevStage.patchelf ] else [ ]; }; }) ] diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index f7e39d9a..ef74088b 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -1,4 +1,4 @@ -{lib, config}: +{ lib, config }: stdenv: @@ -56,7 +56,7 @@ let # separate lines, because Nix would only show the last line of the comment. # An infinite recursion here can be caused by having the attribute names of expression `e` in `.overrideAttrs(finalAttrs: previousAttrs: e)` depend on `finalAttrs`. Only the attribute values of `e` can depend on `finalAttrs`. - args = rattrs (args // {inherit finalPackage overrideAttrs;}); + args = rattrs (args // { inherit finalPackage overrideAttrs; }); # ^^^^ overrideAttrs = @@ -137,30 +137,30 @@ let # TODO(@Ericson2314): Stop using legacy dep attribute names # host offset -> target offset - depsBuildBuild ? [], # -1 -> -1 - depsBuildBuildPropagated ? [], # -1 -> -1 - nativeBuildInputs ? [], # -1 -> 0 N.B. Legacy name - propagatedNativeBuildInputs ? [], # -1 -> 0 N.B. Legacy name - depsBuildTarget ? [], # -1 -> 1 - depsBuildTargetPropagated ? [], # -1 -> 1 - - depsHostHost ? [], # 0 -> 0 - depsHostHostPropagated ? [], # 0 -> 0 - buildInputs ? [], # 0 -> 1 N.B. Legacy name - propagatedBuildInputs ? [], # 0 -> 1 N.B. Legacy name - - depsTargetTarget ? [], # 1 -> 1 - depsTargetTargetPropagated ? [], # 1 -> 1 - - checkInputs ? [], - installCheckInputs ? [], - nativeCheckInputs ? [], - nativeInstallCheckInputs ? [], + depsBuildBuild ? [ ], # -1 -> -1 + depsBuildBuildPropagated ? [ ], # -1 -> -1 + nativeBuildInputs ? [ ], # -1 -> 0 N.B. Legacy name + propagatedNativeBuildInputs ? [ ], # -1 -> 0 N.B. Legacy name + depsBuildTarget ? [ ], # -1 -> 1 + depsBuildTargetPropagated ? [ ], # -1 -> 1 + + depsHostHost ? [ ], # 0 -> 0 + depsHostHostPropagated ? [ ], # 0 -> 0 + buildInputs ? [ ], # 0 -> 1 N.B. Legacy name + propagatedBuildInputs ? [ ], # 0 -> 1 N.B. Legacy name + + depsTargetTarget ? [ ], # 1 -> 1 + depsTargetTargetPropagated ? [ ], # 1 -> 1 + + checkInputs ? [ ], + installCheckInputs ? [ ], + nativeCheckInputs ? [ ], + nativeInstallCheckInputs ? [ ], # Configure Phase - configureFlags ? [], - cmakeFlags ? [], - mesonFlags ? [], + configureFlags ? [ ], + cmakeFlags ? [ ], + mesonFlags ? [ ], # Target is not included by default because most programs don't care. # Including it then would cause needless mass rebuilds. # @@ -191,8 +191,8 @@ let enableParallelBuilding ? config.enableParallelBuildingByDefault, - meta ? {}, - passthru ? {}, + meta ? { }, + passthru ? { }, pos ? # position used in error messages and for meta.position ( if attrs.meta.description or null != null then @@ -203,17 +203,17 @@ let builtins.unsafeGetAttrPos "name" attrs ), separateDebugInfo ? false, - outputs ? ["out"], + outputs ? [ "out" ], __darwinAllowLocalNetworking ? false, - __impureHostDeps ? [], - __propagatedImpureHostDeps ? [], + __impureHostDeps ? [ ], + __propagatedImpureHostDeps ? [ ], sandboxProfile ? "", propagatedSandboxProfile ? "", - hardeningEnable ? [], - hardeningDisable ? [], + hardeningEnable ? [ ], + hardeningDisable ? [ ], - patches ? [], + patches ? [ ], __contentAddressed ? (!attrs ? outputHash) # Fixed-output drvs can't be content addressed too @@ -223,7 +223,7 @@ let # but for anything complex, be prepared to debug if enabling. __structuredAttrs ? config.structuredAttrsByDefault or false, - env ? {}, + env ? { }, ... }@attrs: @@ -277,7 +277,7 @@ let any (x: x == "fortify") hardeningDisable # disabling fortify implies fortify3 should also be disabled then - unique (hardeningDisable ++ ["fortify3"]) + unique (hardeningDisable ++ [ "fortify3" ]) else hardeningDisable; supportedHardeningFlags = [ @@ -308,7 +308,7 @@ let remove "pie" supportedHardeningFlags; enabledHardeningOptions = if builtins.elem "all" hardeningDisable' then - [] + [ ] else subtractLists hardeningDisable' (defaultHardeningFlags ++ hardeningEnable); # hardeningDisable additionally supports "all". @@ -316,7 +316,7 @@ let hardeningEnable ++ remove "all" hardeningDisable ); - checkDependencyList = checkDependencyList' []; + checkDependencyList = checkDependencyList' [ ]; checkDependencyList' = positions: name: deps: flip imap1 deps ( @@ -326,17 +326,17 @@ let then dep else if isList dep then - checkDependencyList' ([index] ++ positions) name dep + checkDependencyList' ([ index ] ++ positions) name dep else throw "Dependency is not of a valid type: ${ - concatMapStrings (ix: "element ${toString ix} of ") ([index] ++ positions) + concatMapStrings (ix: "element ${toString ix} of ") ([ index ] ++ positions) }${name} for ${attrs.name or attrs.pname}" ); in if builtins.length erroneousHardeningFlags != 0 then abort ( "mkDerivation was called with unsupported hardening flags: " - + lib.generators.toPretty {} { + + lib.generators.toPretty { } { inherit erroneousHardeningFlags hardeningDisable @@ -422,7 +422,7 @@ let ]; computedSandboxProfile = - concatMap (input: input.__propagatedSandboxProfile or []) + concatMap (input: input.__propagatedSandboxProfile or [ ]) ( stdenv.extraNativeBuildInputs ++ stdenv.extraBuildInputs @@ -430,11 +430,11 @@ let ); computedPropagatedSandboxProfile = - concatMap (input: input.__propagatedSandboxProfile or []) + concatMap (input: input.__propagatedSandboxProfile or [ ]) (concatLists propagatedDependencies); computedImpureHostDeps = unique ( - concatMap (input: input.__propagatedImpureHostDeps or []) ( + concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( stdenv.extraNativeBuildInputs ++ stdenv.extraBuildInputs ++ concatLists dependencies @@ -442,7 +442,7 @@ let ); computedPropagatedImpureHostDeps = unique ( - concatMap (input: input.__propagatedImpureHostDeps or []) ( + concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( concatLists propagatedDependencies ) ); @@ -498,7 +498,7 @@ let "${attrs.pname}${staticMarker}${hostSuffix}-${attrs.version}" ); }) - // optionalAttrs __structuredAttrs {env = checkedEnv;} + // optionalAttrs __structuredAttrs { env = checkedEnv; } // { builder = attrs.realBuilder or stdenv.shell; args = @@ -634,12 +634,14 @@ let } // optionalAttrs - (hardeningDisable != [] || hardeningEnable != [] || stdenv.hostPlatform.isMusl) - {NIX_HARDENING_ENABLE = enabledHardeningOptions;} + ( + hardeningDisable != [ ] || hardeningEnable != [ ] || stdenv.hostPlatform.isMusl + ) + { NIX_HARDENING_ENABLE = enabledHardeningOptions; } // optionalAttrs (stdenv.hostPlatform.isx86_64 && stdenv.hostPlatform ? gcc.arch) { - requiredSystemFeatures = attrs.requiredSystemFeatures or [] ++ [ + requiredSystemFeatures = attrs.requiredSystemFeatures or [ ] ++ [ "gccarch-${stdenv.hostPlatform.gcc.arch}" ]; } @@ -649,7 +651,7 @@ let __sandboxProfile = let profiles = - [stdenv.extraSandboxProfile] + [ stdenv.extraSandboxProfile ] ++ computedSandboxProfile ++ computedPropagatedSandboxProfile ++ [ @@ -660,7 +662,7 @@ let in final; __propagatedSandboxProfile = unique ( - computedPropagatedSandboxProfile ++ [propagatedSandboxProfile] + computedPropagatedSandboxProfile ++ [ propagatedSandboxProfile ] ); __impureHostDeps = computedImpureHostDeps @@ -717,14 +719,14 @@ let references ; }; - validity = checkMeta.assertValidity {inherit meta attrs;}; + validity = checkMeta.assertValidity { inherit meta attrs; }; checkedEnv = let overlappingNames = attrNames (builtins.intersectAttrs env derivationArg); in assert assertMsg envIsExportable "When using structured attributes, `env` must be an attribute set of environment variables."; - assert assertMsg (overlappingNames == []) + assert assertMsg (overlappingNames == [ ]) "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; mapAttrs ( @@ -750,7 +752,7 @@ let # Add a name in case the original drv didn't have one name = derivationArg.name or "inputDerivation"; # This always only has one output - outputs = ["out"]; + outputs = [ "out" ]; # Propagate the original builder and arguments, since we override # them and they might contain references to build inputs @@ -779,8 +781,8 @@ let # anymore. allowedReferences = null; allowedRequisites = null; - disallowedReferences = []; - disallowedRequisites = []; + disallowedReferences = [ ]; + disallowedRequisites = [ ]; } ); diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index b1ac3eb5..a30e7e2e 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -1,5 +1,5 @@ [ - (if true then {version = "1.2.3";} else {version = "3.2.1";}) + (if true then { version = "1.2.3"; } else { version = "3.2.1"; }) ( if true then '' diff --git a/test/diff/inherit/out.nix b/test/diff/inherit/out.nix index a823c878..93a31869 100644 --- a/test/diff/inherit/out.nix +++ b/test/diff/inherit/out.nix @@ -18,8 +18,8 @@ j ; } - {inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa;} - {inherit b d;} + { inherit aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa; } + { inherit b d; } { inherit b diff --git a/test/diff/inherit_from/out.nix b/test/diff/inherit_from/out.nix index 4dbd6154..126b8f8b 100644 --- a/test/diff/inherit_from/out.nix +++ b/test/diff/inherit_from/out.nix @@ -40,7 +40,7 @@ k ; } - {inherit (c) f h;} + { inherit (c) f h; } { inherit (c) f diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 571c14ac..f31a78da 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -41,7 +41,7 @@ rec { 1 # d ; }; - j = a: {b = 1;}; + j = a: { b = 1; }; k = a: { b = 1; c = 2; @@ -55,8 +55,8 @@ rec { b = 1; c = 2; }; - n = pkgs: {}; - o = {pkgs, ...}: {}; + n = pkgs: { }; + o = { pkgs, ... }: { }; a # b @@ -66,5 +66,5 @@ rec { # d ; - p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa {} a; + p = aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa { } a; } diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index e383114a..42d4b05b 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -3,7 +3,7 @@ let in [ ( - {lib}: + { lib }: let foo = 1; in @@ -13,7 +13,7 @@ in /* Collection of functions useful for debugging Some comment */ - {lib}: + { lib }: let foo = 1; in @@ -24,13 +24,13 @@ in d ) ( - {}: + { }: b: # c d ) ( a: - {}: # c + { }: # c d ) (a: d) @@ -52,27 +52,27 @@ in (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa) ( { - pkgs ? import ./.. {}, + pkgs ? import ./.. { }, locationsXml, }: null ) ( a: b: c: - {}: + { }: a: b: c: a ) ( - {pkgs, ...}: + { pkgs, ... }: { # Stuff } ) ( - {pkgs, ...}: + { pkgs, ... }: let in pkgs @@ -80,7 +80,7 @@ in ( a: - {b, ...}: + { b, ... }: c: { # Stuff } @@ -88,7 +88,7 @@ in ( a: - {b, c, ...}: + { b, c, ... }: d: { # Stuff } diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 1987f449..75ffcf4d 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -14,9 +14,9 @@ baz ) ] - [1] + [ 1 ] - [1] + [ 1 ] [ b @@ -80,12 +80,12 @@ line ] ] - [[[singleton]]] - [[[{}]]] + [ [ [ singleton ] ] ] + [ [ [ { } ] ] ] [ [ [ - {} + { } multiline ] ] diff --git a/test/diff/monsters_2/out.nix b/test/diff/monsters_2/out.nix index 926682b1..09f521f8 100644 --- a/test/diff/monsters_2/out.nix +++ b/test/diff/monsters_2/out.nix @@ -15,7 +15,7 @@ options = { boot.kernel.features = mkOption { - default = {}; + default = { }; example = literalExpression "{ debug = true; }"; internal = true; description = '' diff --git a/test/diff/monsters_3/out.nix b/test/diff/monsters_3/out.nix index 2bf7e744..063dc219 100644 --- a/test/diff/monsters_3/out.nix +++ b/test/diff/monsters_3/out.nix @@ -62,7 +62,7 @@ stdenv.mkDerivation rec { description = "Checks whether the contrast between two colors meet the WCAG requirements"; homepage = "https://gitlab.gnome.org/World/design/contrast"; license = licenses.gpl3Plus; - maintainers = with maintainers; [jtojnar]; + maintainers = with maintainers; [ jtojnar ]; platforms = platforms.unix; }; } diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 31e23692..288584f9 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -74,7 +74,7 @@ in = - {}; + { }; example @@ -173,7 +173,7 @@ in or - [] + [ ] ) ++ @@ -251,7 +251,7 @@ in = - []; + [ ]; example diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index d5466c0d..95be0fee 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -2,7 +2,7 @@ ( # To find infinite recursion in NixOS option docs: # builtins.trace opt.loc - [docOption] ++ optionals subOptionsVisible subOptions + [ docOption ] ++ optionals subOptionsVisible subOptions ) ( # Filter out git @@ -37,7 +37,7 @@ # comment on operator inside || baseName == "tests.nix" # comment absorbable term - || {} + || { } # comment absorbable term 2 || { foo = "bar"; # multiline @@ -68,13 +68,13 @@ ( # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. - if actualPlugins == [] then - terraform.overrideAttrs (orig: {passthru = orig.passthru // passthru;}) + if actualPlugins == [ ] then + terraform.overrideAttrs (orig: { passthru = orig.passthru // passthru; }) else lib.appendToName "with-plugins" ( stdenv.mkDerivation { inherit (terraform) meta pname version; - nativeBuildInputs = [makeWrapper]; + nativeBuildInputs = [ makeWrapper ]; } ) ) @@ -159,13 +159,13 @@ some flags # multiline ] - ++ [short] + ++ [ short ] ++ [ more stuff # multiline ] - ++ (if foo then [bar] else [baz]) - ++ [] + ++ (if foo then [ bar ] else [ baz ]) + ++ [ ] ++ (optionals condition [ more items @@ -195,14 +195,14 @@ || cccccccccccccccccccc && ddddddddddddddddd || eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff then - [] + [ ] else if aaaaaaaaaaaaaaaaaaaaa || bbbbbbbbbbbbbbbbbbb && cccccccccccccccccccccccccccccccc || ddddddddddddddddd && eeeeeeeeeeeeeeeeeeee || fffffffffffffffffffffffffff then - [] + [ ] else if aaaaaaaaaaaaaa && bbbbbbbbbbbb && aaaaaaaaaaaaaa && bbbbbbbbbbbb || @@ -216,9 +216,9 @@ && eeeeeeeeeeeeeeeeeeee && fffffffffffffffffffffffffff then - [] + [ ] else - {} + { } ) # Indentation @@ -228,7 +228,7 @@ zip zlib ] - ++ [(if (lib.versionAtLeast version "103") then nss_latest else nss_esr)] + ++ [ (if (lib.versionAtLeast version "103") then nss_latest else nss_esr) ] ) # Indentation with parenthesized multiline function call diff --git a/test/diff/pat_bind/out.nix b/test/diff/pat_bind/out.nix index 1ea1f833..7105a893 100644 --- a/test/diff/pat_bind/out.nix +++ b/test/diff/pat_bind/out.nix @@ -1,11 +1,11 @@ [ - ({}@a: _) - ({}@a: _) - ({}@a: _) - ({}@a: _) + ({ }@a: _) + ({ }@a: _) + ({ }@a: _) + ({ }@a: _) - (a@{}: _) - (a@{}: _) - (a@{}: _) - (a@{}: _) + (a@{ }: _) + (a@{ }: _) + (a@{ }: _) + (a@{ }: _) ] diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index bf0b9300..573c5b9b 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -6,7 +6,7 @@ # Some comment baz, }: - {} + { } ) ( { @@ -14,7 +14,7 @@ bar, # Some comment baz, # More comment }: - {} + { } ) ( { @@ -23,14 +23,14 @@ # Some comment baz, }: - {} + { } ) ( { foo, bar, # Some comment }: - {} + { } ) ( a@{ @@ -61,15 +61,15 @@ }: _ ) - ({}: _) - ({a}: _) - ({}: _) - ({...}: _) - ({...}: _) - ({...}: _) - ({...}: _) + ({ }: _) + ({ a }: _) + ({ }: _) + ({ ... }: _) + ({ ... }: _) + ({ ... }: _) + ({ ... }: _) - ({b, e, ...}: _) + ({ b, e, ... }: _) ( { b, @@ -336,7 +336,7 @@ ) ( # a - {b, e, ...}: _ + { b, e, ... }: _ ) ( # a diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 01021da3..413c3b48 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -16,9 +16,9 @@ ) (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) - {a = with b; 1;} - {a = with b; 1 + 1;} - {a = with b; {c = 1;};} + { a = with b; 1; } + { a = with b; 1 + 1; } + { a = with b; { c = 1; }; } { a = with b; { c = 1; @@ -36,7 +36,7 @@ a = with b; 1; # comment } - (with a; with b; with c; {a = 1;}) + (with a; with b; with c; { a = 1; }) ( with a; with b; @@ -53,7 +53,7 @@ b = 2; } ) - {a = with b; with b; with b; 1;} + { a = with b; with b; with b; 1; } { binPath = with pkgs; From 35da23233a1cfd799d2b59cee056ece6dff06ea1 Mon Sep 17 00:00:00 2001 From: piegames Date: Thu, 4 Jan 2024 00:43:17 +0100 Subject: [PATCH 090/125] Strings: Fix multi-line strings that end with a single quote --- src/Nixfmt/Predoc.hs | 2 +- src/Nixfmt/Pretty.hs | 3 ++- test/correct/string-with-single-quote-at-end.nix | 3 +++ 3 files changed, 6 insertions(+), 2 deletions(-) create mode 100644 test/correct/string-with-single-quote-at-end.nix diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 0c8ca809..e2bd6746 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -45,7 +45,7 @@ import Data.Bifunctor (second) import Data.Maybe (fromMaybe) import Data.Text as Text (Text, concat, length, replicate, strip) import GHC.Stack (HasCallStack) -import Debug.Trace (traceShow, traceShowId) +-- import Debug.Trace (traceShow, traceShowId) import Control.Applicative ((<|>)) import Control.Monad.Trans.State.Strict (State, StateT, StateT(..), mapStateT, state, runState, evalState, get, put) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 58b1db41..24a8e7e9 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -626,6 +626,7 @@ isSimpleString [parts] isSimpleString parts | all isInvisibleLine parts = True + | endsInSingleQuote (last parts) = True | isIndented parts = True | lastLineIsSpaces parts = True | otherwise = False @@ -718,7 +719,7 @@ prettyIndentedString parts = group $ base $ -- 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 2 (sepBy newline (map (prettyLine escape unescapeInterpol) parts)) + <> (nest 2 $ sepBy newline $ map (prettyLine escape unescapeInterpol) parts) <> text "''" where escape = replaceMultiple [ ("'${", "''\\'''${") diff --git a/test/correct/string-with-single-quote-at-end.nix b/test/correct/string-with-single-quote-at-end.nix new file mode 100644 index 00000000..8cf4337a --- /dev/null +++ b/test/correct/string-with-single-quote-at-end.nix @@ -0,0 +1,3 @@ +'' + ${"w '%{http_code}\n'"} +'' From a273e5ae71bf74c4a53d1818fc2e2e6cc703bab4 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 8 Jan 2024 12:03:27 +0100 Subject: [PATCH 091/125] Lists: Fix absorbtion rules For some reasons instead of one condition it was split into two conditions, which covered everything necessery minus one edge case --- src/Nixfmt/Pretty.hs | 4 ++-- test/diff/idioms_nixos_1/out.nix | 10 ++++------ test/diff/lists/in.nix | 14 ++++++++++++++ test/diff/lists/out.nix | 15 +++++++++++++++ 4 files changed, 35 insertions(+), 8 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 24a8e7e9..614d0dda 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -409,10 +409,10 @@ isAbstractionWithAbsorbableTerm _ = False isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts +-- Non-empty sets and lists isAbsorbable (Set _ _ (Items (_:_)) _) = True -isAbsorbable (List (Ann [] _ Nothing) (Items [CommentedItem [] _]) _) = True +isAbsorbable (List _ (Items (_:_)) _) = True isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t -isAbsorbable (List _ (Items (_:_:_)) _) = True isAbsorbable _ = False absorb :: Doc -> Doc -> Maybe Int -> Expression -> Doc diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 2d26acba..22225f2f 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -276,12 +276,10 @@ in ] ); - boot.initrd.kernelModules = - optionals config.boot.initrd.includeDefaultModules - [ - # For LVM. - "dm_mod" - ]; + boot.initrd.kernelModules = optionals config.boot.initrd.includeDefaultModules [ + # For LVM. + "dm_mod" + ]; }) (mkIf (!config.boot.isContainer) { diff --git a/test/diff/lists/in.nix b/test/diff/lists/in.nix index 6798858e..56352bc1 100644 --- a/test/diff/lists/in.nix +++ b/test/diff/lists/in.nix @@ -4,6 +4,20 @@ foo = "bar"; foo2 = "barbar"; } ] + { # List in attrset with comment + + imports0 = []; + + imports2 = [ + # ./disko.nix + ./hardware-configuration.nix + ]; + imports3 = [ + # comment + ./disko.nix + ./hardware-configuration.nix + ]; + } [ (if foo then bar #multiline too else diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 75ffcf4d..8cbd273a 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -6,6 +6,21 @@ foo2 = "barbar"; } ] + { + # List in attrset with comment + + imports0 = [ ]; + + imports2 = [ + # ./disko.nix + ./hardware-configuration.nix + ]; + imports3 = [ + # comment + ./disko.nix + ./hardware-configuration.nix + ]; + } [ ( if foo then From 070063ecc6a5b6ecc9d6d80f99e46971fb9cc763 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 15 Jan 2024 17:54:29 +0100 Subject: [PATCH 092/125] Assert: always force-expand --- src/Nixfmt/Pretty.hs | 2 +- test/diff/assert/out.nix | 15 ++++++++++++--- test/diff/idioms_lib_4/out.nix | 6 ++++-- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 614d0dda..80246ccb 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -483,7 +483,7 @@ instance Pretty Expression where pretty (Assert assert cond semicolon expr) = base (pretty assert <> hardspace <> nest 2 (group cond) <> pretty semicolon) - <> absorbSet expr + <> hardline <> pretty expr pretty (If if_ cond then_ expr0 else_ expr1) = base $ group' False $ diff --git a/test/diff/assert/out.nix b/test/diff/assert/out.nix index de9c0151..b57ec7a6 100644 --- a/test/diff/assert/out.nix +++ b/test/diff/assert/out.nix @@ -1,5 +1,8 @@ [ - (assert b; e) + ( + assert b; + e + ) ( assert b; # d e @@ -36,6 +39,12 @@ ; # d e ) - (assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) - (assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) + ( + assert b; + cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ) + ( + assert b; + cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ) ] diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index 5df581a3..a887a224 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -837,10 +837,12 @@ rec { cpu, # Optional, but fallback too complex for here. # Inferred below instead. - vendor ? assert false; null, + vendor ? assert false; + null, kernel, # Also inferred below - abi ? assert false; null, + abi ? assert false; + null, }@args: let getCpu = name: cpuTypes.${name} or (throw "Unknown CPU type: ${name}"); From 53c7361d6e45638599dba6c82b9faeaa07cb0cfe Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 15 Jan 2024 15:39:41 +0100 Subject: [PATCH 093/125] Rework: with, paramAttr, bindings, parentheses - Bindings where the RHS is a parenthesized expression are now handled explicitly. - Function argument default values now use the same logic as bindings, making it prettier and more consistent. - Attribute sets in a `with` are now force-expanded in bindings. This is consistent with current attrset handling in bindings. - Improved parenthesized with statements. --- src/Nixfmt/Pretty.hs | 137 ++++++++++++++++++++------------ test/diff/apply/out.nix | 42 +++++----- test/diff/attr_set/in.nix | 19 +++++ test/diff/attr_set/out.nix | 56 +++++++++++++ test/diff/idioms_lib_4/out.nix | 6 +- test/diff/idioms_pkgs_5/out.nix | 44 +++++----- test/diff/lambda/in.nix | 17 ++++ test/diff/lambda/out.nix | 73 +++++++++++++++++ test/diff/pattern/out.nix | 20 ++--- test/diff/with/in.nix | 39 ++++++++- test/diff/with/out.nix | 95 +++++++++++++++++++++- 11 files changed, 434 insertions(+), 114 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 80246ccb..31b9389c 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -118,52 +118,7 @@ instance Pretty Binder where -- `foo = bar` pretty (Assignment selectors assign expr semicolon) = base $ group $ hcat selectors - <> nest 2 (hardspace <> pretty assign <> inner) <> pretty semicolon - where - inner = - case expr of - -- Absorbable term. Always start on the same line, keep semicolon attatched - (Term t) | isAbsorbable t -> hardspace <> prettyTermWide t - -- Not all strings are absorbably, but in this case we always want to keep them attached. - -- Because there's nothing to gain from having them start on a new line. - (Term (String _)) -> hardspace <> group expr - -- Same for path - (Term (Path _)) -> hardspace <> group expr - -- Non-absorbable term - -- If it is multi-line, force it to start on a new line with indentation - (Term _) -> group' False (line <> pretty expr) - -- 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 - -- Absorb function declarations but only those with simple parameter(s) - (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr - -- With expression with absorbable body: Try to absorb and keep the semicolon attached, spread otherwise - (With _ _ _ (Term t)) | isAbsorbable t -> softline <> group expr - -- Special case `//` 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 [] TUpdate Nothing) b) | isAbsorbable t -> - group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b - -- Case 2a: LHS fits onto first line, RHS is an absorbable term - (Operation l (Ann [] TUpdate Nothing) (Term t)) | isAbsorbable t -> - group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) - -- Case 2b: LHS fits onto first line, RHS is a function application - (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp False (pretty TUpdate <> hardspace) False f a - -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> - group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b - -- Case 2a: LHS fits onto first line, RHS is an absorbable term - (Operation l (Ann [] TConcat Nothing) (Term t)) | isAbsorbable t -> - group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) - -- Case 2b: LHS fits onto first line, RHS is a function application - (Operation l (Ann [] TConcat Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp False (pretty TConcat <> 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) - -- Otherwise, start on new line, expand fully (including the semicolon) - _ -> line <> group expr + <> nest 2 (hardspace <> pretty assign <> absorbRHS expr) <> pretty semicolon -- Pretty a set -- while we already pretty eagerly expand sets with more than one element, @@ -219,6 +174,10 @@ prettyTerm (Parenthesized paropen (Application f a) parclose) base $ prettyApp True mempty True f a ) <> pretty parclose +-- Parenthesized `with` followed by absorbable term +prettyTerm (Parenthesized paropen with@(With _ _ _ (Term t)) parclose) | isAbsorbable t + = base $ group $ pretty (moveTrailingCommentUp paropen) <> nest 2 (prettyWith True with) <> pretty parclose + -- Parentheses prettyTerm (Parenthesized paropen expr parclose) = base $ group $ pretty (moveTrailingCommentUp paropen) <> lineL <> nest 2 (group expr) <> lineR <> pretty parclose @@ -250,8 +209,9 @@ instance Pretty ParamAttr where -- With ? default pretty (ParamAttr name (Just (qmark, def)) maybeComma) - = group (pretty name <> hardspace <> pretty qmark - <> absorb softline mempty (Just 2) def) + = base $ group $ + pretty name <> hardspace + <> nest 2 (pretty qmark <> absorbRHS def) <> pretty maybeComma -- `...` @@ -373,7 +333,7 @@ prettyApp indentFunction pre hasPost f a = group' True $ nest 2 $ prettyTerm t absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) - -- Move any tryiling comments on the opening parenthesis down into the body + -- Move any trailing comments on the opening parenthesis down into the body <> (surroundWith line' $ group $ nest 2 $ base $ mapFirstToken (\(Ann leading token trailing') -> (Ann (maybeToList (toLineComment <$> post') ++ leading) token trailing')) @@ -401,6 +361,19 @@ prettyApp indentFunction pre hasPost f a ) <> (if hasPost && not (null comment') then hardline else mempty) +prettyWith :: Bool -> Expression -> Doc +-- absorb the body +prettyWith True (With with expr0 semicolon (Term expr1)) + = base (pretty with <> hardspace + <> nest 2 (group expr0) <> pretty semicolon) + -- Force-expand attrsets + <> hardspace <> prettyTermWide expr1 +prettyWith _ (With with expr0 semicolon expr1) + = base (pretty with <> hardspace + <> nest 2 (group expr0) <> pretty semicolon) + <> line <> pretty expr1 +prettyWith _ _ = error "unreachable" + isAbstractionWithAbsorbableTerm :: Expression -> Bool isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ body) = isAbstractionWithAbsorbableTerm body @@ -422,6 +395,12 @@ absorb left right _ (Term t) | x == softline' = mempty | x == line' = mempty | otherwise = hardspace +absorb left right _ with@(With _ _ _ (Term t)) | isAbsorbable t + = toHardspace left <> prettyWith True with <> toHardspace right + where toHardspace x | x == mempty = mempty + | x == softline' = mempty + | x == line' = mempty + | otherwise = hardspace absorb left right Nothing x = left <> pretty x <> right absorb left right (Just level) x @@ -430,6 +409,61 @@ absorb left right (Just level) x absorbSet :: Expression -> Doc absorbSet = absorb line mempty Nothing +-- Render the RHS value of an assignment or function parameter default value +absorbRHS :: Expression -> Doc +absorbRHS expr = case expr of + -- Absorbable term. Always start on the same line, keep semicolon attatched + (Term t) | isAbsorbable t -> hardspace <> prettyTermWide t + -- Parenthesized expression. Same thing as the special case for parenthesized last argument in function calls. + (Term (Parenthesized open expr' close)) -> + group' True $ nest 2 $ base $ + hardspace <> pretty open + <> (surroundWith line' . group . nest 2 . base) expr' + <> pretty close + -- Not all strings are absorbably, but in this case we always want to keep them attached. + -- Because there's nothing to gain from having them start on a new line. + (Term (String _)) -> hardspace <> group expr + -- Same for path + (Term (Path _)) -> hardspace <> group expr + -- Non-absorbable term + -- If it is multi-line, force it to start on a new line with indentation + (Term _) -> group' False (line <> pretty expr) + -- 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 + -- Absorb function declarations but only those with simple parameter(s) + (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr + -- With expression with absorbable body: Treat as absorbable term + (With _ _ _ (Term t)) | isAbsorbable t -> hardspace <> prettyWith True expr + -- Otherwise, render like in the "Everything else" case, but with the leading line break + -- being part of the group. + (With _ _ _ _) -> group' False $ line <> pretty expr + -- Special case `//` 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 [] TUpdate Nothing) b) | isAbsorbable t -> + group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b + -- Case 2a: LHS fits onto first line, RHS is an absorbable term + (Operation l (Ann [] TUpdate Nothing) (Term t)) | isAbsorbable t -> + group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) + -- Case 2b: LHS fits onto first line, RHS is a function application + (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> + line <> (group l) <> line <> prettyApp False (pretty TUpdate <> hardspace) False f a + -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> + group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b + -- Case 2a: LHS fits onto first line, RHS is an absorbable term + (Operation l (Ann [] TConcat Nothing) (Term t)) | isAbsorbable t -> + group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) + -- Case 2b: LHS fits onto first line, RHS is a function application + (Operation l (Ann [] TConcat Nothing) (Application f a)) -> + line <> (group l) <> line <> prettyApp False (pretty TConcat <> 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) + -- Otherwise, start on new line, expand fully (including the semicolon) + _ -> line <> group expr + -- Only absorb "else if" absorbElse :: Expression -> Doc absorbElse (If if_ cond then_ expr0 else_ expr1) @@ -444,10 +478,7 @@ absorbElse x instance Pretty Expression where pretty (Term t) = pretty t - pretty (With with expr0 semicolon expr1) - = base (pretty with <> hardspace - <> nest 2 (group expr0) <> pretty semicolon) - <> absorbSet expr1 + 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) diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 5c8aaa29..9f601672 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -218,8 +218,8 @@ 2 3 # multiline ]; - looooooooong = - (toINI + looooooooong = ( + toINI { inherit mkSectionName @@ -229,7 +229,7 @@ ; } sections - ); + ); looooooooong' = toINI { @@ -363,31 +363,29 @@ } ); # Also test within parenthesized function instead of just attribute sets - foo3 = - ( - (callPackage ../generic-builders/manifest.nix { - # A lot of values here - }).overrideAttrs + foo3 = ( + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs stuff ( prevAttrs: { # stuff here } ) - ); + ); # Add a comment at a bad place - foo4 = - ( - # comment - (callPackage ../generic-builders/manifest.nix { - # A lot of values here - }).overrideAttrs - stuff - ( - prevAttrs: { - # stuff here - } - ) - ); + foo4 = ( + # comment + (callPackage ../generic-builders/manifest.nix { + # A lot of values here + }).overrideAttrs + stuff + ( + prevAttrs: { + # stuff here + } + ) + ); } ] diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index 9b709688..2fe8a921 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -230,4 +230,23 @@ }) secret-config.ssh-hosts; } + + # Parentheses + { + a = ({}); + b = ([ 1 2 3 ]); + c = (if null then true else false); + d = (let in [ 1 2 3]); + e = (if null then true else [ 1 2 3 ]); + # FIXME: This one exposes a really weird bug in the underlying + # pretty printing engine. + # (It's probably the same one that causes weird indentation in + # functions with multiline function) + # f = /* comment */ (if null then true else [ 1 2 3 ]); + + a = (with a; {}); + b = (with a; [ 1 2 3 ]); + c = (with a; if null then true else false); + d = (with a; let in [ 1 2 3]); + } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 77774632..a0935609 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -303,4 +303,60 @@ }) secret-config.ssh-hosts; } + + # Parentheses + { + a = ({ }); + b = ([ + 1 + 2 + 3 + ]); + c = (if null then true else false); + d = ( + let + in + [ + 1 + 2 + 3 + ] + ); + e = ( + if null then + true + else + [ + 1 + 2 + 3 + ] + ); + # FIXME: This one exposes a really weird bug in the underlying + # pretty printing engine. + # (It's probably the same one that causes weird indentation in + # functions with multiline function) + # f = /* comment */ (if null then true else [ 1 2 3 ]); + + a = (with a; { }); + b = ( + with a; + [ + 1 + 2 + 3 + ] + ); + c = (with a; if null then true else false); + d = ( + with a; + let + in + [ + 1 + 2 + 3 + ] + ); + } ] diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index a887a224..fcf413f5 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -837,11 +837,13 @@ rec { cpu, # Optional, but fallback too complex for here. # Inferred below instead. - vendor ? assert false; + vendor ? + assert false; null, kernel, # Also inferred below - abi ? assert false; + abi ? + assert false; null, }@args: let diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index ef74088b..1812b854 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -165,15 +165,16 @@ let # Including it then would cause needless mass rebuilds. # # TODO(@Ericson2314): Make [ "build" "host" ] always the default / resolve #87909 - configurePlatforms ? optionals - ( - stdenv.hostPlatform != stdenv.buildPlatform - || config.configurePlatformsByDefault - ) - [ - "build" - "host" - ], + configurePlatforms ? + optionals + ( + stdenv.hostPlatform != stdenv.buildPlatform + || config.configurePlatformsByDefault + ) + [ + "build" + "host" + ], # TODO(@Ericson2314): Make unconditional / resolve #33599 # Check phase @@ -184,24 +185,25 @@ let doInstallCheck ? config.doCheckByDefault or false, # TODO(@Ericson2314): Make always true and remove / resolve #178468 - strictDeps ? if config.strictDepsByDefault then - true - else - stdenv.hostPlatform != stdenv.buildPlatform, + strictDeps ? + if config.strictDepsByDefault then + true + else + stdenv.hostPlatform != stdenv.buildPlatform, enableParallelBuilding ? config.enableParallelBuildingByDefault, meta ? { }, passthru ? { }, pos ? # position used in error messages and for meta.position - ( - if attrs.meta.description or null != null then - builtins.unsafeGetAttrPos "description" attrs.meta - else if attrs.version or null != null then - builtins.unsafeGetAttrPos "version" attrs - else - builtins.unsafeGetAttrPos "name" attrs - ), + ( + if attrs.meta.description or null != null then + builtins.unsafeGetAttrPos "description" attrs.meta + else if attrs.version or null != null then + builtins.unsafeGetAttrPos "version" attrs + else + builtins.unsafeGetAttrPos "name" attrs + ), separateDebugInfo ? false, outputs ? [ "out" ], __darwinAllowLocalNetworking ? false, diff --git a/test/diff/lambda/in.nix b/test/diff/lambda/in.nix index 69454cef..cd0d838f 100644 --- a/test/diff/lambda/in.nix +++ b/test/diff/lambda/in.nix @@ -52,4 +52,21 @@ in ...}: d: { # Stuff }) + + ({ + gst_plugins ? [ + gst-plugins-good + gst-plugins-ugly + ], + more ? let in [1 2 3], + things ? if null then true else false, + things ? if null then true else "loooooooooooooooooooooooooooooooooooooooooooong", + more ? (let in [1 2 3]), + foo ? (with bar; [ 1 2 3 ]), + foo ? (with bar; let in [ 1 2 3 ]), + things ? (if null then true else false), + things ? (if null then true else "loooooooooooooooooooooooooooooooooooooooooooong"), + things ? (if null then [ 1 2 3 ] else "loooooooooooooooooooooooooooooooooooooooooooong"), + things ? /* comment */ (if null then [ 1 2 3 ] else "loooooooooooooooooooooooooooooooooooooooooooong"), + }: {}) ] diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 42d4b05b..5999629f 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -93,4 +93,77 @@ in # Stuff } ) + + ( + { + gst_plugins ? [ + gst-plugins-good + gst-plugins-ugly + ], + more ? + let + in + [ + 1 + 2 + 3 + ], + things ? if null then true else false, + things ? + if null then true else "loooooooooooooooooooooooooooooooooooooooooooong", + more ? ( + let + in + [ + 1 + 2 + 3 + ] + ), + foo ? ( + with bar; + [ + 1 + 2 + 3 + ] + ), + foo ? ( + with bar; + let + in + [ + 1 + 2 + 3 + ] + ), + things ? (if null then true else false), + things ? ( + if null then true else "loooooooooooooooooooooooooooooooooooooooooooong" + ), + things ? ( + if null then + [ + 1 + 2 + 3 + ] + else + "loooooooooooooooooooooooooooooooooooooooooooong" + ), + things ? # comment + ( + if null then + [ + 1 + 2 + 3 + ] + else + "loooooooooooooooooooooooooooooooooooooooooooong" + ), + }: + { } + ) ] diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 573c5b9b..77ae6a7f 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -643,12 +643,12 @@ ( # a { - b # a - ? # a + b # a + ? # a null # c , # d - e # a - ? # a + e # a + ? # a null # f , # g ... # h @@ -661,9 +661,9 @@ # a # b - # a - # - ? + # a + # + ? # a # null, @@ -672,9 +672,9 @@ # d # e - # a - # - ? + # a + # + ? # a # null, diff --git a/test/diff/with/in.nix b/test/diff/with/in.nix index 5c967140..8d584c31 100644 --- a/test/diff/with/in.nix +++ b/test/diff/with/in.nix @@ -10,6 +10,7 @@ { a = with b; 1 + 1;} { a = with b; {c=1;};} { a = with b; {c=1; d=2; e=3;};} + { a = with b; /* comment */ [ 1 2 3 ]; } { a = with b; # comment 1; @@ -18,9 +19,15 @@ 1; # comment } - (with a; with b; with c; {a=1;}) - (with a; with b; with c; {a=1;b=2;}) - (with a; /* comment */ with b; with c; {a=1;b=2;}) + ([ 1 ]) + (with a; [ 1 ]) + ([ 1 2 3]) + (with a; [ 1 2 3 ]) + (with a; with b; with c; [ 1 ]) + (with a; with b; with c; {a=1;}) + (with a; /* comment */ with b; with c; {a=1;}) + (with a; with b; with c; {a=1;b=2;}) + (with a; /* comment */ with b; with c; {a=1;b=2;}) { a = with b;with b;with b; 1; } @@ -31,4 +38,30 @@ [ rsync util-linux]);} + (with a; {}) + (with a; [ 1 2 3 ]) + (with a; if null then true else false) + (with a; let in [ 1 2 3]) + ({ + gst_plugins ? with gst_all_1; [ + gst-plugins-good + gst-plugins-ugly + ], + more ? with stuff; let in [1 2 3], + things ? with a; if null then true else false, + things ? with a; if null then true else "looooooooooooooooooooooooooooooooooooong", + }: {}) + { + more = with stuff; + let + in + [ + 1 + 2 + 3 + ]; + things = with a; if null then true else false; + things = with a; + if null then true else "looooooooooooooooooooooooooooooooooooong"; + } ] diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 413c3b48..9e20012e 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -18,7 +18,11 @@ (with b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc) { a = with b; 1; } { a = with b; 1 + 1; } - { a = with b; { c = 1; }; } + { + a = with b; { + c = 1; + }; + } { a = with b; { c = 1; @@ -26,6 +30,14 @@ e = 3; }; } + { + a = with b; # comment + [ + 1 + 2 + 3 + ]; + } { a = with b; @@ -36,11 +48,33 @@ a = with b; 1; # comment } + ([ 1 ]) + (with a; [ 1 ]) + ([ + 1 + 2 + 3 + ]) + (with a; [ + 1 + 2 + 3 + ]) + (with a; with b; with c; [ 1 ]) (with a; with b; with c; { a = 1; }) + ( + with a; # comment + with b; + with c; + { + a = 1; + } + ) ( with a; with b; - with c; { + with c; + { a = 1; b = 2; } @@ -48,7 +82,8 @@ ( with a; # comment with b; - with c; { + with c; + { a = 1; b = 2; } @@ -62,4 +97,58 @@ util-linux ]); } + (with a; { }) + (with a; [ + 1 + 2 + 3 + ]) + (with a; if null then true else false) + ( + with a; + let + in + [ + 1 + 2 + 3 + ] + ) + ( + { + gst_plugins ? with gst_all_1; [ + gst-plugins-good + gst-plugins-ugly + ], + more ? + with stuff; + let + in + [ + 1 + 2 + 3 + ], + things ? with a; if null then true else false, + things ? + with a; + if null then true else "looooooooooooooooooooooooooooooooooooong", + }: + { } + ) + { + more = + with stuff; + let + in + [ + 1 + 2 + 3 + ]; + things = with a; if null then true else false; + things = + with a; + if null then true else "looooooooooooooooooooooooooooooooooooong"; + } ] From 067c281ae2bd344c2ba0e9d79ae5c6aa737086e3 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 15 Jan 2024 21:04:07 +0100 Subject: [PATCH 094/125] Force-expand attrsets in attrset functions --- src/Nixfmt/Pretty.hs | 46 ++++++++++++++++------------------------ test/diff/lambda/in.nix | 37 ++++++++++++++++++++++++++++++++ test/diff/lambda/out.nix | 43 +++++++++++++++++++++++++++++++++++++ 3 files changed, 98 insertions(+), 28 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 31b9389c..9c872552 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -388,27 +388,6 @@ isAbsorbable (List _ (Items (_:_)) _) = True isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t isAbsorbable _ = False -absorb :: Doc -> Doc -> Maybe Int -> Expression -> Doc -absorb left right _ (Term t) - | isAbsorbable t = toHardspace left <> prettyTerm t <> toHardspace right - where toHardspace x | x == mempty = mempty - | x == softline' = mempty - | x == line' = mempty - | otherwise = hardspace -absorb left right _ with@(With _ _ _ (Term t)) | isAbsorbable t - = toHardspace left <> prettyWith True with <> toHardspace right - where toHardspace x | x == mempty = mempty - | x == softline' = mempty - | x == line' = mempty - | otherwise = hardspace - -absorb left right Nothing x = left <> pretty x <> right -absorb left right (Just level) x - = left <> nest level (pretty x) <> right - -absorbSet :: Expression -> Doc -absorbSet = absorb line mempty Nothing - -- Render the RHS value of an assignment or function parameter default value absorbRHS :: Expression -> Doc absorbRHS expr = case expr of @@ -523,15 +502,26 @@ instance Pretty Expression where <> (surroundWith line $ nest 2 $ group expr0) <> pretty else_ <> absorbElse expr1 + -- Simple parameter pretty (Abstraction (IDParameter param) colon body) = pretty param <> pretty colon <> absorbAbs 1 body - where absorbAbs :: Int -> Expression -> Doc - absorbAbs depth (Abstraction (IDParameter param0) colon0 body0) = - hardspace <> pretty param0 <> pretty colon0 <> absorbAbs (depth + 1) body0 - absorbAbs depth x - | depth <= 2 = absorbSet x - | otherwise = absorb hardline mempty Nothing x - + where + absorbAbs :: Int -> Expression -> Doc + -- If there are multiple ID parameters to that function, treat them all at once + absorbAbs depth (Abstraction (IDParameter param0) colon0 body0) = + hardspace <> pretty param0 <> pretty colon0 <> absorbAbs (depth + 1) body0 + absorbAbs _ (Term t) | isAbsorbable t + = hardspace <> prettyTerm t + absorbAbs _ with@(With _ _ _ (Term t)) | isAbsorbable t + = hardspace <> prettyWith True with + -- Force the content onto a new line when it is not absorbable and there are more than two arguments + absorbAbs depth x + = (if depth <= 2 then line else hardline) <> pretty x + + -- Attrset parameter + pretty (Abstraction param colon (Term t)) + | isAbsorbable t + = pretty param <> pretty colon <> line <> group (prettyTermWide t) pretty (Abstraction param colon body) = pretty param <> pretty colon <> line <> pretty body diff --git a/test/diff/lambda/in.nix b/test/diff/lambda/in.nix index cd0d838f..12d30655 100644 --- a/test/diff/lambda/in.nix +++ b/test/diff/lambda/in.nix @@ -69,4 +69,41 @@ in things ? (if null then [ 1 2 3 ] else "loooooooooooooooooooooooooooooooooooooooooooong"), things ? /* comment */ (if null then [ 1 2 3 ] else "loooooooooooooooooooooooooooooooooooooooooooong"), }: {}) + { + a = + name: + with config.ids; + '' + --nodaemon --syslog --prefix=${name} --pidfile /run/${name}/${name}.pid ${name} + ''; + a' = + name: + '' + --nodaemon --syslog --prefix=${name} --pidfile /run/${name}/${name}.pid ${name} + ''; + b = p: + with p; + [ + ConfigIniFiles + FileSlurp + ]; + b' = p: + [ + ConfigIniFiles + FileSlurp + ]; + mkUrls = + { + name, + version, + biocVersion, + }: + [ "mirror://bioc/${biocVersion}/data/experiment/${name}_${version}.tar.gz" ]; + c = { ... }: { foo = true; }; + c = { ... }: [ 1 ]; + d = { a }: { foo = true; }; + d = { a }: [ 1 ]; + e = { a, b, }: { foo = true; }; + e = { a, b, }: [ 1 ]; + } ] diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 5999629f..8722bb4e 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -166,4 +166,47 @@ in }: { } ) + { + a = + name: with config.ids; '' + --nodaemon --syslog --prefix=${name} --pidfile /run/${name}/${name}.pid ${name} + ''; + a' = name: '' + --nodaemon --syslog --prefix=${name} --pidfile /run/${name}/${name}.pid ${name} + ''; + b = + p: with p; [ + ConfigIniFiles + FileSlurp + ]; + b' = p: [ + ConfigIniFiles + FileSlurp + ]; + mkUrls = + { + name, + version, + biocVersion, + }: + [ "mirror://bioc/${biocVersion}/data/experiment/${name}_${version}.tar.gz" ]; + c = + { ... }: + { + foo = true; + }; + c = { ... }: [ 1 ]; + d = + { a }: + { + foo = true; + }; + d = { a }: [ 1 ]; + e = + { a, b }: + { + foo = true; + }; + e = { a, b }: [ 1 ]; + } ] From d6930fd0c62c4d7ec9e4a814adc3d2f590d96271 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 23 Jan 2024 22:07:59 +0100 Subject: [PATCH 095/125] Refactoring This should not change the output format --- src/Nixfmt/Pretty.hs | 100 +++++++++++++++++++------------------------ 1 file changed, 45 insertions(+), 55 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 9c872552..b565cd0a 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -168,34 +168,21 @@ prettyTerm (List (Ann pre paropen post) items parclose) = prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) --- Parenthesized application -prettyTerm (Parenthesized paropen (Application f a) parclose) - = base $ group $ pretty (moveTrailingCommentUp paropen) <> nest 2 ( - base $ prettyApp True mempty True f a - ) <> pretty parclose - --- Parenthesized `with` followed by absorbable term -prettyTerm (Parenthesized paropen with@(With _ _ _ (Term t)) parclose) | isAbsorbable t - = base $ group $ pretty (moveTrailingCommentUp paropen) <> nest 2 (prettyWith True with) <> pretty parclose - -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = base $ group $ pretty (moveTrailingCommentUp paropen) <> lineL <> nest 2 (group expr) <> lineR <> pretty parclose + = base $ group $ pretty (moveTrailingCommentUp paropen) <> inner <> pretty parclose where - (lineL, lineR) = + inner = case expr of -- Start on the same line for these - (Term t) | isAbsorbable t -> (mempty, mempty) - -- unreachable - (Application _ _) -> (mempty, mempty) - -- Absorb function declarations but only those with simple parameter(s) - (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> (mempty, mempty) - (Operation _ _ _) -> (line', line') + _ | isAbsorbableExpr expr -> nest 2 $ group $ absorbExpr False expr + -- Parenthesized application + (Application f a) -> nest 2 $ base $ prettyApp True mempty True f a -- Same thing for selections - (Term (Selection t _)) | isAbsorbable t -> (line', line') - (Term (Selection _ _)) -> (mempty, line') + (Term (Selection t _)) | isAbsorbable t -> line' <> (nest 2 $ group $ expr) <> line' + (Term (Selection _ _)) -> (nest 2 $ group $ expr) <> line' -- Start on a new line for the others - _ -> (line', line') + _ -> line' <> (nest 2 $ group $ expr) <> line' instance Pretty Term where pretty l@List{} = group $ prettyTerm l @@ -368,38 +355,54 @@ prettyWith True (With with expr0 semicolon (Term expr1)) <> nest 2 (group expr0) <> pretty semicolon) -- Force-expand attrsets <> hardspace <> prettyTermWide expr1 +-- Normal case prettyWith _ (With with expr0 semicolon expr1) = base (pretty with <> hardspace <> nest 2 (group expr0) <> pretty semicolon) <> line <> pretty expr1 prettyWith _ _ = error "unreachable" -isAbstractionWithAbsorbableTerm :: Expression -> Bool -isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ (Term t)) | isAbsorbable t = True -isAbstractionWithAbsorbableTerm (Abstraction (IDParameter _) _ body) = isAbstractionWithAbsorbableTerm body -isAbstractionWithAbsorbableTerm _ = False +isAbsorbableExpr :: Expression -> Bool +isAbsorbableExpr expr = case expr of + (Term t) | isAbsorbableTerm t -> True + (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 + _ -> False isAbsorbable :: Term -> Bool isAbsorbable (String (Ann _ parts@(_:_:_) _)) = not $ isSimpleString parts +isAbsorbable (Path _) = True -- Non-empty sets and lists isAbsorbable (Set _ _ (Items (_:_)) _) = True isAbsorbable (List _ (Items (_:_)) _) = True isAbsorbable (Parenthesized (Ann [] _ Nothing) (Term t) _) = isAbsorbable t isAbsorbable _ = False +isAbsorbableTerm :: Term -> Bool +isAbsorbableTerm = isAbsorbable + +absorbExpr :: Bool -> Expression -> Doc +absorbExpr True (Term t) | isAbsorbableTerm t = prettyTermWide t +absorbExpr False (Term t) | isAbsorbableTerm t = prettyTerm t +-- With expression with absorbable body: Treat as absorbable term +absorbExpr _ expr@(With _ _ _ (Term t)) | isAbsorbableTerm t = prettyWith True expr +absorbExpr _ expr = pretty expr + -- Render the RHS value of an assignment or function parameter default value absorbRHS :: Expression -> Doc absorbRHS expr = case expr of - -- Absorbable term. Always start on the same line, keep semicolon attatched - (Term t) | isAbsorbable t -> hardspace <> prettyTermWide t + -- Absorbable expression. Always start on the same line + _ | isAbsorbableExpr expr -> hardspace <> group (absorbExpr True expr) -- Parenthesized expression. Same thing as the special case for parenthesized last argument in function calls. (Term (Parenthesized open expr' close)) -> group' True $ nest 2 $ base $ hardspace <> pretty open <> (surroundWith line' . group . nest 2 . base) expr' <> pretty close - -- Not all strings are absorbably, but in this case we always want to keep them attached. + -- Not all strings are absorbable, but in this case we always want to keep them attached. -- Because there's nothing to gain from having them start on a new line. (Term (String _)) -> hardspace <> group expr -- Same for path @@ -410,12 +413,6 @@ 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 - -- Absorb function declarations but only those with simple parameter(s) - (Abstraction _ _ _) | isAbstractionWithAbsorbableTerm expr -> hardspace <> group expr - -- With expression with absorbable body: Treat as absorbable term - (With _ _ _ (Term t)) | isAbsorbable t -> hardspace <> prettyWith True expr - -- Otherwise, render like in the "Everything else" case, but with the leading line break - -- being part of the group. (With _ _ _ _) -> group' False $ line <> pretty expr -- Special case `//` operations to be more compact in some cases -- Case 1: two arguments, LHS is absorbable term, RHS fits onto the last line @@ -443,17 +440,6 @@ absorbRHS expr = case expr of -- Otherwise, start on new line, expand fully (including the semicolon) _ -> line <> group expr --- Only absorb "else if" -absorbElse :: Expression -> Doc -absorbElse (If if_ cond then_ expr0 else_ expr1) - -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - -- Using hardline here is okay because it will only apply to nested ifs, which should not be inline anyways. - = hardspace <> (group (pretty if_ <> line <> nest 2 (pretty cond) <> line <> pretty then_)) - <> hardline <> nest 2 (group expr0) <> hardline - <> pretty else_ <> absorbElse expr1 -absorbElse x - = line <> nest 2 (group x) - instance Pretty Expression where pretty (Term t) = pretty t @@ -495,12 +481,19 @@ instance Pretty Expression where <> nest 2 (group cond) <> pretty semicolon) <> hardline <> pretty expr - pretty (If if_ cond then_ expr0 else_ expr1) - = base $ group' False $ - -- `if cond then` if it fits on one line, otherwise `if\n cond\nthen` (with cond indented) - group (pretty if_ <> line <> nest 2 (pretty cond) <> line <> pretty then_) - <> (surroundWith line $ nest 2 $ group expr0) - <> pretty else_ <> absorbElse expr1 + pretty expr@(If _ _ _ _ _ _) + = base $ group' False $ prettyIf line expr + where + -- Recurse to absorb nested "else if" chains + prettyIf :: Doc -> Expression -> Doc + 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 2 (pretty cond) <> line <> pretty then_) + <> (surroundWith sep $ nest 2 $ group expr0) + -- Using hardline here is okay because it will only apply to nested ifs, which should not be inline anyways. + <> pretty else_ <> hardspace <> prettyIf hardline expr1 + prettyIf _ x + = line <> nest 2 (group x) -- Simple parameter pretty (Abstraction (IDParameter param) colon body) @@ -510,10 +503,7 @@ instance Pretty Expression where -- If there are multiple ID parameters to that function, treat them all at once absorbAbs depth (Abstraction (IDParameter param0) colon0 body0) = hardspace <> pretty param0 <> pretty colon0 <> absorbAbs (depth + 1) body0 - absorbAbs _ (Term t) | isAbsorbable t - = hardspace <> prettyTerm t - absorbAbs _ with@(With _ _ _ (Term t)) | isAbsorbable t - = hardspace <> prettyWith True with + absorbAbs _ expr | isAbsorbableExpr expr = hardspace <> absorbExpr False expr -- Force the content onto a new line when it is not absorbable and there are more than two arguments absorbAbs depth x = (if depth <= 2 then line else hardline) <> pretty x From 08fe73957556be8f79d696698dfe319f3fef0aee Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 3 Feb 2024 21:04:18 +0100 Subject: [PATCH 096/125] Fix false positive in --verify checks --- src/Nixfmt/Types.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index e3719ab5..03e75d3d 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -145,7 +145,15 @@ data Expression -- initial trivia. data Whole a = Whole a Trivia - deriving (Eq, Show) + +-- | Equality of annotated syntax is defined as equality of their corresponding +-- semantics, thus ignoring the annotations. +instance Eq a => Eq (Whole a) where + Whole x _ == Whole y _ = x == y + +-- Trivia is ignored for Eq, so also don't show +instance Show a => Show (Whole a) where + show (Whole a _) = show a type File = Whole Expression From bb459628075dd57e704ca984712d01b1765a5e60 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 2 Feb 2024 12:56:31 +0100 Subject: [PATCH 097/125] Treat some parenthesized expressions as "simple" This allows force-compaction in more situations --- src/Nixfmt/Pretty.hs | 4 ++++ test/diff/idioms_lib_2/out.nix | 6 +----- test/diff/idioms_nixos_2/out.nix | 22 +++++----------------- test/diff/idioms_pkgs_3/out.nix | 8 ++------ test/diff/idioms_pkgs_5/out.nix | 12 +++--------- 5 files changed, 15 insertions(+), 37 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index b565cd0a..628298f4 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -384,6 +384,9 @@ isAbsorbable _ = False isAbsorbableTerm :: Term -> Bool isAbsorbableTerm = isAbsorbable +-- Note that unlike for absorbable terms which can be force-absorbed, some expressions +-- may turn out to not be absorbable. In that case, they should start with a line' so that +-- they properly start on the next line if necessary. absorbExpr :: Bool -> Expression -> Doc absorbExpr True (Term t) | isAbsorbableTerm t = prettyTermWide t absorbExpr False (Term t) | isAbsorbableTerm t = prettyTerm t @@ -580,6 +583,7 @@ isSimple (Term (Path (Ann [] _ Nothing))) = True isSimple (Term (Token (Ann [] (Identifier _) Nothing))) = True isSimple (Term (Selection t selectors)) = isSimple (Term t) && all isSimpleSelector selectors +isSimple (Term (Parenthesized (Ann [] _ Nothing) e (Ann [] _ Nothing))) = isSimple e -- Function applications of simple terms are simple up to two arguments isSimple (Application (Application (Application _ _) _) _) = False isSimple (Application f a) = isSimple f && isSimple a diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index 301f95bc..e434bff7 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -390,11 +390,7 @@ rec { unexpected = lib.subtractLists valid given; in lib.throwIfNot (unexpected == [ ]) - "${msg}: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected) - } unexpected; valid ones: ${ - builtins.concatStringsSep ", " (builtins.map builtins.toString valid) - }"; + "${msg}: ${builtins.concatStringsSep ", " (builtins.map builtins.toString unexpected)} unexpected; valid ones: ${builtins.concatStringsSep ", " (builtins.map builtins.toString valid)}"; info = msg: builtins.trace "INFO: ${msg}"; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 79aeb15c..86726c87 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -922,10 +922,7 @@ in [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], ], - ${ - optionalString (showAppStoreSetting) - "'appstoreenabled' => ${renderedAppStoreSetting}," - } + ${optionalString (showAppStoreSetting) "'appstoreenabled' => ${renderedAppStoreSetting},"} 'datadirectory' => '${datadir}/data', 'skeletondirectory' => '${cfg.skeletonDirectory}', ${optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu',"} @@ -959,10 +956,7 @@ in optionalString (c.defaultPhoneRegion != null) "'default_phone_region' => '${c.defaultPhoneRegion}'," } - ${ - optionalString (nextcloudGreaterOrEqualThan "23") - "'profile.enabled' => ${boolToString cfg.globalProfiles}," - } + ${optionalString (nextcloudGreaterOrEqualThan "23") "'profile.enabled' => ${boolToString cfg.globalProfiles},"} ${objectstoreConfig} ]; @@ -1082,9 +1076,7 @@ in ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' # Try to enable apps - ${occ}/bin/nextcloud-occ app:enable ${ - concatStringsSep " " (attrNames cfg.extraApps) - } + ${occ}/bin/nextcloud-occ app:enable ${concatStringsSep " " (attrNames cfg.extraApps)} ''} ${occSetTrustedDomainsCmd} @@ -1093,9 +1085,7 @@ in serviceConfig.User = "nextcloud"; # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent # an automatic creation of the database user. - environment.NC_setup_create_db_user = - lib.mkIf (nextcloudGreaterOrEqualThan "26") - "false"; + environment.NC_setup_create_db_user = lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; }; nextcloud-cron = { after = [ "nextcloud-setup.service" ]; @@ -1157,9 +1147,7 @@ in } ]; initialScript = pkgs.writeText "mysql-init" '' - CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${ - builtins.readFile (cfg.config.dbpassFile) - }'; + CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index fea4751f..d0a9cd1f 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -255,12 +255,8 @@ buildStdenv.mkDerivation ({ hash = "sha256-+wNZhkDB3HSknPRD4N6cQXY7zMT/DzNXx29jQH0Gb1o="; }) ] - ++ - lib.optional (lib.versionOlder version "111") - ./env_var_for_system_dir-ff86.patch - ++ - lib.optional (lib.versionAtLeast version "111") - ./env_var_for_system_dir-ff111.patch + ++ lib.optional (lib.versionOlder version "111") ./env_var_for_system_dir-ff86.patch + ++ lib.optional (lib.versionAtLeast version "111") ./env_var_for_system_dir-ff111.patch ++ lib.optional (lib.versionAtLeast version "96") ./no-buildconfig-ffx96.patch ++ extraPatches; diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 1812b854..8b952610 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -539,15 +539,9 @@ let # This parameter is sometimes a string, sometimes null, and sometimes a list, yuck configureFlags = configureFlags - ++ - optional (elem "build" configurePlatforms) - "--build=${stdenv.buildPlatform.config}" - ++ - optional (elem "host" configurePlatforms) - "--host=${stdenv.hostPlatform.config}" - ++ - optional (elem "target" configurePlatforms) - "--target=${stdenv.targetPlatform.config}"; + ++ optional (elem "build" configurePlatforms) "--build=${stdenv.buildPlatform.config}" + ++ optional (elem "host" configurePlatforms) "--host=${stdenv.hostPlatform.config}" + ++ optional (elem "target" configurePlatforms) "--target=${stdenv.targetPlatform.config}"; cmakeFlags = cmakeFlags From a75658d892846bd235ed48ee10ca2754d1e0b906 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 4 Feb 2024 23:40:04 +0100 Subject: [PATCH 098/125] Strings: Don't normalize anymore Strings will not be treated as opaque and rendered exactly the way as in the input. --- src/Nixfmt/Parser.hs | 35 ++++---- src/Nixfmt/Pretty.hs | 134 ++++-------------------------- src/Nixfmt/Types.hs | 14 +++- src/Nixfmt/Util.hs | 35 +------- test/diff/idioms_lib_5/out.nix | 26 +++--- test/diff/idioms_nixos_2/out.nix | 8 +- test/diff/string/out.nix | 20 +++-- test/diff/string_interpol/out.nix | 4 +- 8 files changed, 76 insertions(+), 200 deletions(-) diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index ba323d19..c44424c9 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -33,7 +33,7 @@ import Nixfmt.Parser.Float (floatParse) import Nixfmt.Types (Ann, Binder(..), Expression(..), File, Fixity(..), Item(..), Items(..), Leaf, Operator(..), ParamAttr(..), Parameter(..), Parser, Path, Selector(..), - SimpleSelector(..), String, StringPart(..), Term(..), Token(..), Trivium(..), + SimpleSelector(..), StringPart(..), Term(..), Token(..), Trivium(..), operators, tokenText) import Nixfmt.Util (commonIndentation, identChar, isSpaces, manyP, manyText, pathChar, @@ -116,22 +116,22 @@ interpolation = Interpolation <$> simpleStringPart :: Parser StringPart simpleStringPart = TextPart <$> someText ( - chunk "\\n" $> "\n" <|> - chunk "\\r" $> "\r" <|> - chunk "\\t" $> "\t" <|> - chunk "\\" *> (Text.singleton <$> anySingle) <|> + chunk "\\n" <|> + chunk "\\r" <|> + chunk "\\t" <|> + ((<>) <$> chunk "\\" <*> (Text.singleton <$> anySingle)) <|> chunk "$$" <|> try (chunk "$" <* notFollowedBy (char '{')) <|> someP (\t -> t /= '"' && t /= '\\' && t /= '$')) indentedStringPart :: Parser StringPart indentedStringPart = TextPart <$> someText ( - chunk "''\\n" $> "\n" <|> - chunk "''\\r" $> "\r" <|> - chunk "''\\t" $> "\t" <|> + chunk "''\\n" <|> + chunk "''\\r" <|> + chunk "''\\t" <|> chunk "''\\" *> (Text.singleton <$> anySingle) <|> - chunk "''$" $> "$" <|> - chunk "'''" $> "''" <|> + chunk "''$" <|> + chunk "'''" <|> chunk "$$" <|> try (chunk "$" <* notFollowedBy (char '{')) <|> try (chunk "'" <* notFollowedBy (char '\'')) <|> @@ -216,10 +216,6 @@ indentedString :: Parser [[StringPart]] indentedString = rawSymbol TDoubleSingleQuote *> fmap fixIndentedString (sepBy indentedLine (chunk "\n")) <* rawSymbol TDoubleSingleQuote - -string :: Parser String -string = lexeme $ simpleString <|> indentedString <|> uri - -- TERMS parens :: Parser Term @@ -239,9 +235,14 @@ selectorPath = (pure <$> selector Nothing) <> many (selector $ Just $ symbol TDot) simpleTerm :: Parser Term -simpleTerm = (String <$> string) <|> (Path <$> path) <|> - (Token <$> (envPath <|> float <|> integer <|> identifier)) <|> - parens <|> set <|> list +simpleTerm = + (SimpleString <$> (lexeme $ simpleString <|> uri)) + <|> (IndentedString <$> lexeme indentedString) + <|> (Path <$> path) + <|> (Token <$> (envPath <|> float <|> integer <|> identifier)) + <|> parens + <|> set + <|> list term :: Parser Term term = label "term" $ do diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 628298f4..9017d0d7 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -12,9 +12,8 @@ import Prelude hiding (String) import Data.Char (isSpace) import Data.Maybe (fromMaybe, isJust, fromJust, maybeToList) -import Data.Text (Text, isPrefixOf, isSuffixOf, stripPrefix) -import qualified Data.Text as Text - (dropEnd, empty, init, isInfixOf, last, null, strip, takeWhile) +import Data.Text (Text, isPrefixOf, stripPrefix) +import qualified Data.Text as Text (null, takeWhile) -- import Debug.Trace (traceShowId) import Nixfmt.Predoc @@ -26,7 +25,6 @@ import Nixfmt.Types ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), Token(..), TrailingComment(..), Trivium(..), Whole(..), tokenText, mapFirstToken, mapFirstToken', mapLastToken') -import Nixfmt.Util (commonIndentation, isSpaces, replaceMultiple) prettyCommentLine :: Text -> Doc prettyCommentLine l @@ -145,7 +143,8 @@ prettyTermWide t = prettyTerm t -- | Pretty print a term without wrapping it in a group. prettyTerm :: Term -> Doc prettyTerm (Token t) = pretty t -prettyTerm (String s) = pretty s +prettyTerm (SimpleString (Ann leading s trailing')) = pretty leading <> prettySimpleString s <> pretty trailing' +prettyTerm (IndentedString (Ann leading s trailing')) = pretty leading <> prettyIndentedString s <> pretty trailing' prettyTerm (Path p) = pretty p -- Selection (`foo.bar.baz`) case distinction on the first element (`foo`): -- If it is an ident, keep it all together @@ -372,8 +371,8 @@ isAbsorbableExpr expr = case expr of _ -> False isAbsorbable :: Term -> Bool -isAbsorbable (String (Ann _ parts@(_:_:_) _)) - = not $ isSimpleString parts +-- Multi-line indented string +isAbsorbable (IndentedString (Ann _ (_:_:_) _)) = True isAbsorbable (Path _) = True -- Non-empty sets and lists isAbsorbable (Set _ _ (Items (_:_)) _) = True @@ -407,7 +406,8 @@ absorbRHS expr = case expr of <> pretty close -- Not all strings are absorbable, but in this case we always want to keep them attached. -- Because there's nothing to gain from having them start on a new line. - (Term (String _)) -> hardspace <> group expr + (Term (SimpleString _)) -> hardspace <> group expr + (Term (IndentedString _)) -> hardspace <> group expr -- Same for path (Term (Path _)) -> hardspace <> group expr -- Non-absorbable term @@ -571,14 +571,14 @@ instance Pretty a => Pretty (Whole a) where instance Pretty Token where pretty = text . tokenText --- STRINGS isSimpleSelector :: Selector -> Bool isSimpleSelector (Selector _ (IDSelector _) Nothing) = True isSimpleSelector _ = False isSimple :: Expression -> Bool -isSimple (Term (String (Ann [] _ Nothing))) = True +isSimple (Term (SimpleString (Ann [] _ Nothing))) = True +isSimple (Term (IndentedString (Ann [] _ Nothing))) = True isSimple (Term (Path (Ann [] _ Nothing))) = True isSimple (Term (Token (Ann [] (Identifier _) Nothing))) = True isSimple (Term (Selection t selectors)) @@ -589,62 +589,7 @@ isSimple (Application (Application (Application _ _) _) _) = False isSimple (Application f a) = isSimple f && isSimple a isSimple _ = False -hasQuotes :: [StringPart] -> Bool -hasQuotes [] = False -hasQuotes (TextPart x : xs) = Text.isInfixOf "\"" x || hasQuotes xs -hasQuotes (_ : xs) = hasQuotes xs - -hasDualQuotes :: [StringPart] -> Bool -hasDualQuotes [] = False -hasDualQuotes (TextPart x : xs) = Text.isInfixOf "''" x || hasDualQuotes xs -hasDualQuotes (_ : xs) = hasDualQuotes xs - -endsInSingleQuote :: [StringPart] -> Bool -endsInSingleQuote [] = False -endsInSingleQuote xs = - case last xs of - (TextPart x) -> x /= Text.empty && Text.last x == '\'' - _ -> False - -isIndented :: [[StringPart]] -> Bool -isIndented parts = - case commonIndentation inits of - Just "" -> False - _ -> True - where textInit (TextPart t : xs) = t <> textInit xs - textInit _ = "" - nonEmpty (TextPart "" : xs) = nonEmpty xs - nonEmpty [] = False - nonEmpty _ = True - inits = map textInit $ filter nonEmpty parts - --- | If the last line has at least one space but nothing else, it cannot be --- cleanly represented in an indented string. -lastLineIsSpaces :: [[StringPart]] -> Bool -lastLineIsSpaces [] = False -lastLineIsSpaces xs = case last xs of - [TextPart t] -> isSpaces t - _ -> False - -isInvisibleLine :: [StringPart] -> Bool -isInvisibleLine [] = True -isInvisibleLine [TextPart t] = Text.null $ Text.strip t -isInvisibleLine _ = False - -isSimpleString :: [[StringPart]] -> Bool -isSimpleString [parts] - | hasDualQuotes parts = True - | endsInSingleQuote parts = True - | isIndented [parts] = True - | hasQuotes parts = False - | otherwise = True - -isSimpleString parts - | all isInvisibleLine parts = True - | endsInSingleQuote (last parts) = True - | isIndented parts = True - | lastLineIsSpaces parts = True - | otherwise = False +-- STRINGS instance Pretty StringPart where pretty (TextPart t) = text t @@ -689,43 +634,13 @@ instance Pretty [StringPart] where pretty parts = base $ hcat parts -instance Pretty [[StringPart]] where - pretty parts - | isSimpleString parts = prettySimpleString parts - | otherwise = prettyIndentedString parts - -type UnescapeInterpol = Text -> Text -type EscapeText = Text -> Text - -prettyLine :: EscapeText -> UnescapeInterpol -> [StringPart] -> Doc -prettyLine escapeText unescapeInterpol - = pretty . unescapeInterpols . map escape - where escape (TextPart t) = TextPart (escapeText t) - escape x = x - - unescapeInterpols [] = [] - unescapeInterpols (TextPart t : TextPart u : xs) - = unescapeInterpols (TextPart (t <> u) : xs) - unescapeInterpols (TextPart t : xs@(Interpolation{} : _)) - = TextPart (unescapeInterpol t) : unescapeInterpols xs - unescapeInterpols (x : xs) = x : unescapeInterpols xs - prettySimpleString :: [[StringPart]] -> Doc prettySimpleString parts = group $ text "\"" - <> sepBy (text "\\n") (map (prettyLine escape unescapeInterpol) parts) + -- Use literal \n here instead of `newline`, as the latter + -- would cause multiline-string-style indentation which we do not want + <> sepBy (text "\n") (map pretty parts) <> text "\"" - where escape = replaceMultiple - [ ("$\\${", "$${") - , ("${", "\\${") - , ("\"", "\\\"") - , ("\r", "\\r") - , ("\\", "\\\\") - ] - - unescapeInterpol t - | "$" `isSuffixOf` t = Text.init t <> "\\$" - | otherwise = t prettyIndentedString :: [[StringPart]] -> Doc prettyIndentedString parts = group $ base $ @@ -734,24 +649,5 @@ prettyIndentedString parts = group $ base $ -- 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 2 $ sepBy newline $ map (prettyLine escape unescapeInterpol) parts) + <> (nest 2 $ sepBy newline $ map pretty parts) <> text "''" - where escape = replaceMultiple - [ ("'${", "''\\'''${") - , ("${", "''${") - , ("''", "'''") - ] - - unescapeInterpol t - | Text.null t = t - | Text.last t /= '$' = t - | trailingQuotes (Text.init t) `mod` 3 == 0 - = Text.init t <> "''$" - | trailingQuotes (Text.init t) `mod` 3 == 1 - = Text.dropEnd 2 t <> "''\\'''$" - | otherwise - = error "should never happen after escape" - - trailingQuotes t - | "'" `isSuffixOf` t = 1 + trailingQuotes (Text.init t) - | otherwise = 0 :: Int diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 03e75d3d..4a3cb3a1 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -71,6 +71,9 @@ data StringPart type Path = Ann [StringPart] +-- A string consists of lines, each of which consists of text elements and interpolations. +-- The string's text does describe the raw input text value, and not the actual text it represents +-- within Nix semantics. type String = Ann [[StringPart]] data SimpleSelector @@ -91,7 +94,10 @@ data Binder data Term = Token Leaf - | String String + -- " String + | SimpleString String + -- '' String + | IndentedString String | Path Path | List Leaf (Items Term) Leaf | Set (Maybe Leaf) Leaf (Items Binder) Leaf @@ -212,7 +218,8 @@ instance LanguageElement Parameter where instance LanguageElement Term where mapFirstToken' f = \case (Token leaf) -> first Token (f leaf) - (String string) -> first String (f string) + (SimpleString string) -> first SimpleString (f string) + (IndentedString string) -> first IndentedString (f string) (Path path) -> first Path (f path) (List open items close) -> first (\open' -> List open' items close) (f open) (Set (Just rec) open items close) -> first (\rec' -> Set (Just rec') open items close) (f rec) @@ -222,7 +229,8 @@ instance LanguageElement Term where mapLastToken' f = \case (Token leaf) -> first Token (f leaf) - (String string) -> first String (f string) + (SimpleString string) -> first SimpleString (f string) + (IndentedString string) -> first IndentedString (f string) (Path path) -> first Path (f path) (List open items close) -> first (List open items) (f close) (Set rec open items close) -> first (Set rec open items) (f close) diff --git a/src/Nixfmt/Util.hs b/src/Nixfmt/Util.hs index 4590ff62..0fab01a4 100644 --- a/src/Nixfmt/Util.hs +++ b/src/Nixfmt/Util.hs @@ -11,24 +11,17 @@ module Nixfmt.Util , someP , manyText , someText - , commonPrefix , commonIndentation - , dropCommonIndentation , identChar , isSpaces , pathChar - , replaceMultiple , schemeChar , uriChar ) where -import Control.Applicative ((<|>)) import Data.Char (isAlpha, isDigit, isSpace) -import Data.Foldable (asum) -import Data.List (unfoldr) -import Data.Maybe (fromMaybe) import Data.Text as Text - (Text, all, commonPrefixes, concat, empty, null, splitAt, stripEnd, stripPrefix, takeWhile) + (Text, all, commonPrefixes, concat, empty, takeWhile) import Text.Megaparsec (MonadParsec, Token, Tokens, many, some, takeWhile1P, takeWhileP) @@ -77,31 +70,5 @@ commonIndentation [] = Nothing commonIndentation [x] = Just $ Text.takeWhile isSpace x commonIndentation (x:y:xs) = commonIndentation (commonPrefix x y : xs) --- | Strip the longest common indentation from a list of lines. Empty lines do --- not count towards the common indentation. -dropCommonIndentation :: [Text] -> [Text] -dropCommonIndentation unstrippedLines = - let strippedLines = map stripEnd unstrippedLines - in case commonIndentation (filter (/=empty) strippedLines) of - Nothing -> map (const empty) strippedLines - Just indentation -> map (fromMaybe empty . stripPrefix indentation) strippedLines - isSpaces :: Text -> Bool isSpaces = Text.all (==' ') - --- | Apply multiple independent replacements. This function passes over the text --- once and applies the first replacement it can find at each position. After a --- replacement is matched, the function continues after the replacement, not --- inside it. -replaceMultiple :: [(Text, Text)] -> Text -> Text -replaceMultiple replacements = mconcat . unfoldr replaceAny - where - -- | replaceAny assumes input is nonempty - replaceAny :: Text -> Maybe (Text, Text) - replaceAny t - | Text.null t = Nothing - | otherwise = asum (map (replaceStart t) replacements) - <|> Just (Text.splitAt 1 t) - - replaceStart :: Text -> (Text, Text) -> Maybe (Text, Text) - replaceStart t (pat, rep) = (rep,) <$> Text.stripPrefix pat t diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 001fa955..216b237c 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -178,7 +178,11 @@ let ''; # flakeNote will be printed in the remediation messages below. - flakeNote = "\n Note: For `nix shell`, `nix build`, `nix develop` or any other Nix 2.4+\n (Flake) command, `--impure` must be passed in order to read this\n environment variable.\n "; + flakeNote = " + Note: For `nix shell`, `nix build`, `nix develop` or any other Nix 2.4+ + (Flake) command, `--impure` must be passed in order to read this + environment variable. + "; remediate_allowlist = allow_attr: rebuild_amendment: attrs: '' a) To temporarily allow ${remediation_phrase allow_attr}, you can use an environment variable @@ -290,9 +294,7 @@ let "Warning while evaluating ${getName attrs}: «${reason}»: ${errormsg}" else "Package ${getName attrs} in ${pos_str meta} ${errormsg}, continuing anyway." - + (lib.optionalString (remediationMsg != "") '' - - ${remediationMsg}''); + + (lib.optionalString (remediationMsg != "") "\n${remediationMsg}"); isEnabled = lib.findFirst (x: x == reason) null showWarnings; in if isEnabled != null then builtins.trace msg true else true; @@ -381,13 +383,11 @@ let if typeCheck metaTypes.${k} v then null else - '' - key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got - ${lib.generators.toPretty { indent = " "; } v}'' + "key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got\n ${lib.generators.toPretty { indent = " "; } v}" else - '' - key 'meta.${k}' is unrecognized; expected one of: - [${lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes)}]''; + "key 'meta.${k}' is unrecognized; expected one of: \n [${ + lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes) + }]"; checkMeta = meta: lib.optionals config.checkMeta ( @@ -424,9 +424,9 @@ let { valid = "no"; reason = "unknown-meta"; - errormsg = '' - has an invalid meta attrset:${lib.concatMapStrings (x: "\n - " + x) res} - ''; + errormsg = "has an invalid meta attrset:${ + lib.concatMapStrings (x: "\n - " + x) res + }\n"; unfree = false; nonSource = false; broken = false; diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 86726c87..6d0a69ef 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -131,7 +131,7 @@ in enableBrokenCiphersForSSE = mkOption { type = types.bool; default = versionOlder stateVersion "22.11"; - defaultText = literalExpression ''versionOlder system.stateVersion "22.11"''; + defaultText = literalExpression "versionOlder system.stateVersion \"22.11\""; description = lib.mdDoc '' This option enables using the OpenSSL PHP extension linked against OpenSSL 1.1 rather than latest OpenSSL (≥ 3), this is not recommended unless you need @@ -825,7 +825,7 @@ in assertions = [ { assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; - message = "services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true."; + message = ''services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true.''; } ]; } @@ -996,9 +996,9 @@ in if c.dbport != null then "--database-port" else null } = ''"${toString c.dbport}"''; ${if c.dbuser != null then "--database-user" else null} = ''"${c.dbuser}"''; - "--database-pass" = ''"''$${dbpass.arg}"''; + "--database-pass" = "\"\$${dbpass.arg}\""; "--admin-user" = ''"${c.adminuser}"''; - "--admin-pass" = ''"''$${adminpass.arg}"''; + "--admin-pass" = "\"\$${adminpass.arg}\""; "--data-dir" = ''"${datadir}/data"''; } ); diff --git a/test/diff/string/out.nix b/test/diff/string/out.nix index ba505a96..f5d1ebca 100644 --- a/test/diff/string/out.nix +++ b/test/diff/string/out.nix @@ -5,15 +5,19 @@ '' "" ### - "\n " + " + " ### - "a\n ${x}\n b\n " + "a + ${x} + b + " ### - "" + '''' ### - "a" + ''a'' ### - "${""}" + ''${""}'' ### '' ${""} @@ -47,7 +51,7 @@ e '' ### - "" + '''' ### '' declare -a makefiles=(./*.mak) @@ -62,7 +66,7 @@ [${mkSectionName sectName}] '' ### - "-couch_ini ${cfg.package}/etc/default.ini ${configFile} ${pkgs.writeText "couchdb-extra.ini" cfg.extraConfig} ${cfg.configFile}" + ''-couch_ini ${cfg.package}/etc/default.ini ${configFile} ${pkgs.writeText "couchdb-extra.ini" cfg.extraConfig} ${cfg.configFile}'' ### ''exec i3-input -F "mark %s" -l 1 -P 'Mark: ' '' ### @@ -70,7 +74,7 @@ ### ''"${pkgs.name or ""}";'' ### - "${pkgs.replace-secret}/bin/replace-secret '${placeholder}' '${secretFile}' '${targetFile}' " + ''${pkgs.replace-secret}/bin/replace-secret '${placeholder}' '${secretFile}' '${targetFile}' '' ### '' mkdir -p "$out/lib/modules/${kernel.modDirVersion}/kernel/net/wireless/" diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index 27605563..0b3a7a91 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -27,7 +27,7 @@ map ( e: - ''iifname "${cfg.upstreamIface}" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' + "iifname \"${cfg.upstreamIface}\" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" ) tcpPortMap ) @@ -38,7 +38,7 @@ map ( e: - ''ifname "${cfg.upstreamIface}" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}'' + "ifname \"${cfg.upstreamIface}\" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" ) udpPortMap ) From 543b65f785179c1ca274f4a5f3ebd561d5cd1384 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 5 Feb 2024 00:36:44 +0100 Subject: [PATCH 099/125] WIP: Automatically minimize verification failures --- src/Nixfmt.hs | 40 ++++++++++++++++++----- src/Nixfmt/Predoc.hs | 2 -- src/Nixfmt/Types.hs | 75 ++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 105 insertions(+), 12 deletions(-) diff --git a/src/Nixfmt.hs b/src/Nixfmt.hs index 3c2619d3..0d17be1f 100644 --- a/src/Nixfmt.hs +++ b/src/Nixfmt.hs @@ -11,7 +11,7 @@ module Nixfmt , formatVerify ) where -import Data.Function ((&)) +import Data.Either (fromRight) import Data.Bifunctor (bimap, first) import Data.Text (Text, unpack) import qualified Text.Megaparsec as Megaparsec (parse) @@ -20,7 +20,9 @@ import Text.Megaparsec.Error (errorBundlePretty) import Nixfmt.Parser (file) import Nixfmt.Predoc (layout) import Nixfmt.Pretty () -import Nixfmt.Types (ParseErrorBundle) +import Nixfmt.Types (ParseErrorBundle, Whole(..), Expression, walkSubprograms) + +-- import Debug.Trace (traceShow, traceShowId) type Width = Int @@ -32,20 +34,44 @@ format width filename = bimap errorBundlePretty (layout width) . Megaparsec.parse file filename +-- Same functionality as `format`, but add sanity checks to guarantee the following properties of the formatter: +-- - Correctness: The formatted output parses, and the parse tree is identical to the input's +-- - Idempotency: Formatting the output again will not modify it +-- +-- If any issues are found, the operation will fail and print an error message. It will contain a diff showcasing +-- the issue on an automatically minimized example based on the input. formatVerify :: Width -> FilePath -> Text -> Either String Text formatVerify width path unformatted = do - unformattedParsed <- parse unformatted + 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) let formattedTwice = layout width formattedOnceParsed if formattedOnceParsed /= unformattedParsed - then Left $ pleaseReport "Parses differently after formatting." & - \x -> (x <> "\n\nBefore formatting:\n" <> (show unformattedParsed) <> "\n\nAfter formatting:\n" <> (show formattedOnceParsed)) + then Left $ + let + 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)) else if formattedOnce /= formattedTwice - then Left $ pleaseReport "Nixfmt is not idempotent." & - \x -> (x <> "\n\nAfter one formatting:\n" <> unpack formattedOnce <> "\n\nAfter two:\n" <> unpack formattedTwice) + then Left $ + let + minimized = minimize unformattedParsed' + (\e -> layout width e == layout width (fromRight (error "TODO") $ parse $ layout width e)) + in + pleaseReport "Nixfmt is not idempotent." + <> "\n\nAfter one formatting:\n" <> unpack (layout width minimized) + <> "\n\nAfter two:\n" <> unpack (layout width (fromRight (error "TODO") $ parse $ layout width minimized)) else Right formattedOnce where parse = first errorBundlePretty . Megaparsec.parse file path pleaseReport x = path <> ": " <> x <> " This is a bug in nixfmt. Please report it at https://github.com/serokell/nixfmt" + + +minimize :: Expression -> (Expression -> Bool) -> Expression +minimize expr test = + case concatMap (\e -> case test e of { False -> [minimize e test]; True -> [] }) $ walkSubprograms expr of + result:_ -> result + [] -> expr diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index e2bd6746..8dcdf991 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -6,8 +6,6 @@ {-# LANGUAGE FlexibleInstances, OverloadedStrings #-} --- | This module implements a layer around the prettyprinter package, making it --- easier to use. module Nixfmt.Predoc ( text , comment diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 4a3cb3a1..4a0347f2 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -4,12 +4,13 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase, TupleSections #-} +{-# LANGUAGE DeriveFoldable, OverloadedStrings, RankNTypes, LambdaCase, TupleSections, FlexibleInstances #-} module Nixfmt.Types where import Prelude hiding (String) +import Data.Maybe (maybeToList) import Data.List.NonEmpty as NonEmpty import Control.Monad.State (StateT) import Data.Bifunctor (first) @@ -57,11 +58,13 @@ data Item a deriving (Foldable, Show) newtype Items a = Items { unItems :: [Item a] } - deriving (Show) instance Eq a => Eq (Items a) where (==) = (==) `on` concatMap Data.Foldable.toList . unItems +instance Show a => Show (Items a) where + show = show . concatMap Data.Foldable.toList . unItems + type Leaf = Ann Token data StringPart @@ -183,9 +186,14 @@ class LanguageElement a where -- returned. This is useful for getting/extracting values mapLastToken' :: (forall b. Ann b -> (Ann b, c)) -> a -> (a, c) + -- Walk all syntactically valid sub-expressions in a breadth-first search way. This allows + -- minimizing failing test cases + walkSubprograms :: a -> [Expression] + instance LanguageElement (Ann a) where mapFirstToken' f = f mapLastToken' f = f + walkSubprograms = error "unreachable" instance LanguageElement SimpleSelector where mapFirstToken' f = \case @@ -195,6 +203,11 @@ instance LanguageElement SimpleSelector where mapLastToken' = mapFirstToken' + walkSubprograms = \case + (IDSelector name) -> [Term (Token name)] + (InterpolSelector (Ann _ str _)) -> pure $ Term $ SimpleString $ Ann [] [[str]] Nothing + (StringSelector str) -> [Term (SimpleString str)] + instance LanguageElement Selector where mapFirstToken' f = \case (Selector Nothing ident def) -> first (\ident' -> Selector Nothing ident' def) $ mapFirstToken' f ident @@ -204,6 +217,19 @@ instance LanguageElement Selector where (Selector dot ident Nothing) -> first (\ident' -> Selector dot ident' Nothing) $ mapLastToken' f ident (Selector dot ident (Just (qmark, def))) -> first (Selector dot ident . Just . (qmark,)) $ mapLastToken' f def + walkSubprograms = \case + (Selector _ ident Nothing) -> walkSubprograms ident + (Selector _ ident (Just (_, def))) -> (Term def) : walkSubprograms ident + +instance LanguageElement ParamAttr where + mapFirstToken' _ _ = error "unreachable" + mapLastToken' _ _ = error "unreachable" + + walkSubprograms = \case + (ParamAttr name Nothing _) -> [Term (Token name)] + (ParamAttr name (Just (_, def)) _) -> [Term (Token name), def] + (ParamEllipsis _) -> [] + instance LanguageElement Parameter where mapFirstToken' f = \case (IDParameter name) -> first IDParameter (f name) @@ -215,6 +241,11 @@ instance LanguageElement Parameter where (SetParameter open items close) -> first (SetParameter open items) (f close) (ContextParameter first' at second) -> first (ContextParameter first' at) (mapLastToken' f second) + walkSubprograms = \case + (IDParameter ident) -> [(Term $ Token ident)] + (SetParameter _ bindings _) -> bindings >>= walkSubprograms + (ContextParameter left _ right) -> walkSubprograms left ++ walkSubprograms right + instance LanguageElement Term where mapFirstToken' f = \case (Token leaf) -> first Token (f leaf) @@ -238,6 +269,23 @@ instance LanguageElement Term where (Selection term sels) -> first (Selection term . NonEmpty.toList) (mapLastToken' f $ NonEmpty.fromList sels) (Parenthesized open expr close) -> first (Parenthesized open expr) (f close) + walkSubprograms = \case + (List _ items _) -> unItems items >>= \case + CommentedItem _ item -> [Term item] + DetachedComments _ -> [] + (Set _ _ items _) | Prelude.length (unItems items) == 1 -> case Prelude.head (unItems items) of + (CommentedItem _ (Inherit _ from sels _)) -> (Term <$> maybeToList from) ++ concatMap walkSubprograms sels + (CommentedItem _ (Assignment sels _ expr _)) -> expr : concatMap walkSubprograms sels + (DetachedComments _) -> [] + (Set _ _ items _) -> unItems items >>= \case + -- Map each binding to a singleton set + (CommentedItem _ item) -> [ Term (Set Nothing (Ann [] TBraceOpen Nothing) (Items [(CommentedItem [] item)]) (Ann [] TBraceClose Nothing)) ] + (DetachedComments _) -> [] + (Selection term sels) -> Term term : (sels >>= walkSubprograms) + (Parenthesized _ expr _) -> [expr] + -- The others are already minimal + _ -> [] + instance LanguageElement Expression where mapFirstToken' f = \case (Term term) -> first Term (mapFirstToken' f term) @@ -266,19 +314,40 @@ instance LanguageElement Expression where (Negation not_ expr) -> first (Negation not_) (mapLastToken' f expr) (Inversion tilde expr) -> first (Inversion tilde) (mapLastToken' f expr) -instance LanguageElement a => LanguageElement (Whole a) where + walkSubprograms = \case + (Term term) -> walkSubprograms term + (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 Nothing) (Items [(CommentedItem [] item)]) (Ann [] TBraceClose Nothing)) ] + (DetachedComments _) -> [] + ) + (Assert _ cond _ body) -> [cond, body] + (If _ expr0 _ expr1 _ expr2) -> [expr0, expr1, expr2] + (Abstraction param _ body) -> [(Abstraction param (Ann [] TColon Nothing) (Term (Token (Ann [] (Identifier "_") Nothing)))), body] + (Application g a) -> [g, a] + (Operation left _ right) -> [left, right] + (MemberCheck name _ sels) -> name : (sels >>= walkSubprograms) + (Negation _ expr) -> [expr] + (Inversion _ expr) -> [expr] + +instance LanguageElement (Whole Expression) where mapFirstToken' f (Whole a trivia) = first (\a' -> Whole a' trivia) (mapFirstToken' f a) mapLastToken' f (Whole a trivia) = first (\a' -> Whole a' trivia) (mapLastToken' f a) + walkSubprograms (Whole a _) = [a] + instance LanguageElement a => LanguageElement (NonEmpty a) where mapFirstToken' f (x :| _) = first pure $ mapFirstToken' f x mapLastToken' f (x :| []) = first pure $ mapLastToken' f x mapLastToken' f (x :| xs) = first ((x :|) . NonEmpty.toList) $ mapLastToken' f (NonEmpty.fromList xs) + walkSubprograms = error "unreachable" + data Token = Integer Int | Float Double From 5ab94306d6e9b6eb6cc06de732cfac230c0235e6 Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 23 Sep 2023 11:37:25 +0200 Subject: [PATCH 100/125] Relax dependency version bounds Closes #130 --- nixfmt.cabal | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/nixfmt.cabal b/nixfmt.cabal index 44a653e1..d782d3ae 100644 --- a/nixfmt.cabal +++ b/nixfmt.cabal @@ -41,11 +41,11 @@ executable nixfmt else buildable: True build-depends: - base >= 4.12.0 && < 4.17 + base >= 4.12.0 && < 4.19 , cmdargs >= 0.10.20 && < 0.11 , nixfmt - , unix >= 2.7.2 && < 2.8 - , text >= 1.2.3 && < 1.3 + , unix >= 2.7.2 && < 2.9 + , text >= 1.2.3 && < 2.2 -- for System.IO.Atomic , directory >= 1.3.3 && < 1.4 @@ -86,12 +86,12 @@ library hs-source-dirs: src build-depends: - base >= 4.12.0 && < 4.17 - , megaparsec >= 9.0.1 && < 9.3 + base >= 4.12.0 && < 4.19 + , megaparsec >= 9.0.1 && < 9.6 , mtl , parser-combinators >= 1.0.3 && < 1.4 , scientific >= 0.3.0 && < 0.4.0 - , text >= 1.2.3 && < 1.3 + , text >= 1.2.3 && < 2.2 , transformers default-language: Haskell2010 ghc-options: @@ -115,7 +115,7 @@ executable js-interface -Wredundant-constraints -Wno-orphans build-depends: - base >= 4.12.0 && < 4.17 + base >= 4.12.0 && < 4.19 , ghcjs-base >= 0.2.0 && < 0.3 , nixfmt hs-source-dirs: js/ From 887a40d3aed1ab4c667075866e2f268fbf5ff00d Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 2 Oct 2023 12:04:46 +0200 Subject: [PATCH 101/125] Update Nix dependencies --- flake.lock | 44 +++++++++++++++++++++++++++++++------------- flake.nix | 2 +- 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/flake.lock b/flake.lock index e2025e57..fb987758 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "flake-compat": { "flake": false, "locked": { - "lastModified": 1650374568, - "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=", + "lastModified": 1673956053, + "narHash": "sha256-4gtG9iQuiKITOjNQQeQIpoIB6b16fm+504Ch3sNKLd8=", "owner": "edolstra", "repo": "flake-compat", - "rev": "b4a34015c698c7793d592d66adbab377907a2be8", + "rev": "35bb57c0c8d8b62bbfd284272c928ceb64ddbde9", "type": "github" }, "original": { @@ -17,12 +17,15 @@ } }, "flake-utils": { + "inputs": { + "systems": "systems" + }, "locked": { - "lastModified": 1667395993, - "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "lastModified": 1694529238, + "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", "owner": "numtide", "repo": "flake-utils", - "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", "type": "github" }, "original": { @@ -33,11 +36,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1667292599, - "narHash": "sha256-7ISOUI1aj6UKMPIL+wwthENL22L3+A9V+jS8Is3QsRo=", + "lastModified": 1696165369, + "narHash": "sha256-pd1cjFHCoEf9q5f9B0HhlOwwpBI9RP3HbUE6xjI7wAI=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "ef2f213d9659a274985778bff4ca322f3ef3ac68", + "rev": "d7186d62bb68fac3c90f1d95515e613ef299e992", "type": "github" }, "original": { @@ -49,16 +52,16 @@ }, "nixpkgs-stable": { "locked": { - "lastModified": 1672580127, - "narHash": "sha256-3lW3xZslREhJogoOkjeZtlBtvFMyxHku7I/9IVehhT8=", + "lastModified": 1696039360, + "narHash": "sha256-g7nIUV4uq1TOVeVIDEZLb005suTWCUjSY0zYOlSBsyE=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "0874168639713f547c05947c76124f78441ea46c", + "rev": "32dcb45f66c0487e92db8303a798ebc548cadedc", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-22.05", + "ref": "nixos-23.05", "repo": "nixpkgs", "type": "github" } @@ -70,6 +73,21 @@ "nixpkgs": "nixpkgs", "nixpkgs-stable": "nixpkgs-stable" } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } } }, "root": "root", diff --git a/flake.nix b/flake.nix index 83661b57..df949aaf 100644 --- a/flake.nix +++ b/flake.nix @@ -8,7 +8,7 @@ inputs = { nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; - nixpkgs-stable.url = "github:NixOS/nixpkgs/nixos-22.05"; + nixpkgs-stable.url = "github:NixOS/nixpkgs/nixos-23.05"; flake-utils.url = "github:numtide/flake-utils"; From 6cfbc2cdda9cff868ce21d3bef0cb5a3ba89ecea Mon Sep 17 00:00:00 2001 From: Silvan Mosberger Date: Tue, 31 Oct 2023 22:07:12 +0100 Subject: [PATCH 102/125] Fix TypeOperators warning --- src/Nixfmt/Parser/Float.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Nixfmt/Parser/Float.hs b/src/Nixfmt/Parser/Float.hs index c5360b55..660ac839 100644 --- a/src/Nixfmt/Parser/Float.hs +++ b/src/Nixfmt/Parser/Float.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE TypeFamilies, TypeApplications, ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies, TypeApplications, ScopedTypeVariables, TypeOperators #-} module Nixfmt.Parser.Float (floatParse) where From bbe0ba5564cf80c857e338afc4423b4c895dddd9 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 6 Feb 2024 01:11:21 +0100 Subject: [PATCH 103/125] Improve multiline asserts We now render them the same way as functions --- src/Nixfmt/Pretty.hs | 13 +++++-- test/diff/assert/in.nix | 44 ++++++++++++++++++++++ test/diff/assert/out.nix | 67 +++++++++++++++++++++++++++++---- test/diff/idioms_lib_5/out.nix | 4 +- test/diff/idioms_pkgs_3/out.nix | 3 +- test/diff/idioms_pkgs_5/out.nix | 6 ++- 6 files changed, 122 insertions(+), 15 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 9017d0d7..b25772b8 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -480,9 +480,16 @@ instance Pretty Expression where <> pretty expr pretty (Assert assert cond semicolon expr) - = base (pretty assert <> hardspace - <> nest 2 (group cond) <> pretty semicolon) - <> hardline <> pretty expr + = group $ + -- Render the assert as if it is was just a function (literally) + uncurry (prettyApp False mempty False) (insertIntoApp (Term $ Token assert) cond) + <> pretty semicolon <> hardline <> pretty expr + 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 other = (insert, other) pretty expr@(If _ _ _ _ _ _) = base $ group' False $ prettyIf line expr diff --git a/test/diff/assert/in.nix b/test/diff/assert/in.nix index 6be19f68..918d9d3e 100644 --- a/test/diff/assert/in.nix +++ b/test/diff/assert/in.nix @@ -10,4 +10,48 @@ ( assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) ( assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) + ( + assert let + int = a: if a then 1 else 0; + xor = a: b: ((builtins.bitXor (int a) (int b)) == 1); + in + lib.assertMsg (xor (gitRelease != null) (officialRelease != null)) ( + "must specify `gitRelease` or `officialRelease`" + + (lib.optionalString (gitRelease != null) " — not both") + ); + assert if true then 1 else 0; + assert if true then /* multiline */ 1 else 0; + assert + with lib.strings; + (versionAtLeast stdenv.cc.version "7.1" && versionOlder stdenv.cc.version "13"); + assert ( + stringLength (drvName (toString oldDependency)) == stringLength (drvName (toString newDependency)) + ); + assert ( + lib.assertMsg (!enableGoldPlugin) + "Gold plugin cannot be enabled on LLVM16 due to a upstream issue: https://github.com/llvm/llvm-project/issues/61350" + ); + assert + lib.assertMsg (!enableGoldPlugin) + "Gold plugin cannot be enabled on LLVM16 due to a upstream issue: https://github.com/llvm/llvm-project/issues/61350" + ; + assert ( + builtins.length eriAm == eriDeriv + 1 + && builtins.foldl' (a: b: a && b) true (builtins.map (a: a <= maxAm && a >= 0) eriAm) + ); + assert assertMsg (originalValid -> absConcatOrig == absConcatNormalised) + "For valid subpath \"${str}\", appending to an absolute Nix path value gives \"${absConcatOrig}\", but appending the normalised result \"${tryOnce.value}\" gives a different value \"${absConcatNormalised}\""; + assert lib.assertMsg (strw <= width) + "fixedWidthString: requested string length (${toString width}) must not be shorter than actual length (${toString strw})"; + assert lib.foldl (pass: { assertion, message }: if assertion final then pass else throw message) + true + (final.parsed.abi.assertions or [ ]); + assert + getErrors { + nixpkgs.localSystem = pkgs.stdenv.hostPlatform; + nixpkgs.hostPlatform = pkgs.stdenv.hostPlatform; + nixpkgs.pkgs = pkgs; + } == [ ]; + [] + ) ] diff --git a/test/diff/assert/out.nix b/test/diff/assert/out.nix index b57ec7a6..a17f7d32 100644 --- a/test/diff/assert/out.nix +++ b/test/diff/assert/out.nix @@ -18,24 +18,24 @@ e ) ( - assert # a - b; + # a + assert b; e ) ( - assert # a - b; # d + # a + assert b; # d e ) ( - assert # a - b # c + # a + assert b # c ; e ) ( - assert # a - b # c + # a + assert b # c ; # d e ) @@ -47,4 +47,55 @@ assert b; cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ) + ( + assert + let + int = a: if a then 1 else 0; + xor = a: b: ((builtins.bitXor (int a) (int b)) == 1); + in + lib.assertMsg (xor (gitRelease != null) (officialRelease != null)) ( + "must specify `gitRelease` or `officialRelease`" + + (lib.optionalString (gitRelease != null) " — not both") + ); + assert if true then 1 else 0; + assert + if true then # multiline + 1 + else + 0; + assert + with lib.strings; + (versionAtLeast stdenv.cc.version "7.1" && versionOlder stdenv.cc.version "13"); + assert ( + stringLength (drvName (toString oldDependency)) + == stringLength (drvName (toString newDependency)) + ); + assert ( + lib.assertMsg (!enableGoldPlugin) + "Gold plugin cannot be enabled on LLVM16 due to a upstream issue: https://github.com/llvm/llvm-project/issues/61350" + ); + assert lib.assertMsg (!enableGoldPlugin) + "Gold plugin cannot be enabled on LLVM16 due to a upstream issue: https://github.com/llvm/llvm-project/issues/61350"; + assert ( + builtins.length eriAm == eriDeriv + 1 + && builtins.foldl' (a: b: a && b) true ( + builtins.map (a: a <= maxAm && a >= 0) eriAm + ) + ); + assert assertMsg (originalValid -> absConcatOrig == absConcatNormalised) + "For valid subpath \"${str}\", appending to an absolute Nix path value gives \"${absConcatOrig}\", but appending the normalised result \"${tryOnce.value}\" gives a different value \"${absConcatNormalised}\""; + assert lib.assertMsg (strw <= width) + "fixedWidthString: requested string length (${toString width}) must not be shorter than actual length (${toString strw})"; + assert lib.foldl + (pass: { assertion, message }: if assertion final then pass else throw message) + true + (final.parsed.abi.assertions or [ ]); + assert + getErrors { + nixpkgs.localSystem = pkgs.stdenv.hostPlatform; + nixpkgs.hostPlatform = pkgs.stdenv.hostPlatform; + nixpkgs.pkgs = pkgs; + } == [ ]; + [ ] + ) ] diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 216b237c..c98343fa 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -383,7 +383,9 @@ let if typeCheck metaTypes.${k} v then null else - "key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got\n ${lib.generators.toPretty { indent = " "; } v}" + "key 'meta.${k}' has invalid value; expected ${metaTypes.${k}.description}, got\n ${ + lib.generators.toPretty { indent = " "; } v + }" else "key 'meta.${k}' is unrecognized; expected one of: \n [${ lib.concatMapStringsSep ", " (x: "'${x}'") (lib.attrNames metaTypes) diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index d0a9cd1f..58159b28 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -153,7 +153,8 @@ }: assert stdenv.cc.libc or null != null; -assert pipewireSupport +assert + pipewireSupport -> !waylandSupport || !webrtcSupport -> throw "${pname}: pipewireSupport requires both wayland and webrtc support."; diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 8b952610..d43e67b1 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -231,7 +231,8 @@ let }@attrs: # Policy on acceptable hash types in nixpkgs - assert attrs ? outputHash + assert + attrs ? outputHash -> ( let algo = attrs.outputHashAlgo or (head (splitString "-" attrs.outputHash)); @@ -721,7 +722,8 @@ let let overlappingNames = attrNames (builtins.intersectAttrs env derivationArg); in - assert assertMsg envIsExportable "When using structured attributes, `env` must be an attribute set of environment variables."; + assert assertMsg envIsExportable + "When using structured attributes, `env` must be an attribute set of environment variables."; assert assertMsg (overlappingNames == [ ]) "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; mapAttrs From eb732b168f2447be5162afab1c182df01dc2cef8 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 6 Feb 2024 00:33:38 +0100 Subject: [PATCH 104/125] Rework indentation handling The old nesting code and "base" functions are now gone. The new code will handle more things automagicalls. It also fixes some bugs that used to be there, but apart from that should not result in many changes. --- src/Nixfmt/Predoc.hs | 276 +++++++++++++++++--------------- src/Nixfmt/Pretty.hs | 112 ++++++------- test/diff/apply/out.nix | 8 +- test/diff/idioms_pkgs_5/out.nix | 16 +- test/diff/lambda/out.nix | 20 +-- 5 files changed, 224 insertions(+), 208 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 8dcdf991..c761f9d3 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances, OverloadedStrings, LambdaCase #-} module Nixfmt.Predoc ( text @@ -14,10 +14,10 @@ module Nixfmt.Predoc , sepBy , surroundWith , hcat - , base , group , group' , nest + , offset , softline' , line' , softline @@ -85,12 +85,6 @@ data DocAnn -- In all other cases, fully expand the group. -- Groups containing multiple priority groups are not supported at the moment. = Group Bool - -- | Node (Nest n) doc indicates all line starts in doc should be indented - -- by n more spaces than the surrounding Base. - | Nest Int - -- | Node Base doc sets the base indentation that Nests should be relative - -- to to the indentation of the line where the Base starts. - | Base deriving (Show, Eq) -- Comments do not count towards some line length limits @@ -103,8 +97,9 @@ data TextAnn = Regular | Comment | TrailingComment | Trailing -- | Single document element. Documents are modeled as lists of these elements -- in order to make concatenation simple. -data DocE - = Text TextAnn Text +data DocE = + -- indent level, offset, kind, text + Text Int Int TextAnn Text | Spacing Spacing | Node DocAnn Doc deriving (Show, Eq) @@ -129,21 +124,21 @@ instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where text :: Text -> Doc text "" = [] -text t = [Text Regular t] +text t = [Text 0 0 Regular t] comment :: Text -> Doc comment "" = [] -comment t = [Text Comment t] +comment t = [Text 0 0 Comment t] -- Comment at the end of a line trailingComment :: Text -> Doc trailingComment "" = [] -trailingComment t = [Text TrailingComment t] +trailingComment t = [Text 0 0 TrailingComment t] -- Text tokens that are only needed in expanded groups trailing :: Text -> Doc trailing "" = [] -trailing t = [Text Trailing t] +trailing t = [Text 0 0 Trailing t] -- | Group document elements together (see Node Group documentation) -- Must not contain non-hard whitespace (e.g. line, softline' etc.) at the start of the end. @@ -166,21 +161,28 @@ group x = pure . Node (Group False) $ group' :: Pretty a => Bool -> a -> Doc group' prio = pure . Node (Group prio) . pretty --- | @nest n doc@ sets the indentation for lines in @doc@ to @n@ more than the --- indentation of the part before it. This is based on the actual indentation of --- the line, rather than the indentation it should have used: If multiple --- indentation levels start on the same line, only the last indentation level --- will be applied on the next line. This prevents unnecessary nesting. -nest :: HasCallStack => Pretty a => Int -> a -> Doc -nest level x = pure . Node (Nest level) $ - if x' /= [] && (isSoftSpacing (head x') || isSoftSpacing (last x')) then - error $ "nest should not start or end with whitespace; " <> show x' - else - x' - where x' = pretty x - -base :: Pretty a => a -> Doc -base = pure . Node Base . pretty +-- | @nest doc@ declarse @doc@ to have a higher indentation level +-- than before. Not all nestings actually result in indentation changes, +-- this will be calculated automatically later on. As a rule of thumb: +-- Multiple indentation levels on one line will be compacted and only result in a single +-- bump for the next line. This prevents excessive indentation. +nest :: Pretty a => a -> Doc +nest x = go $ pretty x + where + go (Text i o ann t : rest) = (Text (i + 2) o ann t) : go rest + go (Node ann inner : rest) = (Node ann (go inner)) : go rest + go (spacing : rest) = spacing : go rest + go [] = [] + +-- This is similar to nest, however it circumvents the "smart" rules that usually apply. +-- This should only be useful to manage the indentation within indented strings. +offset :: Pretty a => Int -> a -> Doc +offset level x = go $ pretty x + where + go (Text i o ann t : rest) = (Text i (o + level) ann t) : go rest + go (Node ann inner : rest) = (Node ann (go inner)) : go rest + go (spacing : rest) = spacing : go rest + go [] = [] -- | Line break or nothing (soft) softline' :: Doc @@ -243,8 +245,8 @@ isHardSpacing _ = False -- Some comments are nested as nodes with multiple elements. -- Therefore nodes are counted as comments if they only contain comments or hard spacings isComment :: DocE -> Bool -isComment (Text Comment _) = True -isComment (Text TrailingComment _) = True +isComment (Text _ _ Comment _) = True +isComment (Text _ _ TrailingComment _) = True isComment (Node _ inner) = all (\x -> isComment x || isHardSpacing x) inner isComment _ = False @@ -269,7 +271,7 @@ 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 (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 @@ -297,16 +299,15 @@ fixup :: Doc -> Doc fixup [] = [] -- Merge consecutive spacings fixup (Spacing a : Spacing b : xs) = fixup $ Spacing (mergeSpacings a b) : xs --- Merge consecutive texts -fixup (Text ann a : Text ann' b : xs) | ann == ann' = fixup $ Text ann (a <> b) : xs +-- Merge consecutive texts. Take indentation and offset from the left one +fixup (Text level off ann a : Text _ _ ann' b : xs) | ann == ann' = fixup $ Text level off ann (a <> b) : xs -- Handle node, with stuff in front of it to potentially merge with fixup (a@(Spacing _) : Node ann xs : ys) = let - moveComment = case ann of { Nest _ -> False; _ -> True } -- Recurse onto xs, split out leading and trailing whitespace into pre and post. -- 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 || (moveComment && isComment x)) $ fixup xs + (pre, rest) = span (\x -> isHardSpacing x || isComment x) $ fixup xs (post, body) = (second $ simplifyNode ann) $ spanEnd isHardSpacing rest in if null body then -- Dissolve empty node @@ -316,8 +317,7 @@ fixup (a@(Spacing _) : Node ann xs : ys) = -- Handle node, almost the same thing as above fixup (Node ann xs : ys) = let - moveComment = case ann of { Nest _ -> False; _ -> True } - (pre, rest) = span (\x -> isHardSpacing x || (moveComment && isComment x)) $ fixup xs + (pre, rest) = span (\x -> isHardSpacing x || isComment x) $ fixup xs (post, body) = (second $ simplifyNode ann) $ spanEnd isHardSpacing rest in if null body then fixup $ pre ++ post ++ ys @@ -354,7 +354,8 @@ textWidth :: Text -> Int textWidth = Text.length -- | Attempt to fit a list of documents in a single line of a specific width. --- ni — next indentation. Only used for trailing comment calculations +-- ni — next indentation. Only used for trailing comment calculations. Set this to the indentation +-- of the next line relative to the current one. So usuall 2 when the indentation level increases, 0 otherwise. -- c — allowed width fits :: Int -> Int -> Doc -> Maybe Text fits _ c _ | c < 0 = Nothing @@ -363,11 +364,11 @@ fits _ _ [] = Just "" -- due to our recursion on nodes below fits ni c (Spacing a:Spacing b:xs) = fits ni c (Spacing (mergeSpacings a b):xs) fits ni c (x:xs) = case x of - Text Regular t -> (t<>) <$> fits (ni - textWidth t) (c - textWidth t) xs - Text Comment t -> (t<>) <$> fits ni c xs - Text TrailingComment t | ni == 0 -> ((" " <> t) <>) <$> fits ni c xs + Text _ _ Regular t -> (t<>) <$> fits (ni - textWidth t) (c - textWidth t) xs + Text _ _ Comment t -> (t<>) <$> fits ni c xs + Text _ _ TrailingComment t | ni == 0 -> ((" " <> t) <>) <$> fits ni c xs | otherwise -> (t<>) <$> fits ni c xs - Text Trailing _ -> fits ni c xs + Text _ _ Trailing _ -> fits ni c xs Spacing Softbreak -> fits ni c xs Spacing Break -> fits ni c xs Spacing Softspace -> (" "<>) <$> fits (ni - 1) (c - 1) xs @@ -382,9 +383,9 @@ fits ni c (x:xs) = case x of -- width 0, which always forces line breaks when possible. firstLineWidth :: Doc -> Int firstLineWidth [] = 0 -firstLineWidth (Text Comment _ : xs) = firstLineWidth xs -firstLineWidth (Text TrailingComment _ : xs) = firstLineWidth xs -firstLineWidth (Text _ t : xs) = textWidth t + firstLineWidth xs +firstLineWidth (Text _ _ Comment _ : xs) = firstLineWidth xs +firstLineWidth (Text _ _ TrailingComment _ : xs) = firstLineWidth xs +firstLineWidth (Text _ _ _ t : xs) = textWidth t + firstLineWidth xs -- This case is impossible in the input thanks to fixup, but may happen -- due to our recursion on nodes below firstLineWidth (Spacing a : Spacing b : xs) = firstLineWidth (Spacing (mergeSpacings a b):xs) @@ -398,8 +399,8 @@ firstLineFits :: Int -> Int -> Doc -> Bool firstLineFits targetWidth maxWidth docs = go maxWidth docs where go c _ | c < 0 = False go c [] = maxWidth - c <= targetWidth - go c (Text Regular t : xs) = go (c - textWidth t) xs - go c (Text _ _ : xs) = go c xs + go c (Text _ _ Regular t : xs) = go (c - textWidth t) 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 nodes below go c (Spacing a : Spacing b : xs) = go c $ Spacing (mergeSpacings a b) : xs @@ -410,37 +411,13 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs Nothing -> go c (ys ++ xs) Just t -> go (c - textWidth t) xs - go c (Node _ ys : xs) = go c (ys ++ xs) - -- Calculate the amount of indentation until the first token -- This assumes the input to be an unexpanded group at the start of a new line -firstLineIndent :: Doc -> Int -firstLineIndent ((Node (Nest n) xs) : _) = n + firstLineIndent xs -firstLineIndent ((Node _ xs) : _) = firstLineIndent xs -firstLineIndent _ = 0 - --- From a current indent and following tokens, calculate the effective indent of the next text token -nextIndent :: Int -> [Chunk] -> Int -nextIndent _ (Chunk ti (Text _ _) : _) = ti -nextIndent _ (Chunk _ (Spacing s) : Chunk ti (Node (Nest l) ys) : xs) - | s == Break || s == Space || s == Hardline - = nextIndent (ti + l) (map (Chunk (ti+l)) ys ++ xs) -nextIndent _ (Chunk ti (Spacing s) : xs) - | s == Break || s == Space || s == Hardline - = nextIndent ti xs -nextIndent _ (Chunk _ (Spacing Emptyline) : _) = 0 -nextIndent _ (Chunk _ (Spacing (Newlines _)) : _) = 0 -nextIndent _ (Chunk ti (Spacing Softbreak) : xs) = nextIndent ti xs -nextIndent _ (Chunk ti (Spacing Softspace) : xs) = nextIndent ti xs -nextIndent ci (Chunk ti (Node (Nest l) ys) : xs) = nextIndent ci (map (Chunk (ti+l)) ys ++ xs) -nextIndent ci (Chunk _ (Node Base ys) : xs) = nextIndent ci (map (Chunk ci) ys ++ xs) -nextIndent ci (Chunk ti (Node _ ys) : xs) = nextIndent ci (map (Chunk ti) ys ++ xs) -nextIndent ci (_:xs) = nextIndent ci xs -nextIndent _ [] = 0 - --- | A document element with target indentation -data Chunk = Chunk Int DocE - deriving (Show) +nextIndent :: Doc -> (Int, Int) +nextIndent ((Text i o _ _) : _) = (i, o) +nextIndent ((Node _ xs) : _) = nextIndent xs +nextIndent (_:xs) = nextIndent xs +nextIndent _ = (0, 0) -- | Create `n` newlines newlines :: Int -> Text @@ -450,71 +427,105 @@ newlines n = Text.replicate n "\n" indent :: Int -> Text indent n = Text.replicate n " " -unChunk :: Chunk -> DocE -unChunk (Chunk _ doc) = doc +-- All state is (cc, indents) +-- cc: current column (within the current line, *not including indentation*) +-- indents: +-- A stack of tuples (realIndent, virtualIndent) +-- This is guaranteed to never be empty, as we start with [(0, 0)] and never go below that. +type St = (Int, [(Int, Int)]) -- tw Target Width --- cc Current Column --- ci Current Indentation --- ti Target Indentation --- an indent only changes the target indentation at first. --- Only for the tokens starting on the next line the current --- indentation will match the target indentation. layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) doc] []) (0, 0) +layoutGreedy tw doc = Text.concat $ evalState (go [Node (Group False) doc] []) (0, [(0, 0)]) where - -- All state is (cc, ci) + -- Print a given text. If this is the first token on a line, it will + -- do the appropriate calculations for indentation and print that in addition to the text. + putText :: Int -> Int -> Text -> State St [Text] + putText textVI textOffset t = get >>= + \case + -- Needs indent, but no more than last line + (0, indents@((ci, vi):_)) | textVI == vi -> + go' indents (ci + textOffset) + -- Needs more indent than last line. We only go up by one level every time + (0, indents@((ci, vi):_)) | textVI > vi -> + go' ((ci + 2, textVI):indents) (ci + 2 + textOffset) + -- Need to go down one or more levels + -- Just pop from the stack and recurse until the indent matches again + (0, ((_, vi) : indents@((ci, vi'):_))) | textVI < vi -> + if textVI < vi' then + put (0, indents) >> putText textVI textOffset t + else + go' indents (ci + textOffset) + -- Does not need indent (not at start of line) + (cc, indents) -> + put (cc + textWidth t, indents) $> [t] + where + -- Start a new line + go' indents i = put (textWidth t, indents) $> [indent i, t] + + -- Simply put text without caring about line-start indentation + putText' :: [Text] -> State St [Text] + putText' ts = do + (cc, indents) <- get + put (cc + sum (map textWidth ts), indents) + pure ts -- First argument: chunks to render -- Second argument: lookahead of following chunks, not rendered - go :: [Chunk] -> [Chunk] -> State (Int, Int) [Text] + go :: Doc -> Doc -> State St [Text] go [] _ = return [] go (x:xs) ys = do { t <- goOne x (xs ++ ys); ts <- go xs ys; return (t ++ ts) } -- First argument: chunk to render. This will recurse into nests/groups if the chunk is one. -- Second argument: lookahead of following chunks - goOne :: Chunk -> [Chunk] -> State (Int, Int) [Text] - goOne (Chunk ti x) xs = get >>= \(cc, ci) -> + goOne :: DocE -> Doc -> State St [Text] + goOne x xs = get >>= \(cc, indents) -> let - xs' = map unChunk xs - -- The last printed character was a line break needsIndent = (cc == 0) - -- Start of line indentation, if necessary - lineStart = if needsIndent then indent ti else "" - -- Some state helpers - putText ts = put (cc + sum (map textWidth ts), ci) $> ts - putNL = put (0, ti) + putNL :: Int -> State St [Text] + putNL n = put (0, indents) $> [newlines n] in case x of - Text TrailingComment t | not needsIndent && cc == nextIndent ci xs -> putText [" ", t] - Text _ t -> putText [lineStart, t] + -- Special case trailing comments. Because in cases like + -- [ # comment + -- 1 + -- ] + -- the comment will be parsed as associated to the inner element next time, rendering it as + -- [ + -- # comment + -- 1 + -- ] + -- This breaks idempotency. To work around this, we simply shift the comment by one: + -- [ # comment + -- 1 + -- ] + Text _ _ TrailingComment t | cc == 2 && (fst $ nextIndent xs) > lineVI -> putText' [" ", t] + where lineVI = snd $ head indents + Text vi off _ t -> putText vi off t -- This code treats whitespace as "expanded" -- A new line resets the column counter and sets the target indentation as current indentation - Spacing sp -> + Spacing sp -- We know that the last printed character was a line break (cc == 0), -- therefore drop any leading whitespace within the group to avoid duplicate newlines - if needsIndent then - pure [] - else case sp of - Break -> putNL $> [newlines 1] - Space -> putNL $> [newlines 1] - Hardspace -> putText [" "] - Hardline -> putNL $> [newlines 1] - Emptyline -> putNL $> [newlines 2] - (Newlines n) -> putNL $> [newlines n] + | needsIndent -> pure [] + | otherwise -> case sp of + Break -> putNL 1 + Space -> putNL 1 + Hardspace -> putText' [" "] + Hardline -> putNL 1 + Emptyline -> putNL 2 + (Newlines n) -> putNL n Softbreak - | firstLineFits (tw - cc + ci) (tw - ti) xs' + | firstLineFits (tw - cc) tw xs -> pure [] - | otherwise -> putNL $> [newlines 1] + | otherwise -> putNL 1 Softspace - | firstLineFits (tw - cc + ci - 1) (tw - ti) xs' - -> putText [" "] - | otherwise -> putNL $> [newlines 1] + | firstLineFits (tw - cc - 1) tw xs + -> putText' [" "] + | otherwise -> putNL 1 - Node (Nest l) ys -> put (cc, if cc == 0 then ti + l else ci) >> go (map (Chunk (ti + l)) ys) xs - Node Base ys -> go (map (Chunk ci) ys) xs Node (Group _) ys -> let -- fromMaybe lifted to (StateT s Maybe) @@ -522,37 +533,37 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) fromMaybeState l r = state $ \s -> fromMaybe (runState l s) (runStateT r s) in -- Try to fit the entire group first - goGroup ti ys xs' + goGroup ys xs -- If that fails, check whether the group contains a priority group within its children and try to expand that first <|> do -- Split up on the first priority group, if present -- Note that the pattern on prio is infallible as per isPriorityGroup (pre, (Node (Group True) prio) : post) <- pure $ (break isPriorityGroup ys) -- Try to fit pre onto one line - preRendered <- goGroup ti pre (prio ++ post ++ xs') + preRendered <- goGroup pre (prio ++ post ++ xs) -- Render prio expanded -- We know that post will be rendered compact. So we tell the renderer that by manually removing all -- line breaks in post here. Otherwise we might get into awkward the situation where pre and prio are put -- onto the one line, all three obviously wouldn't fit. prioRendered <- mapStateT (Just . runIdentity) $ - go (map (Chunk ti) prio) (map (Chunk ti) (unexpandSpacing post) ++ xs) + go prio (unexpandSpacing post ++ xs) -- Try to render post onto one line - postRendered <- goGroup ti post xs' + postRendered <- goGroup post xs -- If none of these failed, put together and return return $ (preRendered ++ prioRendered ++ postRendered) -- Otherwise, dissolve the group by mapping its members to the target indentation -- This also implies that whitespace in there will now be rendered "expanded". - & fromMaybeState (go (map (Chunk ti) ys) xs) + & fromMaybeState (go ys xs) -- 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). -- Any whitespace within the group is treated as "compact". -- Return Nothing on failure, i.e. if the group would require a line break - goGroup :: Int -> Doc -> Doc -> StateT (Int, Int) Maybe [Text] + goGroup :: Doc -> Doc -> StateT St Maybe [Text] -- In general groups are never empty as empty groups are removed in `fixup`, however this also -- gets called for pre and post of priority groups, which may be empty. - goGroup _ [] _ = pure [] - goGroup ti grp rest = StateT $ \(cc, ci) -> + goGroup [] _ = pure [] + goGroup grp rest = StateT $ \(cc, ci) -> if cc == 0 then let -- We know that the last printed character was a line break (cc == 0), @@ -561,10 +572,19 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Chunk 0 $ Node (Group False) Spacing _ -> tail grp Node ann@(Group _) ((Spacing _) : inner) -> (Node ann inner) : tail grp _ -> grp - i = ti + firstLineIndent grp' + (vi, off) = nextIndent grp' + + indentWillIncrease = if fst (nextIndent rest) > lineVI then 2 else 0 + where + lastLineVI = snd $ head ci + lineVI = lastLineVI + (if vi > lastLineVI then 2 else 0) in - fits ((nextIndent ci (map (Chunk ci) rest)) - ci) (tw - firstLineWidth rest) grp' - <&> \t -> ([indent i, t], (i + textWidth t, ci)) + fits indentWillIncrease (tw - firstLineWidth rest) grp' + <&> \t -> runState (putText vi off t) (cc, ci) else - fits ((nextIndent ci (map (Chunk ci) rest)) - cc) (tw + (ci - cc) - firstLineWidth rest) grp + let + indentWillIncrease = if fst (nextIndent rest) > lineVI then 2 else 0 + where lineVI = snd $ head ci + in + fits (indentWillIncrease - cc) (tw - cc - firstLineWidth rest) grp <&> \t -> ([t], (cc + textWidth t, ci)) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index b25772b8..c5c3d90c 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -17,8 +17,8 @@ import qualified Data.Text as Text (null, takeWhile) -- import Debug.Trace (traceShowId) import Nixfmt.Predoc - (Doc, Pretty, base, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailingComment, trailing, textWidth, + (Doc, Pretty, emptyline, group, group', hardline, hardspace, hcat, line, line', + nest, offset, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailingComment, trailing, textWidth, unexpandSpacing') import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, @@ -26,11 +26,6 @@ import Nixfmt.Types StringPart(..), Term(..), Token(..), TrailingComment(..), Trivium(..), Whole(..), tokenText, mapFirstToken, mapFirstToken', mapLastToken') -prettyCommentLine :: Text -> Doc -prettyCommentLine l - | Text.null l = emptyline - | otherwise = comment l <> hardline - toLineComment :: TrailingComment -> Trivium toLineComment (TrailingComment c) = LineComment $ " " <> c @@ -53,9 +48,15 @@ instance Pretty Trivium where pretty (BlockComment c) | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment' c) | otherwise - = base $ comment "/*" <> hardspace - <> nest 3 (hcat (map prettyCommentLine c)) + = comment "/*" <> hardspace + -- Add an offset to manually indent the comment by one + <> (nest $ offset 1 $ hcat $ map prettyCommentLine c) <> comment "*/" <> hardline + where + prettyCommentLine :: Text -> Doc + prettyCommentLine l + | Text.null l = emptyline + | otherwise = comment l <> hardline instance Pretty a => Pretty (Item a) where pretty (DetachedComments trivia) = pretty trivia @@ -92,21 +93,21 @@ instance Pretty Selector where = pretty dot <> pretty sel pretty (Selector dot sel (Just (kw, def))) - = base $ pretty dot <> pretty sel - <> softline <> nest 2 (pretty kw <> hardspace <> pretty def) + = pretty dot <> pretty sel + <> softline <> nest (pretty kw <> hardspace <> pretty def) -- in attrsets and let bindings instance Pretty Binder where -- `inherit bar` statement pretty (Inherit inherit Nothing ids semicolon) - = base $ group $ pretty inherit + = group $ pretty inherit <> (if null ids then pretty semicolon else - line <> nest 2 (sepBy (if length ids < 4 then line else hardline) ids <> line' <> pretty semicolon) + line <> nest (sepBy (if length ids < 4 then line else hardline) ids <> line' <> pretty semicolon) ) -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) - = base $ group $ pretty inherit <> nest 2 ( + = group $ pretty inherit <> nest ( (group' False (line <> pretty source)) <> if null ids then pretty semicolon else line <> sepBy (if length ids < 4 then line else hardline) ids @@ -115,8 +116,8 @@ instance Pretty Binder where -- `foo = bar` pretty (Assignment selectors assign expr semicolon) - = base $ group $ hcat selectors - <> nest 2 (hardspace <> pretty assign <> absorbRHS expr) <> pretty semicolon + = group $ hcat selectors + <> nest (hardspace <> pretty assign <> absorbRHS expr) <> pretty semicolon -- Pretty a set -- while we already pretty eagerly expand sets with more than one element, @@ -129,9 +130,9 @@ prettySet _ (Nothing, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) -- Singleton sets are allowed to fit onto one line, -- but apart from that always expand. prettySet wide (krec, Ann pre paropen post, binders, parclose) - = base $ pretty (fmap (, hardspace) krec) <> + = pretty (fmap (, hardspace) krec) <> pretty (Ann pre paropen Nothing) - <> (surroundWith sep $ nest 2 $ 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 @@ -161,27 +162,27 @@ prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trail -- General list -- Always expand if len > 1 prettyTerm (List (Ann pre paropen post) items parclose) = - base $ pretty (Ann pre paropen Nothing) - <> (surroundWith line $ nest 2 $ pretty post <> prettyItems hardline items) + pretty (Ann pre paropen Nothing) + <> (surroundWith line $ nest $ pretty post <> prettyItems hardline items) <> pretty parclose prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = base $ group $ pretty (moveTrailingCommentUp paropen) <> inner <> pretty parclose + = group $ pretty (moveTrailingCommentUp paropen) <> inner <> pretty parclose where inner = case expr of -- Start on the same line for these - _ | isAbsorbableExpr expr -> nest 2 $ group $ absorbExpr False expr + _ | isAbsorbableExpr expr -> nest $ group $ absorbExpr False expr -- Parenthesized application - (Application f a) -> nest 2 $ base $ prettyApp True mempty True f a + (Application f a) -> nest $ prettyApp True mempty True f a -- Same thing for selections - (Term (Selection t _)) | isAbsorbable t -> line' <> (nest 2 $ group $ expr) <> line' - (Term (Selection _ _)) -> (nest 2 $ group $ expr) <> line' + (Term (Selection t _)) | isAbsorbable t -> line' <> (nest $ group $ expr) <> line' + (Term (Selection _ _)) -> (nest $ group $ expr) <> line' -- Start on a new line for the others - _ -> line' <> (nest 2 $ group $ expr) <> line' + _ -> line' <> (nest $ group $ expr) <> line' instance Pretty Term where pretty l@List{} = group $ prettyTerm l @@ -195,9 +196,9 @@ instance Pretty ParamAttr where -- With ? default pretty (ParamAttr name (Just (qmark, def)) maybeComma) - = base $ group $ + = group $ pretty name <> hardspace - <> nest 2 (pretty qmark <> absorbRHS def) + <> nest (pretty qmark <> absorbRHS def) <> pretty maybeComma -- `...` @@ -262,7 +263,7 @@ instance Pretty Parameter where pretty (SetParameter bopen attrs bclose) = group $ pretty (moveTrailingCommentUp bopen) - <> (surroundWith sep $ nest 2 $ 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 @@ -275,7 +276,6 @@ instance Pretty Parameter where handleTrailingComma (x:xs) = pretty x : handleTrailingComma xs sep = case attrs of - [] -> line [ParamEllipsis _] -> line -- Attributes must be without default [ParamAttr _ Nothing _] -> line @@ -310,23 +310,23 @@ instance Pretty Parameter where prettyApp :: Bool -> Doc -> Bool -> Expression -> Expression -> Doc prettyApp indentFunction pre hasPost f a = let - absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest 2 (group a')) + absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest (group a')) absorbApp expr - | indentFunction && (null comment') = nest 2 $ group' False $ line' <> pretty expr + | indentFunction && (null comment') = nest $ group' False $ line' <> pretty expr | otherwise = pretty expr absorbLast (Term t) | isAbsorbable t - = group' True $ nest 2 $ prettyTerm t + = group' True $ nest $ prettyTerm t absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) - = group' True $ nest 2 $ base $ pretty (Ann pre' open Nothing) + = group' True $ nest $ pretty (Ann pre' open Nothing) -- Move any trailing comments on the opening parenthesis down into the body - <> (surroundWith line' $ group $ nest 2 $ base $ + <> (surroundWith line' $ group $ nest $ mapFirstToken (\(Ann leading token trailing') -> (Ann (maybeToList (toLineComment <$> post') ++ leading) token trailing')) expr ) <> pretty close - absorbLast arg = group' False $ nest 2 $ pretty arg + absorbLast arg = group' False $ nest $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment') = mapFirstToken' @@ -350,14 +350,14 @@ prettyApp indentFunction pre hasPost f a prettyWith :: Bool -> Expression -> Doc -- absorb the body prettyWith True (With with expr0 semicolon (Term expr1)) - = base (pretty with <> hardspace - <> nest 2 (group expr0) <> pretty semicolon) + = pretty with <> hardspace + <> nest (group expr0) <> pretty semicolon -- Force-expand attrsets <> hardspace <> prettyTermWide expr1 -- Normal case prettyWith _ (With with expr0 semicolon expr1) - = base (pretty with <> hardspace - <> nest 2 (group expr0) <> pretty semicolon) + = pretty with <> hardspace + <> nest (group expr0) <> pretty semicolon <> line <> pretty expr1 prettyWith _ _ = error "unreachable" @@ -400,9 +400,9 @@ absorbRHS expr = case expr of _ | isAbsorbableExpr expr -> hardspace <> group (absorbExpr True expr) -- Parenthesized expression. Same thing as the special case for parenthesized last argument in function calls. (Term (Parenthesized open expr' close)) -> - group' True $ nest 2 $ base $ + group' True $ nest $ hardspace <> pretty open - <> (surroundWith line' . group . nest 2 . base) expr' + <> (surroundWith line' . group . nest) expr' <> pretty close -- Not all strings are absorbable, but in this case we always want to keep them attached. -- Because there's nothing to gain from having them start on a new line. @@ -452,7 +452,7 @@ instance Pretty Expression where -- We also take the comments around the `in` (trailing, leading and detached binder comments) -- and move them down to the first token of the body pretty (Let let_ binders (Ann leading in_ trailing') expr) - = base $ letPart <> hardline <> inPart + = letPart <> hardline <> inPart where -- Convert the TrailingComment to a Trivium, if present convertTrailing Nothing = [] @@ -473,7 +473,7 @@ instance Pretty Expression where (unItems binders) letPart = group $ pretty let_ <> hardline <> letBody - letBody = nest 2 $ prettyItems hardline (Items bindersWithoutComments) + letBody = nest $ prettyItems hardline (Items bindersWithoutComments) inPart = group $ pretty (Ann [] in_ Nothing) <> hardline -- Take our trailing and inject it between `in` and body <> pretty (concat binderComments ++ leading ++ convertTrailing trailing') @@ -492,18 +492,18 @@ instance Pretty Expression where insertIntoApp insert other = (insert, other) pretty expr@(If _ _ _ _ _ _) - = base $ group' False $ prettyIf line expr + = group' False $ prettyIf line expr where -- Recurse to absorb nested "else if" chains prettyIf :: Doc -> Expression -> Doc 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 2 (pretty cond) <> line <> pretty then_) - <> (surroundWith sep $ nest 2 $ group expr0) + = group (pretty if_ <> line <> nest (pretty cond) <> line <> pretty then_) + <> (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 else_ <> hardspace <> prettyIf hardline expr1 prettyIf _ x - = line <> nest 2 (group x) + = line <> nest (group x) -- Simple parameter pretty (Abstraction (IDParameter param) colon body) @@ -526,7 +526,7 @@ instance Pretty Expression where = pretty param <> pretty colon <> line <> pretty body pretty (Application f a) - = base $ prettyApp False mempty False f a + = prettyApp False mempty False f a -- not chainable binary operators: <, >, <=, >=, ==, != pretty (Operation a op@(Ann _ op' _) b) @@ -544,7 +544,7 @@ instance Pretty Expression where -- Called on every operand except the first one (a.k.a. RHS) absorbOperation :: Expression -> Doc - absorbOperation (Term t) | isAbsorbable t = hardspace <> (base $ pretty t) + absorbOperation (Term t) | isAbsorbable t = hardspace <> (pretty t) -- Force nested operations to start on a new line absorbOperation x@(Operation _ _ _) = group' False $ line <> pretty x -- Force applications to start on a new line if more than the last argument is multiline @@ -556,7 +556,7 @@ instance Pretty Expression where prettyOperation (Nothing, expr) = pretty expr -- The others prettyOperation ((Just op'), expr) = - line <> pretty (moveTrailingCommentUp op') <> nest 2 (absorbOperation expr) + line <> pretty (moveTrailingCommentUp op') <> nest (absorbOperation expr) in group' False $ (concat . map prettyOperation . (flatten Nothing)) operation @@ -622,7 +622,7 @@ instance Pretty StringPart where whole' = pretty whole inner = fromMaybe -- default - (surroundWith line' $ nest 2 $ whole') + (surroundWith line' $ nest $ whole') -- force on one line if possible (unexpandSpacing' (Just 30) whole') @@ -636,10 +636,10 @@ instance Pretty [StringPart] where -- interpolations, make sure to indent based on the indentation of the line -- in the string. pretty (TextPart t : parts) - = text t <> base (nest indentation (hcat parts)) + = text t <> offset indentation (hcat parts) where indentation = textWidth $ Text.takeWhile isSpace t - pretty parts = base $ hcat parts + pretty parts = hcat parts prettySimpleString :: [[StringPart]] -> Doc prettySimpleString parts = group $ @@ -650,11 +650,11 @@ prettySimpleString parts = group $ <> text "\"" prettyIndentedString :: [[StringPart]] -> Doc -prettyIndentedString parts = group $ base $ +prettyIndentedString parts = group $ text "''" -- Usually the `''` is followed by a potential line break. -- 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 2 $ sepBy newline $ map pretty parts) + <> (nest $ sepBy newline $ map pretty parts) <> text "''" diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 9f601672..1c7b6c17 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -18,9 +18,7 @@ )) (foo bar baz # Function call with comment - ( - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ) + (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) ) (foo bar baz ( # Function call with comment @@ -48,9 +46,7 @@ bar baz # Function call with comment - ( - mapAttrsToStringsSep "\n" mkSection attrsOfAttrs - ) + (mapAttrsToStringsSep "\n" mkSection attrsOfAttrs) ) (foo [ diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index d43e67b1..04bd0273 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -196,14 +196,14 @@ let meta ? { }, passthru ? { }, pos ? # position used in error messages and for meta.position - ( - if attrs.meta.description or null != null then - builtins.unsafeGetAttrPos "description" attrs.meta - else if attrs.version or null != null then - builtins.unsafeGetAttrPos "version" attrs - else - builtins.unsafeGetAttrPos "name" attrs - ), + ( + if attrs.meta.description or null != null then + builtins.unsafeGetAttrPos "description" attrs.meta + else if attrs.version or null != null then + builtins.unsafeGetAttrPos "version" attrs + else + builtins.unsafeGetAttrPos "name" attrs + ), separateDebugInfo ? false, outputs ? [ "out" ], __darwinAllowLocalNetworking ? false, diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index 8722bb4e..b6f42993 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -153,16 +153,16 @@ in "loooooooooooooooooooooooooooooooooooooooooooong" ), things ? # comment - ( - if null then - [ - 1 - 2 - 3 - ] - else - "loooooooooooooooooooooooooooooooooooooooooooong" - ), + ( + if null then + [ + 1 + 2 + 3 + ] + else + "loooooooooooooooooooooooooooooooooooooooooooong" + ), }: { } ) From 62b0c39ed559fb0ccfe6bc7cbd3fba836ccdba51 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 6 Feb 2024 11:04:46 +0100 Subject: [PATCH 105/125] Small cleanup --- src/Nixfmt/Pretty.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index c5c3d90c..523411cc 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -170,19 +170,19 @@ prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, i -- Parentheses prettyTerm (Parenthesized paropen expr parclose) - = group $ pretty (moveTrailingCommentUp paropen) <> inner <> pretty parclose + = group $ pretty (moveTrailingCommentUp paropen) <> nest inner <> pretty parclose where inner = case expr of -- Start on the same line for these - _ | isAbsorbableExpr expr -> nest $ group $ absorbExpr False expr + _ | isAbsorbableExpr expr -> group $ absorbExpr False expr -- Parenthesized application - (Application f a) -> nest $ prettyApp True mempty True f a + (Application f a) -> prettyApp True mempty True f a -- Same thing for selections - (Term (Selection t _)) | isAbsorbable t -> line' <> (nest $ group $ expr) <> line' - (Term (Selection _ _)) -> (nest $ group $ expr) <> line' + (Term (Selection t _)) | isAbsorbable t -> line' <> group expr <> line' + (Term (Selection _ _)) -> group expr <> line' -- Start on a new line for the others - _ -> line' <> (nest $ group $ expr) <> line' + _ -> line' <> group expr <> line' instance Pretty Term where pretty l@List{} = group $ prettyTerm l From d1067e4139d93bdd124c4623ea05fd8ef8da881a Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 6 Feb 2024 15:02:55 +0100 Subject: [PATCH 106/125] Predoc: Support multiple priority groups --- src/Nixfmt/Predoc.hs | 174 +++++++++++++++++++++++++++---------------- src/Nixfmt/Pretty.hs | 36 ++++----- 2 files changed, 127 insertions(+), 83 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index c761f9d3..f3b59011 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -27,6 +27,7 @@ module Nixfmt.Predoc , emptyline , newline , Doc + , GroupAnn(..) , Pretty , pretty , fixup @@ -44,7 +45,7 @@ import Data.Maybe (fromMaybe) import Data.Text as Text (Text, concat, length, replicate, strip) import GHC.Stack (HasCallStack) -- import Debug.Trace (traceShow, traceShowId) -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>), asum, empty) import Control.Monad.Trans.State.Strict (State, StateT, StateT(..), mapStateT, state, runState, evalState, get, put) -- | Sequential Spacings are reduced to a single Spacing by taking the maximum. @@ -70,21 +71,31 @@ data Spacing | Newlines Int deriving (Show, Eq, Ord) -data DocAnn - -- | Node Group docs indicates either all or none of the Spaces and Breaks - -- in docs should be converted to line breaks. This does not affect softlines, - -- those will be expanded only as necessary and with a lower priority. +-- | `Group docs` indicates that either all or none of the Spaces and Breaks +-- in `docs` should be converted to line breaks. This does not affect softlines, +-- those will be expanded only as necessary and with a lower priority. +data GroupAnn + = RegularG + -- Group with priority expansion. This is only rarely needed, and mostly useful + -- to compact things left and right of a multiline element as long as they fit onto one line. -- - -- The boolean argument makes a group a "high priority" group. You should almost - -- never need this (it was introduced purely to accomodate for some Application special - -- handling). Groups containing priority groups are treated as having three segments: + -- Groups containing priority groups are treated as having three segments: -- pre, prio and post. -- If any group contains a priority group, the following happens: -- If it entirely fits on one line, render on one line (as usual). -- If it does not fit on one line, but pre and post do when prio is expanded, then try that. - -- In all other cases, fully expand the group. - -- Groups containing multiple priority groups are not supported at the moment. - = Group Bool + -- In all other cases, fully expand the group as if it didn't contain any priority groups. + -- + -- If a group contains multiple priority groups, then the renderer will attempt to expand them, + -- each one individually, and in *reverse* order. If all of these fail, then the entire group + -- will be fully expanded as if it didn't contain any priority groups. + | Priority + -- Usually, priority groups are associated and handled by their direct parent group. However, + -- if the parent is a `Transparent` group, then they will be associated with its parent instead. + -- (This goes on transitively until the first non-transparent parent group.) + -- In the case of priority group expansion, this group will be treated as non-existent (transparent). + -- Otherwise, it will be treated like a regular group. + | Transparent deriving (Show, Eq) -- Comments do not count towards some line length limits @@ -92,7 +103,7 @@ data DocAnn -- Trailing comments are like comments, but marked differently for special treatment further down the line -- (The difference is that trailing comments are guaranteed to be single "# text" tokens, while all other comments -- may be composite and multi-line) -data TextAnn = Regular | Comment | TrailingComment | Trailing +data TextAnn = RegularT | Comment | TrailingComment | Trailing deriving (Show, Eq) -- | Single document element. Documents are modeled as lists of these elements @@ -101,7 +112,7 @@ data DocE = -- indent level, offset, kind, text Text Int Int TextAnn Text | Spacing Spacing - | Node DocAnn Doc + | Group GroupAnn Doc deriving (Show, Eq) type Doc = [DocE] @@ -124,7 +135,7 @@ instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where text :: Text -> Doc text "" = [] -text t = [Text 0 0 Regular t] +text t = [Text 0 0 RegularT t] comment :: Text -> Doc comment "" = [] @@ -144,7 +155,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 . Node (Group False) $ +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 @@ -158,8 +169,8 @@ group x = pure . Node (Group False) $ -- or you'll get some *very* confusing bugs … -- -- Also allows to create priority groups (see Node Group documentation) -group' :: Pretty a => Bool -> a -> Doc -group' prio = pure . Node (Group prio) . pretty +group' :: Pretty a => GroupAnn -> a -> Doc +group' ann = pure . (Group ann) . pretty -- | @nest doc@ declarse @doc@ to have a higher indentation level -- than before. Not all nestings actually result in indentation changes, @@ -170,7 +181,7 @@ nest :: Pretty a => a -> Doc nest x = go $ pretty x where go (Text i o ann t : rest) = (Text (i + 2) o ann t) : go rest - go (Node ann inner : rest) = (Node ann (go inner)) : go rest + go (Group ann inner : rest) = (Group ann (go inner)) : go rest go (spacing : rest) = spacing : go rest go [] = [] @@ -180,7 +191,7 @@ offset :: Pretty a => Int -> a -> Doc offset level x = go $ pretty x where go (Text i o ann t : rest) = (Text i (o + level) ann t) : go rest - go (Node ann inner : rest) = (Node ann (go inner)) : go rest + go (Group ann inner : rest) = (Group ann (go inner)) : go rest go (spacing : rest) = spacing : go rest go [] = [] @@ -247,7 +258,7 @@ isHardSpacing _ = False isComment :: DocE -> Bool isComment (Text _ _ Comment _) = True isComment (Text _ _ TrailingComment _) = True -isComment (Node _ inner) = all (\x -> isComment x || isHardSpacing x) inner +isComment (Group _ inner) = all (\x -> isComment x || isHardSpacing x) inner isComment _ = False --- Manually force a group to its compact layout, by replacing all relevant whitespace. @@ -278,12 +289,13 @@ unexpandSpacing' n (Spacing Softspace:xs) = (Spacing Hardspace :) <$> unexpandSp unexpandSpacing' n (Spacing Break:xs) = unexpandSpacing' n xs unexpandSpacing' n (Spacing Softbreak:xs) = unexpandSpacing' n xs unexpandSpacing' _ (Spacing _:_) = Nothing -unexpandSpacing' n ((Node _ xs):ys) = unexpandSpacing' n $ xs <> ys +unexpandSpacing' n ((Group _ xs):ys) = unexpandSpacing' n $ xs <> ys -simplifyNode :: DocAnn -> Doc -> Doc -simplifyNode _ [] = [] -simplifyNode (Group False) [Node (Group False) body] = body -simplifyNode _ x = x +-- Dissolve some groups with only one item +simplifyGroup :: GroupAnn -> Doc -> Doc +simplifyGroup _ [] = [] +simplifyGroup ann [Group ann' body] | ann == ann' = body +simplifyGroup _ x = x -- | Fix up a Doc: -- - Move some spacings (those which are not relevant for group calculations) @@ -301,28 +313,28 @@ fixup [] = [] fixup (Spacing a : Spacing b : xs) = fixup $ Spacing (mergeSpacings a b) : xs -- Merge consecutive texts. Take indentation and offset from the left one fixup (Text level off ann a : Text _ _ ann' b : xs) | ann == ann' = fixup $ Text level off ann (a <> b) : xs --- Handle node, with stuff in front of it to potentially merge with -fixup (a@(Spacing _) : Node ann xs : ys) = +-- Handle group, with stuff in front of it to potentially merge with +fixup (a@(Spacing _) : Group ann xs : ys) = let -- Recurse onto xs, split out leading and trailing whitespace into pre and post. -- 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 $ simplifyNode ann) $ spanEnd isHardSpacing rest + (post, body) = (second $ simplifyGroup ann) $ spanEnd isHardSpacing rest in if null body then - -- Dissolve empty node + -- Dissolve empty group fixup $ (a : pre) ++ post ++ ys else - fixup (a : pre) ++ [Node ann body] ++ fixup (post ++ ys) --- Handle node, almost the same thing as above -fixup (Node ann xs : ys) = + fixup (a : pre) ++ [Group ann body] ++ fixup (post ++ ys) +-- Handle group, almost the same thing as above +fixup (Group ann xs : ys) = let (pre, rest) = span (\x -> isHardSpacing x || isComment x) $ fixup xs - (post, body) = (second $ simplifyNode ann) $ spanEnd isHardSpacing rest + (post, body) = (second $ simplifyGroup ann) $ spanEnd isHardSpacing rest in if null body then fixup $ pre ++ post ++ ys else - fixup pre ++ [Node ann body] ++ fixup (post ++ ys) + fixup pre ++ [Group ann body] ++ fixup (post ++ ys) fixup (x : xs) = x : fixup xs mergeSpacings :: Spacing -> Spacing -> Spacing @@ -345,9 +357,35 @@ layout w = (<>"\n") . Text.strip . layoutGreedy w . fixup . pretty -- 4. For each Group, if it fits on a single line, render it that way. -- 5. If not, convert lines to hardlines and unwrap the group -isPriorityGroup :: DocE -> Bool -isPriorityGroup (Node (Group True) _) = True -isPriorityGroup _ = False + +-- Extract and list the priority groups of this group. +-- The return value is a segmentation of the input, each segment annotated with its priority (True = Priority). +-- This recurses into `Transparent` subgroups on the search for priority groups, and flattens their content in the output. +-- If no priority groups are found, the empty list is returned. +priorityGroups :: Doc -> [(Doc, Doc, Doc)] +priorityGroups = explode . mergeSegments . segments + where + segments :: Doc -> [(Bool, Doc)] + segments [] = [] + segments ((Group Priority ys):xs) = (True, ys) : segments xs + segments ((Group Transparent ys):xs) = segments ys ++ segments xs + segments (x:xs) = (False, pure x) : segments xs + + -- Merge subsequent segments of non-priority-group elements + mergeSegments :: [(Bool, Doc)] -> [(Bool, Doc)] + mergeSegments [] = [] + mergeSegments ((False, content1):(False, content2):xs) = mergeSegments $ (False, content1 ++ content2):xs + mergeSegments (x:xs) = x : mergeSegments xs + + -- Convert the segmented/pre-porcessed input into a list of all groups as (pre, prio, post) triples + explode :: [(Bool, Doc)] -> [(Doc, Doc, Doc)] + explode [] = [] + explode [(prio, x)] + | prio = [([], x, [])] + | otherwise = [] + explode ((prio, x):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. textWidth :: Text -> Int @@ -364,7 +402,7 @@ fits _ _ [] = Just "" -- due to our recursion on nodes below fits ni c (Spacing a:Spacing b:xs) = fits ni c (Spacing (mergeSpacings a b):xs) fits ni c (x:xs) = case x of - Text _ _ Regular t -> (t<>) <$> fits (ni - textWidth t) (c - textWidth t) xs + Text _ _ RegularT t -> (t<>) <$> fits (ni - textWidth t) (c - textWidth t) xs Text _ _ Comment t -> (t<>) <$> fits ni c xs Text _ _ TrailingComment t | ni == 0 -> ((" " <> t) <>) <$> fits ni c xs | otherwise -> (t<>) <$> fits ni c xs @@ -377,7 +415,7 @@ fits ni c (x:xs) = case x of Spacing Hardline -> Nothing Spacing Emptyline -> Nothing Spacing (Newlines _) -> Nothing - Node _ ys -> fits ni c $ ys ++ xs + Group _ ys -> fits ni c $ ys ++ xs -- | Find the width of the first line in a list of documents, using target -- width 0, which always forces line breaks when possible. @@ -387,11 +425,11 @@ firstLineWidth (Text _ _ Comment _ : xs) = firstLineWidth xs firstLineWidth (Text _ _ TrailingComment _ : xs) = firstLineWidth xs firstLineWidth (Text _ _ _ t : xs) = textWidth t + firstLineWidth xs -- This case is impossible in the input thanks to fixup, but may happen --- due to our recursion on nodes below +-- due to our recursion on groups below firstLineWidth (Spacing a : Spacing b : xs) = firstLineWidth (Spacing (mergeSpacings a b):xs) firstLineWidth (Spacing Hardspace : xs) = 1 + firstLineWidth xs firstLineWidth (Spacing _ : _) = 0 -firstLineWidth (Node _ xs : ys) = firstLineWidth $ xs ++ ys +firstLineWidth (Group _ xs : ys) = firstLineWidth $ xs ++ ys -- | Check if the first line in a document fits a target width given -- a maximum width, without breaking up groups. @@ -399,14 +437,14 @@ firstLineFits :: Int -> Int -> Doc -> Bool firstLineFits targetWidth maxWidth docs = go maxWidth docs where go c _ | c < 0 = False go c [] = maxWidth - c <= targetWidth - go c (Text _ _ Regular t : xs) = go (c - textWidth t) xs + go c (Text _ _ RegularT t : xs) = go (c - textWidth t) 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 nodes below + -- due to our recursion on groups below go c (Spacing a : Spacing b : xs) = go c $ Spacing (mergeSpacings a b) : xs go c (Spacing Hardspace : xs) = go (c - 1) xs go c (Spacing _ : _) = maxWidth - c <= targetWidth - go c (Node (Group _) ys : xs) = + go c (Group _ ys : xs) = case fits 0 (c - firstLineWidth xs) ys of Nothing -> go c (ys ++ xs) Just t -> go (c - textWidth t) xs @@ -415,7 +453,7 @@ firstLineFits targetWidth maxWidth docs = go maxWidth docs -- This assumes the input to be an unexpanded group at the start of a new line nextIndent :: Doc -> (Int, Int) nextIndent ((Text i o _ _) : _) = (i, o) -nextIndent ((Node _ xs) : _) = nextIndent xs +nextIndent ((Group _ xs) : _) = nextIndent xs nextIndent (_:xs) = nextIndent xs nextIndent _ = (0, 0) @@ -436,7 +474,7 @@ type St = (Int, [(Int, Int)]) -- tw Target Width layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ evalState (go [Node (Group False) doc] []) (0, [(0, 0)]) +layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, [(0, 0)]) where -- Print a given text. If this is the first token on a line, it will -- do the appropriate calculations for indentation and print that in addition to the text. @@ -526,7 +564,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Node (Group False) doc] []) ( -> putText' [" "] | otherwise -> putNL 1 - Node (Group _) ys -> + Group ann ys -> let -- fromMaybe lifted to (StateT s Maybe) fromMaybeState :: State s a -> StateT s Maybe a -> State s a @@ -534,27 +572,33 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Node (Group False) doc] []) ( in -- Try to fit the entire group first goGroup ys xs - -- If that fails, check whether the group contains a priority group within its children and try to expand that first - <|> do - -- Split up on the first priority group, if present - -- Note that the pattern on prio is infallible as per isPriorityGroup - (pre, (Node (Group True) prio) : post) <- pure $ (break isPriorityGroup ys) - -- Try to fit pre onto one line - preRendered <- goGroup pre (prio ++ post ++ xs) - -- Render prio expanded - -- We know that post will be rendered compact. So we tell the renderer that by manually removing all - -- line breaks in post here. Otherwise we might get into awkward the situation where pre and prio are put - -- onto the one line, all three obviously wouldn't fit. - prioRendered <- mapStateT (Just . runIdentity) $ - go prio (unexpandSpacing post ++ xs) - -- Try to render post onto one line - postRendered <- goGroup post xs - -- If none of these failed, put together and return - return $ (preRendered ++ prioRendered ++ postRendered) + -- If that fails, check whether the group contains any priority groups within its children and try to expand them first + -- 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 + else + empty + ) -- Otherwise, dissolve the group by mapping its members to the target indentation -- This also implies that whitespace in there will now be rendered "expanded". & fromMaybeState (go ys xs) + goPriorityGroup :: (Doc, Doc, Doc) -> Doc -> StateT St Maybe [Text] + goPriorityGroup (pre, prio, post) rest = do + -- Try to fit pre onto one line + preRendered <- goGroup pre (prio ++ post ++ rest) + -- Render prio expanded + -- We know that post will be rendered compact. So we tell the renderer that by manually removing all + -- line breaks in post here. Otherwise we might get into awkward the situation where pre and prio are put + -- onto the one line, all three obviously wouldn't fit. + prioRendered <- mapStateT (Just . runIdentity) $ + go prio (unexpandSpacing post ++ rest) + -- Try to render post onto one line + postRendered <- goGroup post rest + -- If none of these failed, put together and return + 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). -- Any whitespace within the group is treated as "compact". @@ -570,7 +614,7 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Node (Group False) doc] []) ( -- therefore drop any leading whitespace within the group to avoid duplicate newlines grp' = case head grp of Spacing _ -> tail grp - Node ann@(Group _) ((Spacing _) : inner) -> (Node ann inner) : tail grp + Group ann ((Spacing _) : inner) -> (Group ann inner) : tail grp _ -> grp (vi, off) = nextIndent grp' diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 523411cc..3d12666f 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -17,7 +17,7 @@ import qualified Data.Text as Text (null, takeWhile) -- import Debug.Trace (traceShowId) import Nixfmt.Predoc - (Doc, Pretty, emptyline, group, group', hardline, hardspace, hcat, line, line', + (Doc, GroupAnn(..), Pretty, emptyline, group, group', hardline, hardspace, hcat, line, line', nest, offset, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailingComment, trailing, textWidth, unexpandSpacing') import Nixfmt.Types @@ -108,7 +108,7 @@ instance Pretty Binder where -- `inherit (foo) bar` statement pretty (Inherit inherit (Just source) ids semicolon) = group $ pretty inherit <> nest ( - (group' False (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 @@ -312,13 +312,13 @@ prettyApp indentFunction pre hasPost f a = let absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest (group a')) absorbApp expr - | indentFunction && (null comment') = nest $ group' False $ line' <> pretty expr + | indentFunction && (null comment') = nest $ group' RegularG $ line' <> pretty expr | otherwise = pretty expr absorbLast (Term t) | isAbsorbable t - = group' True $ nest $ prettyTerm t + = group' Priority $ nest $ prettyTerm t absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) - = group' True $ nest $ pretty (Ann pre' open Nothing) + = group' Priority $ nest $ pretty (Ann pre' open Nothing) -- Move any trailing comments on the opening parenthesis down into the body <> (surroundWith line' $ group $ nest $ mapFirstToken @@ -326,7 +326,7 @@ prettyApp indentFunction pre hasPost f a expr ) <> pretty close - absorbLast arg = group' False $ nest $ pretty arg + absorbLast arg = group' RegularG $ nest $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded (fWithoutComment, comment') = mapFirstToken' @@ -341,9 +341,9 @@ prettyApp indentFunction pre hasPost f a pretty comment' <> ( if isSimple (Application f a) && isJust (renderedFUnexpanded) then - (group' False $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a <> post) + (group' RegularG $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a <> post) else - (group' False $ renderedF <> line <> absorbLast a <> post) + (group' RegularG $ renderedF <> line <> absorbLast a <> post) ) <> (if hasPost && not (null comment') then hardline else mempty) @@ -400,7 +400,7 @@ absorbRHS expr = case expr of _ | isAbsorbableExpr expr -> hardspace <> group (absorbExpr True expr) -- Parenthesized expression. Same thing as the special case for parenthesized last argument in function calls. (Term (Parenthesized open expr' close)) -> - group' True $ nest $ + group' Priority $ nest $ hardspace <> pretty open <> (surroundWith line' . group . nest) expr' <> pretty close @@ -412,28 +412,28 @@ absorbRHS expr = case expr of (Term (Path _)) -> hardspace <> group expr -- Non-absorbable term -- If it is multi-line, force it to start on a new line with indentation - (Term _) -> group' False (line <> pretty expr) + (Term _) -> group' RegularG (line <> pretty expr) -- 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' False $ line <> pretty expr + (With _ _ _ _) -> group' RegularG $ line <> pretty expr -- Special case `//` 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 [] TUpdate Nothing) b) | isAbsorbable t -> - group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b + group' RegularG $ line <> group' Priority (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b -- Case 2a: LHS fits onto first line, RHS is an absorbable term (Operation l (Ann [] TUpdate Nothing) (Term t)) | isAbsorbable t -> - group' False $ line <> pretty l <> line <> group' True (pretty TUpdate <> hardspace <> prettyTermWide t) + group' RegularG $ line <> pretty l <> line <> group' Priority (pretty TUpdate <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> line <> (group l) <> line <> prettyApp False (pretty TUpdate <> hardspace) False f a -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> - group' False $ line <> group' True (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b + group' RegularG $ line <> group' Priority (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b -- Case 2a: LHS fits onto first line, RHS is an absorbable term (Operation l (Ann [] TConcat Nothing) (Term t)) | isAbsorbable t -> - group' False $ line <> pretty l <> line <> group' True (pretty TConcat <> hardspace <> prettyTermWide t) + group' RegularG $ line <> pretty l <> line <> group' Priority (pretty TConcat <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application (Operation l (Ann [] TConcat Nothing) (Application f a)) -> line <> (group l) <> line <> prettyApp False (pretty TConcat <> hardspace) False f a @@ -492,7 +492,7 @@ instance Pretty Expression where insertIntoApp insert other = (insert, other) pretty expr@(If _ _ _ _ _ _) - = group' False $ prettyIf line expr + = group' RegularG $ prettyIf line expr where -- Recurse to absorb nested "else if" chains prettyIf :: Doc -> Expression -> Doc @@ -546,7 +546,7 @@ instance Pretty Expression where absorbOperation :: Expression -> Doc absorbOperation (Term t) | isAbsorbable t = hardspace <> (pretty t) -- Force nested operations to start on a new line - absorbOperation x@(Operation _ _ _) = group' False $ 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 @@ -558,7 +558,7 @@ instance Pretty Expression where prettyOperation ((Just op'), expr) = line <> pretty (moveTrailingCommentUp op') <> nest (absorbOperation expr) in - group' False $ + group' RegularG $ (concat . map prettyOperation . (flatten Nothing)) operation pretty (MemberCheck expr qmark sel) From 7b1fcf58cf21a780e025d7a1c30f0ef76e2d2673 Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 6 Feb 2024 15:18:32 +0100 Subject: [PATCH 107/125] Function application: Expand non-last arguments when rest fits onto a single line --- src/Nixfmt/Pretty.hs | 31 ++--- test/diff/apply/out.nix | 143 +++++++++-------------- test/diff/assert/out.nix | 7 +- test/diff/attr_set/out.nix | 91 +++++++-------- test/diff/idioms_lib_3/out.nix | 59 +++++----- test/diff/idioms_lib_4/out.nix | 7 +- test/diff/idioms_lib_5/out.nix | 12 +- test/diff/idioms_nixos_1/out.nix | 10 +- test/diff/idioms_nixos_2/out.nix | 30 ++--- test/diff/idioms_pkgs_3/out.nix | 21 ++-- test/diff/idioms_pkgs_5/out.nix | 181 ++++++++++++++---------------- test/diff/string_interpol/out.nix | 26 ++--- 12 files changed, 276 insertions(+), 342 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 3d12666f..dd95e186 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -291,26 +291,29 @@ instance Pretty Parameter where -- Function application -- Some example mapping of Nix code to Doc (using brackets as groups, but omitting the outermost group -- and groups around the expressions for conciseness): +-- -- `f a` -> pre f line a post -- `f g a` -> pre [f line g] line a post -- `f g h a` -> pre [[f line g] line h] line a post -- `f g h i a` -> pre [[[f line g] line h] line i] line a post --- As you can see, it separates the elements by `line` whitespace. However, there are three tricks to make it look good: --- First, for each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion --- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining --- ones on a separate line each. --- Second, the last argument is declared as "priority" group, meaning that the layouting algorithm will try to expand --- it first when things do not fit onto one line. This allows the last argument to be multi-line without forcing the --- preceding arguments to be multiline. --- Third, callers may inject `pre` and `post` tokens (mostly newlines) into the inside of the group. --- This means that callers can say "try to be compact first, but if more than the last argument does not fit onto the line, --- then start on a new line instead". --- Out of necessity, callers may also inject `commentPre` and `commentPost`, which will be added before/after the entire --- thing if the function has a comment associated with its first token +-- +-- As you can see, it separates the elements by `line` whitespace. However, there are several tricks to make it look good: +-- 1. For each function call (imagine the fully parenthesised Nix code), we group it. Due to the greedy expansion +-- of groups this means that it will place as many function calls on the first line as possible, but then all the remaining +-- ones on a separate line each. +-- 2. Each argument is declared as "priority" group, meaning that the layouting algorithm will try to expand +-- it first when things do not fit onto one line. If there are multiple arguments, they will each be attempted to +-- expand, individually and in reverse order (last argument first). +-- This allows the last argument to be multi-line without forcing the +-- preceding arguments to be multiline. This also allows other arguments to be multi-line as long +-- all remaining arguments fit onto a single line together +-- 3. Callers may inject `pre` and `post` tokens (mostly newlines) into the inside of the group. +-- This means that callers can say "try to be compact first, but if more than the last argument does not fit onto the line, +-- then start on a new line instead". prettyApp :: Bool -> Doc -> Bool -> Expression -> Expression -> Doc prettyApp indentFunction pre hasPost f a = let - absorbApp (Application f' a') = (group $ absorbApp f') <> line <> (nest (group 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 | otherwise = pretty expr @@ -333,7 +336,7 @@ prettyApp indentFunction pre hasPost f a ((\(Ann leading token trailing') -> (Ann [] token trailing', leading)) . moveTrailingCommentUp) f - renderedF = pre <> group (absorbApp fWithoutComment) + renderedF = pre <> group' Transparent (absorbApp fWithoutComment) renderedFUnexpanded = unexpandSpacing' Nothing renderedF post = if hasPost then line' else mempty diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 1c7b6c17..e2827911 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -70,15 +70,10 @@ mapAttrsToStringsSep "\n" mkSection attrsOfAttrs; } [ - (mapAttrsToStringsSep - [ - force - long - ] - "\n" - mkSection - attrsOfAttrs - ) + (mapAttrsToStringsSep [ + force + long + ] "\n" mkSection attrsOfAttrs) ] (a b) ((a b) (a b) @@ -96,20 +91,18 @@ otherModules=${ pkgs.writeText "other-modules.json" ( l.toJSON ( - l.mapAttrs - ( - pname: subOutputs: - let - pkg = subOutputs.packages."${pname}".overrideAttrs ( - old: { - buildScript = "true"; - installMethod = "copy"; - } - ); - in - "${pkg}/lib/node_modules/${pname}/node_modules" - ) - outputs.subPackages + l.mapAttrs ( + pname: subOutputs: + let + pkg = subOutputs.packages."${pname}".overrideAttrs ( + old: { + buildScript = "true"; + installMethod = "copy"; + } + ); + in + "${pkg}/lib/node_modules/${pname}/node_modules" + ) outputs.subPackages ) ) } @@ -124,56 +117,37 @@ { name1 = function arg { asdf = 1; }; - name2 = - function arg - { - asdf = 1; - # multiline - } - argument; + name2 = function arg { + asdf = 1; + # multiline + } argument; - name3 = - function arg - { - asdf = 1; - # multiline - } - { qwer = 12345; } - argument; + name3 = function arg { + asdf = 1; + # multiline + } { qwer = 12345; } argument; } { - name4 = - function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - argument; + name4 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } argument; } { - option1 = - function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - lastArg; + option1 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } lastArg; - option2 = - function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - lastArg; + option2 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } lastArg; - option3 = - function arg { asdf = 1; } - { - qwer = 12345; - qwer2 = 54321; - } - lastArg; + option3 = function arg { asdf = 1; } { + qwer = 12345; + qwer2 = 54321; + } lastArg; } # https://github.com/kamadorueda/alejandra/issues/372#issuecomment-1435083516 { @@ -215,28 +189,23 @@ 3 # multiline ]; looooooooong = ( - toINI - { - inherit - mkSectionName - mkKeyValue - listsAsDuplicateKeys - aaaaaaaa - ; - } - sections + toINI { + inherit + mkSectionName + mkKeyValue + listsAsDuplicateKeys + aaaaaaaa + ; + } sections ); - looooooooong' = - toINI - { - inherit - mkSectionName - mkKeyValue - listsAsDuplicateKeys - aaaaaaaa - ; - } - sections; + looooooooong' = toINI { + inherit + mkSectionName + mkKeyValue + listsAsDuplicateKeys + aaaaaaaa + ; + } sections; } # Test breakup behavior at different line lengths diff --git a/test/diff/assert/out.nix b/test/diff/assert/out.nix index a17f7d32..3760f374 100644 --- a/test/diff/assert/out.nix +++ b/test/diff/assert/out.nix @@ -86,10 +86,9 @@ "For valid subpath \"${str}\", appending to an absolute Nix path value gives \"${absConcatOrig}\", but appending the normalised result \"${tryOnce.value}\" gives a different value \"${absConcatNormalised}\""; assert lib.assertMsg (strw <= width) "fixedWidthString: requested string length (${toString width}) must not be shorter than actual length (${toString strw})"; - assert lib.foldl - (pass: { assertion, message }: if assertion final then pass else throw message) - true - (final.parsed.abi.assertions or [ ]); + assert lib.foldl ( + pass: { assertion, message }: if assertion final then pass else throw message + ) true (final.parsed.abi.assertions or [ ]); assert getErrors { nixpkgs.localSystem = pkgs.stdenv.hostPlatform; diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index a0935609..fd5563b4 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -166,32 +166,27 @@ } { programs.ssh.knownHosts = - lib.mapAttrs - (host_name: publicKey: { - inherit publicKey; - extraHostNames = [ - "${host_name}.m-0.eu" - "${host_name}.vpn.m-0.eu" - "${host_name}.lo.m-0.eu" - ]; - }) - secret-config.ssh-hosts + lib.mapAttrs (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) secret-config.ssh-hosts // { foo = "bar"; }; programs.ssh.knownHosts2 = someStuff - // - lib.mapAttrs - (host_name: publicKey: { - inherit publicKey; - extraHostNames = [ - "${host_name}.m-0.eu" - "${host_name}.vpn.m-0.eu" - "${host_name}.lo.m-0.eu" - ]; - }) - secret-config.ssh-hosts + // lib.mapAttrs (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) secret-config.ssh-hosts // { foo = "bar"; }; @@ -238,16 +233,14 @@ ); programs.ssh.knownHosts6 = someStuff - // lib.mapAttrs - (host_name: publicKey: { - inherit publicKey; - extraHostNames = [ - "${host_name}.m-0.eu" - "${host_name}.vpn.m-0.eu" - "${host_name}.lo.m-0.eu" - ]; - }) - secret-config.ssh-hosts; + // lib.mapAttrs (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) secret-config.ssh-hosts; programs.ssh.knownHosts7 = someStuff # multiline // lib.mapAttrs ( @@ -262,16 +255,14 @@ ); programs.ssh.knownHosts8 = someStuff # multiline - // lib.mapAttrs - (host_name: publicKey: { - inherit publicKey; - extraHostNames = [ - "${host_name}.m-0.eu" - "${host_name}.vpn.m-0.eu" - "${host_name}.lo.m-0.eu" - ]; - }) - secret-config.ssh-hosts; + // lib.mapAttrs (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) secret-config.ssh-hosts; programs.ssh.knownHosts9 = { multi = 1; @@ -292,16 +283,14 @@ multi = 1; line = 2; } - // lib.mapAttrs - (host_name: publicKey: { - inherit publicKey; - extraHostNames = [ - "${host_name}.m-0.eu" - "${host_name}.vpn.m-0.eu" - "${host_name}.lo.m-0.eu" - ]; - }) - secret-config.ssh-hosts; + // lib.mapAttrs (host_name: publicKey: { + inherit publicKey; + extraHostNames = [ + "${host_name}.m-0.eu" + "${host_name}.vpn.m-0.eu" + "${host_name}.lo.m-0.eu" + ]; + }) secret-config.ssh-hosts; } # Parentheses diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index b8d30794..f5f83d72 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -131,12 +131,10 @@ rec { # apply transformations (e.g. escapes) to section names mkSectionName ? ( name: - libStr.escape - [ - "[" - "]" - ] - name + libStr.escape [ + "[" + "]" + ] name ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", @@ -194,12 +192,10 @@ rec { # apply transformations (e.g. escapes) to section names mkSectionName ? ( name: - libStr.escape - [ - "[" - "]" - ] - name + libStr.escape [ + "[" + "]" + ] name ), # format a setting line from key and value mkKeyValue ? mkKeyValueDefault { } "=", @@ -428,8 +424,9 @@ rec { let fna = lib.functionArgs v; showFnas = concatStringsSep ", " ( - libAttr.mapAttrsToList (name: hasDefVal: if hasDefVal then name + "?" else name) - fna + libAttr.mapAttrsToList ( + name: hasDefVal: if hasDefVal then name + "?" else name + ) fna ); in if fna == { } then "" else "" @@ -445,16 +442,14 @@ rec { "{" + introSpace + libStr.concatStringsSep introSpace ( - libAttr.mapAttrsToList - ( - name: value: - "${libStr.escapeNixIdentifier name} = ${ - builtins.addErrorContext "while evaluating an attribute `${name}`" ( - go (indent + " ") value - ) - };" - ) - v + libAttr.mapAttrsToList ( + name: value: + "${libStr.escapeNixIdentifier name} = ${ + builtins.addErrorContext "while evaluating an attribute `${name}`" ( + go (indent + " ") value + ) + };" + ) v ) + outroSpace + "}" @@ -524,15 +519,13 @@ rec { ind: x: libStr.concatStringsSep "\n" ( lib.flatten ( - lib.mapAttrsToList - ( - name: value: - lib.optionals (attrFilter name value) [ - (key " ${ind}" name) - (expr " ${ind}" value) - ] - ) - x + lib.mapAttrsToList ( + name: value: + lib.optionals (attrFilter name value) [ + (key " ${ind}" name) + (expr " ${ind}" value) + ] + ) x ) ); in diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index fcf413f5..75f1467d 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -919,10 +919,9 @@ rec { }@sys: assert isSystem sys; let - optExecFormat = - lib.optionalString - (kernel.name == "netbsd" && gnuNetBSDDefaultExecFormat cpu != kernel.execFormat) - kernel.execFormat.name; + optExecFormat = lib.optionalString ( + kernel.name == "netbsd" && gnuNetBSDDefaultExecFormat cpu != kernel.execFormat + ) kernel.execFormat.name; optAbi = lib.optionalString (abi != abis.unknown) "-${abi.name}"; in "${cpu.name}-${vendor.name}-${kernelName kernel}${optExecFormat}${optAbi}"; diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index c98343fa..158e55a6 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -245,9 +245,9 @@ let let expectedOutputs = attrs.meta.outputsToInstall or [ ]; actualOutputs = attrs.outputs or [ "out" ]; - missingOutputs = - builtins.filter (output: !builtins.elem output actualOutputs) - expectedOutputs; + missingOutputs = builtins.filter ( + output: !builtins.elem output actualOutputs + ) expectedOutputs; in '' The package ${getName attrs} has set meta.outputsToInstall to: ${builtins.concatStringsSep ", " expectedOutputs} @@ -401,9 +401,9 @@ let let expectedOutputs = attrs.meta.outputsToInstall or [ ]; actualOutputs = attrs.outputs or [ "out" ]; - missingOutputs = - builtins.filter (output: !builtins.elem output actualOutputs) - expectedOutputs; + missingOutputs = builtins.filter ( + output: !builtins.elem output actualOutputs + ) expectedOutputs; in if config.checkMeta then builtins.length missingOutputs > 0 else false; diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index 22225f2f..de2def62 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -379,12 +379,10 @@ in let cfg = config.boot.kernelPackages.kernel.config; in - map - (attrs: { - assertion = attrs.assertion cfg; - inherit (attrs) message; - }) - config.system.requiredKernelConfig; + map (attrs: { + assertion = attrs.assertion cfg; + inherit (attrs) message; + }) config.system.requiredKernelConfig; }) ]; } diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index 6d0a69ef..a70156de 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -871,8 +871,9 @@ in ${optionalString (s3.region != null) "'region' => '${s3.region}',"} 'use_path_style' => ${boolToString s3.usePathStyle}, ${ - optionalString (s3.sseCKeyFile != null) - "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," + optionalString ( + s3.sseCKeyFile != null + ) "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," } ], ] @@ -929,16 +930,18 @@ in 'log_type' => '${cfg.logType}', 'loglevel' => '${builtins.toString cfg.logLevel}', ${ - optionalString (c.overwriteProtocol != null) - "'overwriteprotocol' => '${c.overwriteProtocol}'," + optionalString ( + c.overwriteProtocol != null + ) "'overwriteprotocol' => '${c.overwriteProtocol}'," } ${optionalString (c.dbname != null) "'dbname' => '${c.dbname}',"} ${optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}',"} ${optionalString (c.dbport != null) "'dbport' => '${toString c.dbport}',"} ${optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}',"} ${ - optionalString (c.dbtableprefix != null) - "'dbtableprefix' => '${toString c.dbtableprefix}'," + optionalString ( + c.dbtableprefix != null + ) "'dbtableprefix' => '${toString c.dbtableprefix}'," } ${ optionalString (c.dbpassFile != null) '' @@ -953,8 +956,9 @@ in }, 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, ${ - optionalString (c.defaultPhoneRegion != null) - "'default_phone_region' => '${c.defaultPhoneRegion}'," + optionalString ( + c.defaultPhoneRegion != null + ) "'default_phone_region' => '${c.defaultPhoneRegion}'," } ${optionalString (nextcloudGreaterOrEqualThan "23") "'profile.enabled' => ${boolToString cfg.globalProfiles},"} ${objectstoreConfig} @@ -1010,12 +1014,10 @@ in ${installFlags} ''; occSetTrustedDomainsCmd = concatStringsSep "\n" ( - imap0 - (i: v: '' - ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ - ${toString i} --value="${toString v}" - '') - ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) + imap0 (i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) ); in { diff --git a/test/diff/idioms_pkgs_3/out.nix b/test/diff/idioms_pkgs_3/out.nix index 58159b28..235289f5 100644 --- a/test/diff/idioms_pkgs_3/out.nix +++ b/test/diff/idioms_pkgs_3/out.nix @@ -222,12 +222,10 @@ let defaultPrefsFile = pkgs.writeText "nixos-default-prefs.js" ( lib.concatStringsSep "\n" ( - lib.mapAttrsToList - (key: value: '' - // ${value.reason} - pref("${key}", ${builtins.toJSON value.value}); - '') - defaultPrefs + lib.mapAttrsToList (key: value: '' + // ${value.reason} + pref("${key}", ${builtins.toJSON value.value}); + '') defaultPrefs ) ); in @@ -410,13 +408,10 @@ buildStdenv.mkDerivation ({ ] # elf-hack is broken when using clang+lld: # https://bugzilla.mozilla.org/show_bug.cgi?id=1482204 - ++ - lib.optional - ( - ltoSupport - && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64) - ) - "--disable-elf-hack" + ++ lib.optional ( + ltoSupport + && (buildStdenv.isAarch32 || buildStdenv.isi686 || buildStdenv.isx86_64) + ) "--disable-elf-hack" ++ lib.optional (!drmSupport) "--disable-eme" ++ [ (enableFeature alsaSupport "alsa") diff --git a/test/diff/idioms_pkgs_5/out.nix b/test/diff/idioms_pkgs_5/out.nix index 04bd0273..25825c7d 100644 --- a/test/diff/idioms_pkgs_5/out.nix +++ b/test/diff/idioms_pkgs_5/out.nix @@ -97,23 +97,21 @@ let # but pre-evaluated for a slight improvement in performance. makeDerivationExtensibleConst = attrs: - mkDerivationSimple - ( - f0: - let - f = - self: super: - let - x = f0 super; - in - if builtins.isFunction x then f0 self super else x; - in - makeDerivationExtensible ( - self: - attrs // (if builtins.isFunction f0 || f0 ? __functor then f self attrs else f0) - ) + mkDerivationSimple ( + f0: + let + f = + self: super: + let + x = f0 super; + in + if builtins.isFunction x then f0 self super else x; + in + makeDerivationExtensible ( + self: + attrs // (if builtins.isFunction f0 || f0 ? __functor then f self attrs else f0) ) - attrs; + ) attrs; mkDerivationSimple = overrideAttrs: @@ -432,9 +430,9 @@ let ++ concatLists dependencies ); - computedPropagatedSandboxProfile = - concatMap (input: input.__propagatedSandboxProfile or [ ]) - (concatLists propagatedDependencies); + computedPropagatedSandboxProfile = concatMap ( + input: input.__propagatedSandboxProfile or [ ] + ) (concatLists propagatedDependencies); computedImpureHostDeps = unique ( concatMap (input: input.__propagatedImpureHostDeps or [ ]) ( @@ -479,10 +477,9 @@ let # suffix. But we have some weird ones with run-time deps that are # just used for their side-affects. Those might as well since the # hash can't be the same. See #32986. - hostSuffix = - optionalString - (stdenv.hostPlatform != stdenv.buildPlatform && !dontAddHostSuffix) - "-${stdenv.hostPlatform.config}"; + hostSuffix = optionalString ( + stdenv.hostPlatform != stdenv.buildPlatform && !dontAddHostSuffix + ) "-${stdenv.hostPlatform.config}"; # Disambiguate statically built packages. This was originally # introduce as a means to prevent nix-env to get confused between @@ -496,8 +493,9 @@ let attrs.name + hostSuffix else # we cannot coerce null to a string below - assert assertMsg (attrs ? version && attrs.version != null) - "The ‘version’ attribute cannot be null."; + assert assertMsg ( + attrs ? version && attrs.version != null + ) "The ‘version’ attribute cannot be null."; "${attrs.pname}${staticMarker}${hostSuffix}-${attrs.version}" ); }) @@ -629,12 +627,9 @@ let enableParallelChecking = attrs.enableParallelChecking or true; enableParallelInstalling = attrs.enableParallelInstalling or true; } - // - optionalAttrs - ( - hardeningDisable != [ ] || hardeningEnable != [ ] || stdenv.hostPlatform.isMusl - ) - { NIX_HARDENING_ENABLE = enabledHardeningOptions; } + // optionalAttrs ( + hardeningDisable != [ ] || hardeningEnable != [ ] || stdenv.hostPlatform.isMusl + ) { NIX_HARDENING_ENABLE = enabledHardeningOptions; } // optionalAttrs (stdenv.hostPlatform.isx86_64 && stdenv.hostPlatform ? gcc.arch) { @@ -726,74 +721,70 @@ let "When using structured attributes, `env` must be an attribute set of environment variables."; assert assertMsg (overlappingNames == [ ]) "The ‘env’ attribute set cannot contain any attributes passed to derivation. The following attributes are overlapping: ${concatStringsSep ", " overlappingNames}"; - mapAttrs - ( - n: v: - assert assertMsg (isString v || isBool v || isInt v || isDerivation v) - "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${builtins.typeOf v}."; - v - ) - env; + mapAttrs ( + n: v: + assert assertMsg (isString v || isBool v || isInt v || isDerivation v) + "The ‘env’ attribute set can only contain derivation, string, boolean or integer attributes. The ‘${n}’ attribute is of type ${builtins.typeOf v}."; + v + ) env; in - extendDerivation validity.handled - ( - { - # A derivation that always builds successfully and whose runtime - # dependencies are the original derivations build time dependencies - # This allows easy building and distributing of all derivations - # needed to enter a nix-shell with - # nix-build shell.nix -A inputDerivation - inputDerivation = derivation ( - derivationArg - // { - # Add a name in case the original drv didn't have one - name = derivationArg.name or "inputDerivation"; - # This always only has one output - outputs = [ "out" ]; - - # Propagate the original builder and arguments, since we override - # them and they might contain references to build inputs - _derivation_original_builder = derivationArg.builder; - _derivation_original_args = derivationArg.args; - - builder = stdenv.shell; - # The bash builtin `export` dumps all current environment variables, - # which is where all build input references end up (e.g. $PATH for - # binaries). By writing this to $out, Nix can find and register - # them as runtime dependencies (since Nix greps for store paths - # through $out to find them) - args = [ - "-c" - '' - export > $out - for var in $passAsFile; do - pathVar="''${var}Path" - printf "%s" "$(< "''${!pathVar}")" >> $out - done - '' - ]; + extendDerivation validity.handled ( + { + # A derivation that always builds successfully and whose runtime + # dependencies are the original derivations build time dependencies + # This allows easy building and distributing of all derivations + # needed to enter a nix-shell with + # nix-build shell.nix -A inputDerivation + inputDerivation = derivation ( + derivationArg + // { + # Add a name in case the original drv didn't have one + name = derivationArg.name or "inputDerivation"; + # This always only has one output + outputs = [ "out" ]; + + # Propagate the original builder and arguments, since we override + # them and they might contain references to build inputs + _derivation_original_builder = derivationArg.builder; + _derivation_original_args = derivationArg.args; + + builder = stdenv.shell; + # The bash builtin `export` dumps all current environment variables, + # which is where all build input references end up (e.g. $PATH for + # binaries). By writing this to $out, Nix can find and register + # them as runtime dependencies (since Nix greps for store paths + # through $out to find them) + args = [ + "-c" + '' + export > $out + for var in $passAsFile; do + pathVar="''${var}Path" + printf "%s" "$(< "''${!pathVar}")" >> $out + done + '' + ]; - # inputDerivation produces the inputs; not the outputs, so any - # restrictions on what used to be the outputs don't serve a purpose - # anymore. - allowedReferences = null; - allowedRequisites = null; - disallowedReferences = [ ]; - disallowedRequisites = [ ]; - } - ); + # inputDerivation produces the inputs; not the outputs, so any + # restrictions on what used to be the outputs don't serve a purpose + # anymore. + allowedReferences = null; + allowedRequisites = null; + disallowedReferences = [ ]; + disallowedRequisites = [ ]; + } + ); - inherit passthru overrideAttrs; - inherit meta; - } - // - # Pass through extra attributes that are not inputs, but - # should be made available to Nix expressions using the - # derivation (e.g., in assertions). - passthru - ) - (derivation (derivationArg // optionalAttrs envIsExportable checkedEnv)); + inherit passthru overrideAttrs; + inherit meta; + } + // + # Pass through extra attributes that are not inputs, but + # should be made available to Nix expressions using the + # derivation (e.g., in assertions). + passthru + ) (derivation (derivationArg // optionalAttrs envIsExportable checkedEnv)); in fnOrAttrs: if builtins.isFunction fnOrAttrs then diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index 0b3a7a91..ed65b6bf 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -12,9 +12,9 @@ description = "${ optionDescriptionPhrase (class: class == "noun" || class == "conjunction") t1 } or ${ - optionDescriptionPhrase - (class: class == "noun" || class == "conjunction" || class == "composite") - t2 + optionDescriptionPhrase ( + class: class == "noun" || class == "conjunction" || class == "composite" + ) t2 }"; ruleset = '' table ip nat { @@ -24,23 +24,19 @@ ${ builtins.concatStringsSep "\n" ( - map - ( - e: - "iifname \"${cfg.upstreamIface}\" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" - ) - tcpPortMap + map ( + e: + "iifname \"${cfg.upstreamIface}\" tcp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" + ) tcpPortMap ) } ${ builtins.concatStringsSep "\n" ( - map - ( - e: - "ifname \"${cfg.upstreamIface}\" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" - ) - udpPortMap + map ( + e: + "ifname \"${cfg.upstreamIface}\" udp dport ${builtins.toString e.sourcePort} dnat to ${e.destination}" + ) udpPortMap ) } } From a273a4780b761b76ec5b9f7cbdc44951f1d9a0ba Mon Sep 17 00:00:00 2001 From: piegames Date: Wed, 7 Feb 2024 12:44:15 +0100 Subject: [PATCH 108/125] Add some tests --- test/diff/apply/in.nix | 6 ++++ test/diff/apply/out.nix | 4 +++ test/diff/comment/in.nix | 65 +++++++++++++++++++++++++++++++++++++++ test/diff/comment/out.nix | 56 +++++++++++++++++++++++++++++++++ 4 files changed, 131 insertions(+) diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index 6611984f..a80d20d0 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -306,4 +306,10 @@ ) ); } + ( + function ( + something + # ... + ) { } + ) ] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index e2827911..c5189553 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -353,4 +353,8 @@ ) ); } + (function ( + something + # ... + ) { }) ] diff --git a/test/diff/comment/in.nix b/test/diff/comment/in.nix index 7ed19e54..a3f2bfa5 100644 --- a/test/diff/comment/in.nix +++ b/test/diff/comment/in.nix @@ -42,6 +42,71 @@ * test */ + /* + * FOO + */ + + /** + * FOO + */ + + /* + * FOO + * BAR + */ + + /** + Concatenate a list of strings with a separator between each element + + # Example + + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` + + # Type + + ``` + concatStringsSep :: string -> [string] -> string + ``` + */ + + /* + Concatenate a list of strings with a separator between each element + + # Example + + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` + + # Type + + ``` + concatStringsSep :: string -> [string] -> string + ``` + */ + + /* + * Concatenate a list of strings with a separator between each element + * + * # Example + * + * ```nix + * concatStringsSep "/" ["usr" "local" "bin"] + * => "usr/local/bin" + * ``` + * + * # Type + * + * ``` + * concatStringsSep :: string -> [string] -> string + * ``` + */ + + [ # 1 #2 a # 3 diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index d3f0cf3d..674ded91 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -30,6 +30,62 @@ # test # test + # * FOO + + # + # FOO + + # FOO + # BAR + + /* * + Concatenate a list of strings with a separator between each element + + # Example + + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` + + # Type + + ``` + concatStringsSep :: string -> [string] -> string + ``` + */ + + /* Concatenate a list of strings with a separator between each element + + # Example + + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` + + # Type + + ``` + concatStringsSep :: string -> [string] -> string + ``` + */ + + # Concatenate a list of strings with a separator between each element + # + # # Example + # + # ```nix + # concatStringsSep "/" ["usr" "local" "bin"] + # => "usr/local/bin" + # ``` + # + # # Type + # + # ``` + # concatStringsSep :: string -> [string] -> string + # ``` + [ # 1 #2 From 9ec2ac0d18b087133b1454a2f5e4daede4780f07 Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 24 Feb 2024 11:37:40 +0100 Subject: [PATCH 109/125] If: Move trailing comments around --- src/Nixfmt/Pretty.hs | 7 +++++-- test/diff/if_else/out.nix | 16 ++++++++++------ 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index dd95e186..900943d9 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -495,7 +495,10 @@ instance Pretty Expression where insertIntoApp insert other = (insert, other) pretty expr@(If _ _ _ _ _ _) - = group' RegularG $ prettyIf line expr + -- 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. + = group' RegularG $ prettyIf line $ mapFirstToken moveTrailingCommentUp expr where -- Recurse to absorb nested "else if" chains prettyIf :: Doc -> Expression -> Doc @@ -504,7 +507,7 @@ instance Pretty Expression where = group (pretty if_ <> line <> nest (pretty cond) <> line <> pretty then_) <> (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 else_ <> hardspace <> prettyIf hardline expr1 + <> pretty (moveTrailingCommentUp else_) <> hardspace <> prettyIf hardline expr1 prettyIf _ x = line <> nest (group x) diff --git a/test/diff/if_else/out.nix b/test/diff/if_else/out.nix index a30e7e2e..479cd610 100644 --- a/test/diff/if_else/out.nix +++ b/test/diff/if_else/out.nix @@ -13,19 +13,23 @@ (if ./a then b else c) (if a then b else c) ( - if # test + # test + if a # test then # test b # test - else # test + # test + else c ) ( - if # test + # test + if a # test then # test b # test - else # test + # test + else c ) ( @@ -77,8 +81,8 @@ b else if a then b - else # x - if a then + # x + else if a then b else c From aa85d38dd853d4d7a40ce535a117ed187568eb04 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 26 Feb 2024 16:13:52 +0100 Subject: [PATCH 110/125] Predoc: Prevent trailing whitespace on lines --- src/Nixfmt/Predoc.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index f3b59011..0f5a3380 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -313,6 +313,8 @@ fixup [] = [] fixup (Spacing a : Spacing b : xs) = fixup $ Spacing (mergeSpacings a b) : xs -- Merge consecutive texts. Take indentation and offset from the left one fixup (Text level off ann a : Text _ _ ann' b : xs) | ann == ann' = fixup $ Text level off ann (a <> b) : xs +-- Move/Merge hard spaces into groups +fixup ((Spacing Hardspace) : Group ann xs : ys) = fixup $ Group ann (Spacing Hardspace:xs) : ys -- Handle group, with stuff in front of it to potentially merge with fixup (a@(Spacing _) : Group ann xs : ys) = let From d531cef982d8d304853f7a79c6104f6d127f51c5 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Feb 2024 21:07:41 +0100 Subject: [PATCH 111/125] With: Don't absorb when there is a trailing comment --- src/Nixfmt/Pretty.hs | 16 ++++++++++------ test/diff/idioms/out.nix | 3 ++- test/diff/with/out.nix | 3 ++- 3 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 900943d9..fd65a0cc 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -353,14 +353,18 @@ prettyApp indentFunction pre hasPost f a prettyWith :: Bool -> Expression -> Doc -- absorb the body prettyWith True (With with expr0 semicolon (Term expr1)) - = pretty with <> hardspace - <> nest (group expr0) <> pretty semicolon - -- Force-expand attrsets - <> hardspace <> prettyTermWide expr1 + = group' RegularG $ + line' <> + pretty with <> hardspace + <> nest (group expr0) <> pretty semicolon + -- Force-expand attrsets + <> hardspace <> group' Priority (prettyTermWide expr1) -- Normal case prettyWith _ (With with expr0 semicolon expr1) - = pretty with <> hardspace - <> nest (group expr0) <> pretty semicolon + = group ( + pretty with <> hardspace + <> nest (group expr0) <> pretty semicolon + ) <> line <> pretty expr1 prettyWith _ _ = error "unreachable" diff --git a/test/diff/idioms/out.nix b/test/diff/idioms/out.nix index 6adb1290..e03bc506 100644 --- a/test/diff/idioms/out.nix +++ b/test/diff/idioms/out.nix @@ -8,7 +8,8 @@ } { - meta = with lib; + meta = + with lib; # comment { a = 1; diff --git a/test/diff/with/out.nix b/test/diff/with/out.nix index 9e20012e..9c71920b 100644 --- a/test/diff/with/out.nix +++ b/test/diff/with/out.nix @@ -31,7 +31,8 @@ }; } { - a = with b; # comment + a = + with b; # comment [ 1 2 From 8f4bf7ecec1a338e1eb39a112368da6521656ca1 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 26 Feb 2024 16:16:25 +0100 Subject: [PATCH 112/125] Abstraction: Don't absorb when there is a trailing comment --- src/Nixfmt/Pretty.hs | 4 ++-- test/diff/idioms_lib_3/out.nix | 3 +-- test/diff/key_value/out.nix | 10 +++++----- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index fd65a0cc..e38a5fd1 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -517,13 +517,13 @@ instance Pretty Expression where -- Simple parameter pretty (Abstraction (IDParameter param) colon body) - = pretty param <> pretty colon <> absorbAbs 1 body + = group' RegularG $ line' <> pretty param <> pretty colon <> absorbAbs 1 body where absorbAbs :: Int -> Expression -> Doc -- If there are multiple ID parameters to that function, treat them all at once absorbAbs depth (Abstraction (IDParameter param0) colon0 body0) = hardspace <> pretty param0 <> pretty colon0 <> absorbAbs (depth + 1) body0 - absorbAbs _ expr | isAbsorbableExpr expr = hardspace <> absorbExpr False expr + absorbAbs _ expr | isAbsorbableExpr expr = hardspace <> group' Priority (absorbExpr False expr) -- Force the content onto a new line when it is not absorbable and there are more than two arguments absorbAbs depth x = (if depth <= 2 then line else hardline) <> pretty x diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index f5f83d72..eed1ae66 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -266,8 +266,7 @@ rec { else { ${head path} = value; }; in - attrs: - lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); + attrs: lib.foldl lib.recursiveUpdate { } (lib.flatten (recurse [ ] attrs)); toINI_ = toINI { inherit mkKeyValue mkSectionName; }; in diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index f31a78da..033cbdc3 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -46,11 +46,11 @@ rec { b = 1; c = 2; }; - l = a: # b - { - b = 1; - }; - m = a: # b + l = + a: # b + { b = 1; }; + m = + a: # b { b = 1; c = 2; From 3b95476a827c16a7a2c14e95dc8a7dee13d5d494 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 26 Feb 2024 16:45:01 +0100 Subject: [PATCH 113/125] Binding: Small refactoring & add test --- src/Nixfmt/Pretty.hs | 29 ++++++++++++----------------- test/diff/attr_set/in.nix | 15 +++++++++++++++ test/diff/attr_set/out.nix | 17 +++++++++++++++++ 3 files changed, 44 insertions(+), 17 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index e38a5fd1..deae64d2 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -424,32 +424,27 @@ absorbRHS expr = case expr of -- 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 - -- Special case `//` operations to be more compact in some cases + -- 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 [] TUpdate Nothing) b) | isAbsorbable t -> - group' RegularG $ line <> group' Priority (prettyTermWide t) <> line <> pretty TUpdate <> hardspace <> pretty b + (Operation (Term t) (Ann [] op Nothing) b) | isAbsorbable t && isUpdateOrConcat op -> + group' RegularG $ line <> group' Priority (prettyTermWide t) <> line <> pretty op <> hardspace <> pretty b -- Case 2a: LHS fits onto first line, RHS is an absorbable term - (Operation l (Ann [] TUpdate Nothing) (Term t)) | isAbsorbable t -> - group' RegularG $ line <> pretty l <> line <> group' Priority (pretty TUpdate <> hardspace <> prettyTermWide t) + (Operation l (Ann [] op Nothing) (Term t)) | isAbsorbable t && isUpdateOrConcat op -> + group' RegularG $ line <> pretty l <> line <> group' Priority (pretty op <> hardspace <> prettyTermWide t) -- Case 2b: LHS fits onto first line, RHS is a function application - (Operation l (Ann [] TUpdate Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp False (pretty TUpdate <> hardspace) False f a - -- Special case `++` 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 [] TConcat Nothing) b) | isAbsorbable t -> - group' RegularG $ line <> group' Priority (prettyTermWide t) <> line <> pretty TConcat <> hardspace <> pretty b - -- Case 2a: LHS fits onto first line, RHS is an absorbable term - (Operation l (Ann [] TConcat Nothing) (Term t)) | isAbsorbable t -> - group' RegularG $ line <> pretty l <> line <> group' Priority (pretty TConcat <> hardspace <> prettyTermWide t) - -- Case 2b: LHS fits onto first line, RHS is a function application - (Operation l (Ann [] TConcat Nothing) (Application f a)) -> - line <> (group l) <> line <> prettyApp False (pretty TConcat <> hardspace) False f a + (Operation l (Ann [] op Nothing) (Application f a)) | isUpdateOrConcat op -> + 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) -- Otherwise, start on new line, expand fully (including the semicolon) _ -> line <> group expr + where + isUpdateOrConcat TUpdate = True + isUpdateOrConcat TConcat = True + isUpdateOrConcat _ = False + instance Pretty Expression where pretty (Term t) = pretty t diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index 2fe8a921..36ceab67 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -249,4 +249,19 @@ c = (with a; if null then true else false); d = (with a; let in [ 1 2 3]); } + + # Comments + { + fontsForXServer = config.fonts.fonts ++ + # We don't want these fonts in fonts.conf, because then modern, + # fontconfig-based applications will get horrible bitmapped + # Helvetica fonts. It's better to get a substitution (like Nimbus + # Sans) than that horror. But we do need the Adobe fonts for some + # old non-fontconfig applications. (Possibly this could be done + # better using a fontconfig rule.) + [ + pkgs.xorg.fontadobe100dpi + pkgs.xorg.fontadobe75dpi + ]; + } ] diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index fd5563b4..7d38543f 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -348,4 +348,21 @@ ] ); } + + # Comments + { + fontsForXServer = + config.fonts.fonts + ++ + # We don't want these fonts in fonts.conf, because then modern, + # fontconfig-based applications will get horrible bitmapped + # Helvetica fonts. It's better to get a substitution (like Nimbus + # Sans) than that horror. But we do need the Adobe fonts for some + # old non-fontconfig applications. (Possibly this could be done + # better using a fontconfig rule.) + [ + pkgs.xorg.fontadobe100dpi + pkgs.xorg.fontadobe75dpi + ]; + } ] From bcbf8c659748466ef7aa7ecad399c864e31b9ef3 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 26 Feb 2024 16:49:17 +0100 Subject: [PATCH 114/125] Binding: Don't absorb // and ++ when there is a trailing comment --- src/Nixfmt/Pretty.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index deae64d2..5e018a11 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -430,7 +430,7 @@ absorbRHS expr = case expr of group' RegularG $ line <> group' Priority (prettyTermWide t) <> line <> pretty op <> hardspace <> pretty b -- Case 2a: LHS fits onto first line, RHS is an absorbable term (Operation l (Ann [] op Nothing) (Term t)) | isAbsorbable t && isUpdateOrConcat op -> - group' RegularG $ line <> pretty l <> line <> group' Priority (pretty op <> hardspace <> prettyTermWide t) + 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 From d6902b04ec0d77ed07e355c69f4ef2ad2fa04939 Mon Sep 17 00:00:00 2001 From: piegames Date: Sun, 25 Feb 2024 20:17:35 +0100 Subject: [PATCH 115/125] Fix indentation --- src/Nixfmt/Predoc.hs | 94 +++++------ src/Nixfmt/Pretty.hs | 6 +- test/diff/apply/out.nix | 2 +- test/diff/idioms_lib_4/out.nix | 2 +- test/diff/key_value/out.nix | 12 +- test/diff/monsters_1/out.nix | 288 ++++++++++++++++----------------- test/diff/monsters_4/out.nix | 194 +++++++++++----------- test/diff/monsters_5/out.nix | 246 ++++++++++++++-------------- test/diff/pattern/out.nix | 20 +-- 9 files changed, 432 insertions(+), 432 deletions(-) diff --git a/src/Nixfmt/Predoc.hs b/src/Nixfmt/Predoc.hs index 0f5a3380..4ddd106a 100644 --- a/src/Nixfmt/Predoc.hs +++ b/src/Nixfmt/Predoc.hs @@ -37,16 +37,18 @@ module Nixfmt.Predoc ) where import Data.List (intersperse) +import qualified Data.List.NonEmpty as NonEmpty +import Data.List.NonEmpty (NonEmpty(..), singleton, (<|)) import Data.Function ((&)) import Data.Functor ((<&>), ($>)) import Data.Functor.Identity (runIdentity) -import Data.Bifunctor (second) +import Data.Bifunctor (first, second) import Data.Maybe (fromMaybe) import Data.Text as Text (Text, concat, length, replicate, strip) import GHC.Stack (HasCallStack) -- import Debug.Trace (traceShow, traceShowId) import Control.Applicative ((<|>), asum, empty) -import Control.Monad.Trans.State.Strict (State, StateT, StateT(..), mapStateT, state, runState, evalState, get, put) +import Control.Monad.Trans.State.Strict (State, StateT, StateT(..), mapStateT, state, runState, evalState, get, put, modify) -- | Sequential Spacings are reduced to a single Spacing by taking the maximum. -- This means that e.g. a Space followed by an Emptyline results in just an @@ -109,7 +111,7 @@ data TextAnn = RegularT | Comment | TrailingComment | Trailing -- | Single document element. Documents are modeled as lists of these elements -- in order to make concatenation simple. data DocE = - -- indent level, offset, kind, text + -- nesting depth, offset, kind, text Text Int Int TextAnn Text | Spacing Spacing | Group GroupAnn Doc @@ -172,28 +174,26 @@ group x = pure . (Group RegularG) $ group' :: Pretty a => GroupAnn -> a -> Doc group' ann = pure . (Group ann) . pretty --- | @nest doc@ declarse @doc@ to have a higher indentation level +-- | @nest doc@ declarse @doc@ to have a higher nesting depth -- than before. Not all nestings actually result in indentation changes, -- this will be calculated automatically later on. As a rule of thumb: --- Multiple indentation levels on one line will be compacted and only result in a single --- bump for the next line. This prevents excessive indentation. +-- Multiple nesting levels on one line will be compacted and only result in a single +-- indentation bump for the next line. This prevents excessive indentation. nest :: Pretty a => a -> Doc -nest x = go $ pretty x +nest x = map go $ pretty x where - go (Text i o ann t : rest) = (Text (i + 2) o ann t) : go rest - go (Group ann inner : rest) = (Group ann (go inner)) : go rest - go (spacing : rest) = spacing : go rest - go [] = [] + go (Text i o ann t) = Text (i + 1) o ann t + go (Group ann inner) = Group ann (map go inner) + go spacing = spacing -- This is similar to nest, however it circumvents the "smart" rules that usually apply. -- This should only be useful to manage the indentation within indented strings. offset :: Pretty a => Int -> a -> Doc -offset level x = go $ pretty x +offset level x = map go $ pretty x where - go (Text i o ann t : rest) = (Text i (o + level) ann t) : go rest - go (Group ann inner : rest) = (Group ann (go inner)) : go rest - go (spacing : rest) = spacing : go rest - go [] = [] + go (Text i o ann t) = Text i (o + level) ann t + go (Group ann inner) = Group ann (map go inner) + go spacing = spacing -- | Line break or nothing (soft) softline' :: Doc @@ -470,38 +470,38 @@ indent n = Text.replicate n " " -- All state is (cc, indents) -- cc: current column (within the current line, *not including indentation*) -- indents: --- A stack of tuples (realIndent, virtualIndent) +-- A stack of tuples (currentIndent, nestingLevel) -- This is guaranteed to never be empty, as we start with [(0, 0)] and never go below that. -type St = (Int, [(Int, Int)]) +type St = (Int, NonEmpty (Int, Int)) -- tw Target Width layoutGreedy :: Int -> Doc -> Text -layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, [(0, 0)]) +layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, singleton (0, 0)) where + -- Simple helpers around `put` with a tuple state + putL = modify . first . const + putR = modify . second . const + -- Print a given text. If this is the first token on a line, it will -- do the appropriate calculations for indentation and print that in addition to the text. putText :: Int -> Int -> Text -> State St [Text] - putText textVI textOffset t = get >>= - \case - -- Needs indent, but no more than last line - (0, indents@((ci, vi):_)) | textVI == vi -> - go' indents (ci + textOffset) - -- Needs more indent than last line. We only go up by one level every time - (0, indents@((ci, vi):_)) | textVI > vi -> - go' ((ci + 2, textVI):indents) (ci + 2 + textOffset) + putText textNL textOffset t = get >>= + \(cc, indents@((ci, nl) :| indents')) -> + case textNL `compare` nl of + -- Push the textNL onto the stack, but only increase the actual indentation (`ci`) + -- if this is the first one of a line. All subsequent nestings within the line effectively get "swallowed" + GT -> putR ((if cc == 0 then ci + 2 else ci, textNL) <| indents) >> go' -- Need to go down one or more levels -- Just pop from the stack and recurse until the indent matches again - (0, ((_, vi) : indents@((ci, vi'):_))) | textVI < vi -> - if textVI < vi' then - put (0, indents) >> putText textVI textOffset t - else - go' indents (ci + textOffset) - -- Does not need indent (not at start of line) - (cc, indents) -> - put (cc + textWidth t, indents) $> [t] + LT -> putR (NonEmpty.fromList indents') >> putText textNL textOffset t + EQ -> go' where - -- Start a new line - go' indents i = put (textWidth t, indents) $> [indent i, t] + -- Put the text and advance the `cc` cursor. Add the appropriate amount of indentation if this is + -- the first token on a line + go' = do + (cc, (ci, _) :| _) <- get + putL (cc + textWidth t) + pure $ if cc == 0 then [indent (ci + textOffset), t] else [t] -- Simply put text without caring about line-start indentation putText' :: [Text] -> State St [Text] @@ -540,9 +540,9 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, [ -- [ # comment -- 1 -- ] - Text _ _ TrailingComment t | cc == 2 && (fst $ nextIndent xs) > lineVI -> putText' [" ", t] - where lineVI = snd $ head indents - Text vi off _ t -> putText vi off 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 -- This code treats whitespace as "expanded" -- A new line resets the column counter and sets the target indentation as current indentation @@ -618,19 +618,19 @@ layoutGreedy tw doc = Text.concat $ evalState (go [Group RegularG doc] []) (0, [ Spacing _ -> tail grp Group ann ((Spacing _) : inner) -> (Group ann inner) : tail grp _ -> grp - (vi, off) = nextIndent grp' + (nl, off) = nextIndent grp' - indentWillIncrease = if fst (nextIndent rest) > lineVI then 2 else 0 + indentWillIncrease = if fst (nextIndent rest) > lineNL then 2 else 0 where - lastLineVI = snd $ head ci - lineVI = lastLineVI + (if vi > lastLineVI then 2 else 0) + lastLineNL = snd $ NonEmpty.head ci + lineNL = lastLineNL + (if nl > lastLineNL then 2 else 0) in fits indentWillIncrease (tw - firstLineWidth rest) grp' - <&> \t -> runState (putText vi off t) (cc, ci) + <&> \t -> runState (putText nl off t) (cc, ci) else let - indentWillIncrease = if fst (nextIndent rest) > lineVI then 2 else 0 - where lineVI = snd $ head ci + indentWillIncrease = if fst (nextIndent rest) > lineNL then 2 else 0 + where lineNL = snd $ NonEmpty.head ci in fits (indentWillIncrease - cc) (tw - cc - firstLineWidth rest) grp <&> \t -> ([t], (cc + textWidth t, ci)) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 5e018a11..65b5ec1e 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -50,7 +50,7 @@ instance Pretty Trivium where | otherwise = comment "/*" <> hardspace -- Add an offset to manually indent the comment by one - <> (nest $ offset 1 $ hcat $ map prettyCommentLine c) + <> (offset 3 $ hcat $ map prettyCommentLine c) <> comment "*/" <> hardline where prettyCommentLine :: Text -> Doc @@ -117,7 +117,7 @@ instance Pretty Binder where -- `foo = bar` pretty (Assignment selectors assign expr semicolon) = group $ hcat selectors - <> nest (hardspace <> pretty assign <> absorbRHS expr) <> pretty semicolon + <> nest (hardspace <> pretty assign <> nest (absorbRHS expr)) <> pretty semicolon -- Pretty a set -- while we already pretty eagerly expand sets with more than one element, @@ -198,7 +198,7 @@ instance Pretty ParamAttr where pretty (ParamAttr name (Just (qmark, def)) maybeComma) = group $ pretty name <> hardspace - <> nest (pretty qmark <> absorbRHS def) + <> nest (pretty qmark <> nest (absorbRHS def)) <> pretty maybeComma -- `...` diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index c5189553..8d187057 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -356,5 +356,5 @@ (function ( something # ... - ) { }) + ) { }) ] diff --git a/test/diff/idioms_lib_4/out.nix b/test/diff/idioms_lib_4/out.nix index 75f1467d..3cbd159a 100644 --- a/test/diff/idioms_lib_4/out.nix +++ b/test/diff/idioms_lib_4/out.nix @@ -829,7 +829,7 @@ rec { }; } .${toString (length l)} - or (throw "system string has invalid number of hyphen-separated components"); + or (throw "system string has invalid number of hyphen-separated components"); # This should revert the job done by config.guess from the gcc compiler. mkSystemFromSkeleton = diff --git a/test/diff/key_value/out.nix b/test/diff/key_value/out.nix index 033cbdc3..92004523 100644 --- a/test/diff/key_value/out.nix +++ b/test/diff/key_value/out.nix @@ -32,13 +32,13 @@ rec { }; h = { a # b - = # c - 1; + = # c + 1; }; i = { a # b - = # c - 1 # d + = # c + 1 # d ; }; j = a: { b = 1; }; @@ -61,8 +61,8 @@ rec { a # b = - # c - 1 + # c + 1 # d ; diff --git a/test/diff/monsters_1/out.nix b/test/diff/monsters_1/out.nix index 7d8c596b..18183d4e 100644 --- a/test/diff/monsters_1/out.nix +++ b/test/diff/monsters_1/out.nix @@ -58,198 +58,198 @@ stdenv.mkDerivation pname # foo = - # foo - "contrast"; + # foo + "contrast"; # foo version # foo = - # foo - "0.0.5"; + # foo + "0.0.5"; # foo src # foo = - # foo - fetchFromGitLab # foo - { - # foo - domain - # foo - = - # foo - "gitlab.gnome.org"; - # foo - group - # foo - = - # foo - "World"; - # foo - owner - # foo - = - # foo - "design"; - # foo - repo - # foo - = - # foo - "contrast"; - # foo - rev - # foo - = - # foo - version; - # foo - sha256 - # foo - = - # foo - "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; - # foo - }; + fetchFromGitLab + # foo + { + # foo + domain + # foo + = + # foo + "gitlab.gnome.org"; + # foo + group + # foo + = + # foo + "World"; + # foo + owner + # foo + = + # foo + "design"; + # foo + repo + # foo + = + # foo + "contrast"; + # foo + rev + # foo + = + # foo + version; + # foo + sha256 + # foo + = + # foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; + # foo + }; # foo cargoDeps # foo = - # foo - rustPlatform.fetchCargoTarball # foo - { - # foo - inherit - # foo - src - ; + rustPlatform.fetchCargoTarball # foo - name + { # foo - = + inherit + # foo + src + ; # foo - "${pname}-${version}"; - # foo - hash + name + # foo + = + # foo + "${pname}-${version}"; # foo - = + hash + # foo + = + # foo + "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # foo - "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; - # foo - }; + }; # foo nativeBuildInputs # foo = - # foo - [ - # foo - desktop-file-utils - # foo - gettext - # foo - meson - # foo - ninja - # foo - pkg-config - # foo - python3 - # foo - rustPlatform.rust.cargo - # foo - rustPlatform.cargoSetupHook - # foo - rustPlatform.rust.rustc # foo - wrapGAppsHook4 - # foo - glib - # foo - # for glib-compile-resources + [ + # foo + desktop-file-utils + # foo + gettext + # foo + meson + # foo + ninja + # foo + pkg-config + # foo + python3 + # foo + rustPlatform.rust.cargo + # foo + rustPlatform.cargoSetupHook + # foo + rustPlatform.rust.rustc + # foo + wrapGAppsHook4 + # foo + glib + # foo + # for glib-compile-resources - # foo - ]; + # foo + ]; # foo buildInputs # foo = - # foo - [ - # foo - cairo - # foo - glib - # foo - gtk4 # foo - libadwaita - # foo - pango - # foo - ]; + [ + # foo + cairo + # foo + glib + # foo + gtk4 + # foo + libadwaita + # foo + pango + # foo + ]; # foo postPatch # foo = - # foo - '' - patchShebangs build-aux/meson_post_install.py - # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 - substituteInPlace build-aux/meson_post_install.py \ - --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" - ''; + # foo + '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; # foo meta # foo = - # foo - with - # foo - lib; - # foo - { # foo - description + with # foo - = - # foo - "Checks whether the contrast between two colors meet the WCAG requirements"; - # foo - homepage - # foo - = - # foo - "https://gitlab.gnome.org/World/design/contrast"; + lib; # foo - license - # foo - = + { # foo - licenses.gpl3Plus; - # foo - maintainers + description + # foo + = + # foo + "Checks whether the contrast between two colors meet the WCAG requirements"; # foo - = + homepage + # foo + = + # foo + "https://gitlab.gnome.org/World/design/contrast"; # foo - with + license # foo - maintainers; + = + # foo + licenses.gpl3Plus; # foo - [ + maintainers # foo - jtojnar + = + # foo + with + # foo + maintainers; + # foo + [ + # foo + jtojnar + # foo + ]; + # foo + platforms # foo - ]; - # foo - platforms - # foo - = + = + # foo + platforms.unix; # foo - platforms.unix; - # foo - }; + }; # foo } diff --git a/test/diff/monsters_4/out.nix b/test/diff/monsters_4/out.nix index c24bf122..ac311ac3 100644 --- a/test/diff/monsters_4/out.nix +++ b/test/diff/monsters_4/out.nix @@ -37,110 +37,110 @@ stdenv.mkDerivation # Foo { # Foo pname # Foo - = # Foo - "contrast"; # Foo + = # Foo + "contrast"; # Foo version # Foo - = # Foo - "0.0.5"; # Foo + = # Foo + "0.0.5"; # Foo src # Foo - = # Foo - # Foo - fetchFromGitLab { + = # Foo # Foo - domain # Foo - = # Foo - "gitlab.gnome.org"; # Foo - group # Foo - = # Foo - "World"; # Foo - owner # Foo - = # Foo - "design"; # Foo - repo # Foo - = # Foo - "contrast"; # Foo - rev # Foo - = # Foo - version; # Foo - sha256 # Foo - = # Foo - "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo - }; # Foo - cargoDeps # Foo - = # Foo - rustPlatform.fetchCargoTarball # Foo - { + fetchFromGitLab { # Foo - inherit # Foo - src - ; # Foo - name # Foo - = # Foo - "${pname}-${version}"; # Foo - hash # Foo - = # Foo - "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo + domain # Foo + = # Foo + "gitlab.gnome.org"; # Foo + group # Foo + = # Foo + "World"; # Foo + owner # Foo + = # Foo + "design"; # Foo + repo # Foo + = # Foo + "contrast"; # Foo + rev # Foo + = # Foo + version; # Foo + sha256 # Foo + = # Foo + "cypSbqLwSmauOoWOuppWpF3hvrxiqmkLspxAWzvlUC0="; # Foo }; # Foo + cargoDeps # Foo + = # Foo + rustPlatform.fetchCargoTarball # Foo + { + # Foo + inherit # Foo + src + ; # Foo + name # Foo + = # Foo + "${pname}-${version}"; # Foo + hash # Foo + = # Foo + "sha256-W4FyqwJpimf0isQRCq9TegpTQPQfsumx40AFQCFG5VQ="; # Foo + }; # Foo nativeBuildInputs # Foo - = # Foo - [ - # Foo - desktop-file-utils # Foo - gettext # Foo - meson # Foo - ninja # Foo - pkg-config # Foo - python3 # Foo - rustPlatform.rust.cargo # Foo - rustPlatform.cargoSetupHook # Foo - rustPlatform.rust.rustc # Foo - wrapGAppsHook4 # Foo - glib # Foo for glib-compile-resources - # Foo - ]; # Foo + = # Foo + [ + # Foo + desktop-file-utils # Foo + gettext # Foo + meson # Foo + ninja # Foo + pkg-config # Foo + python3 # Foo + rustPlatform.rust.cargo # Foo + rustPlatform.cargoSetupHook # Foo + rustPlatform.rust.rustc # Foo + wrapGAppsHook4 # Foo + glib # Foo for glib-compile-resources + # Foo + ]; # Foo buildInputs # Foo - = # Foo - [ - # Foo - cairo # Foo - glib # Foo - gtk4 # Foo - libadwaita # Foo - pango # Foo - ]; # Foo + = # Foo + [ + # Foo + cairo # Foo + glib # Foo + gtk4 # Foo + libadwaita # Foo + pango # Foo + ]; # Foo postPatch # Foo - = # Foo - '' - patchShebangs build-aux/meson_post_install.py - # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 - substituteInPlace build-aux/meson_post_install.py \ - --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" - ''; # Foo + = # Foo + '' + patchShebangs build-aux/meson_post_install.py + # https://gitlab.gnome.org/World/design/contrast/-/merge_requests/23 + substituteInPlace build-aux/meson_post_install.py \ + --replace "gtk-update-icon-cache" "gtk4-update-icon-cache" + ''; # Foo meta # Foo - = # Foo - with # Foo - lib; # Foo - { - # Foo - description # Foo - = # Foo - "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo - homepage # Foo - = # Foo - "https://gitlab.gnome.org/World/design/contrast"; # Foo - license # Foo - = # Foo - licenses.gpl3Plus; # Foo - maintainers # Foo - = # Foo - with # Foo - maintainers; # Foo - [ - # Foo - jtojnar # Foo - ]; # Foo - platforms # Foo - = # Foo - platforms.unix; # Foo - }; # Foo + = # Foo + with # Foo + lib; # Foo + { + # Foo + description # Foo + = # Foo + "Checks whether the contrast between two colors meet the WCAG requirements"; # Foo + homepage # Foo + = # Foo + "https://gitlab.gnome.org/World/design/contrast"; # Foo + license # Foo + = # Foo + licenses.gpl3Plus; # Foo + maintainers # Foo + = # Foo + with # Foo + maintainers; # Foo + [ + # Foo + jtojnar # Foo + ]; # Foo + platforms # Foo + = # Foo + platforms.unix; # Foo + }; # Foo } diff --git a/test/diff/monsters_5/out.nix b/test/diff/monsters_5/out.nix index 288584f9..ad6ecb84 100644 --- a/test/diff/monsters_5/out.nix +++ b/test/diff/monsters_5/out.nix @@ -43,13 +43,13 @@ let = - pkgs.writeText + pkgs.writeText - "nixos.conf" + "nixos.conf" - '' - ${concatStringsSep "\n" config.boot.kernelModules} - ''; + '' + ${concatStringsSep "\n" config.boot.kernelModules} + ''; in { @@ -60,207 +60,207 @@ in = - { + { - boot.kernel.features + boot.kernel.features - = + = - mkOption + mkOption - { + { - default + default - = + = - { }; + { }; - example + example - = + = - literalExpression + literalExpression - "{debug= true;}"; + "{debug= true;}"; - internal + internal - = + = - true; + true; - description + description - = + = - '' - This option allows to enable or disable certain kernel features. - It's not API, because it's about kernel feature sets, that - make sense for specific use cases. Mostly along with programs, - which would have separate nixos options. - `grep features pkgs/os-specific/linux/kernel/common-config.nix` - ''; - }; + '' + This option allows to enable or disable certain kernel features. + It's not API, because it's about kernel feature sets, that + make sense for specific use cases. Mostly along with programs, + which would have separate nixos options. + `grep features pkgs/os-specific/linux/kernel/common-config.nix` + ''; + }; - boot.kernelPackages + boot.kernelPackages - = + = - mkOption + mkOption - { + { - default + default - = + = - pkgs.linuxPackages; + pkgs.linuxPackages; - type + type - = + = - types.unspecified + types.unspecified - // + // - { + { - merge + merge - = + = - mergeEqualOption; - }; + mergeEqualOption; + }; - apply + apply - = + = - kernelPackages: + kernelPackages: - kernelPackages.extend + kernelPackages.extend - ( - self: + ( + self: - super: + super: - { + { - kernel + kernel - = + = - super.kernel.override + super.kernel.override - ( - originalArgs: + ( + originalArgs: - { + { - inherit + inherit - randstructSeed - ; + randstructSeed + ; - kernelPatches + kernelPatches - = + = - (originalArgs.kernelPatches + (originalArgs.kernelPatches - or + or - [ ] - ) + [ ] + ) - ++ + ++ - kernelPatches; + kernelPatches; - features + features - = + = - lib.recursiveUpdate + lib.recursiveUpdate - super.kernel.features + super.kernel.features - features; - } - ); - } - ); + features; + } + ); + } + ); - # We don't want to evaluate all of linuxPackages for the manual - # - some of it might not even evaluate correctly. + # We don't want to evaluate all of linuxPackages for the manual + # - some of it might not even evaluate correctly. - defaultText + defaultText - = + = - literalExpression + literalExpression - "pkgs.linuxPackages"; + "pkgs.linuxPackages"; - example + example - = + = - literalExpression + literalExpression - "pkgs.linuxKernel.packages.linux_5_10"; + "pkgs.linuxKernel.packages.linux_5_10"; - description + description - = + = - '' - This option allows you to override the Linux kernel used by - NixOS. Since things like external kernel module packages are - tied to the kernel you're using, it also overrides those. - This option is a function that takes Nixpkgs as an argument - (as a convenience), and returns an attribute set containing at - the very least an attribute kernel. - Additional attributes may be needed depending on your - configuration. For instance, if you use the NVIDIA X driver, - then it also needs to contain an attribute - nvidia_x11. - ''; - }; + '' + This option allows you to override the Linux kernel used by + NixOS. Since things like external kernel module packages are + tied to the kernel you're using, it also overrides those. + This option is a function that takes Nixpkgs as an argument + (as a convenience), and returns an attribute set containing at + the very least an attribute kernel. + Additional attributes may be needed depending on your + configuration. For instance, if you use the NVIDIA X driver, + then it also needs to contain an attribute + nvidia_x11. + ''; + }; - boot.kernelPatches + boot.kernelPatches - = + = - mkOption + mkOption - { + { - type + type - = + = - types.listOf + types.listOf - types.attrs; + types.attrs; - default + default - = + = - [ ]; + [ ]; - example + example - = + = - literalExpression + literalExpression - "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; - description = "A list of additional patches to apply to the kernel."; - }; - }; + "[ pkgs.kernelPatches.ubuntu_fan_4_4 ]"; + description = "A list of additional patches to apply to the kernel."; + }; + }; } diff --git a/test/diff/pattern/out.nix b/test/diff/pattern/out.nix index 77ae6a7f..cdac106f 100644 --- a/test/diff/pattern/out.nix +++ b/test/diff/pattern/out.nix @@ -644,12 +644,12 @@ # a { b # a - ? # a - null # c + ? # a + null # c , # d e # a - ? # a - null # f + ? # a + null # f , # g ... # h }: @@ -664,9 +664,9 @@ # a # ? - # a - # - null, + # a + # + null, # c # # d @@ -675,9 +675,9 @@ # a # ? - # a - # - null, + # a + # + null, # f # # g From 6413a1249c7c555cff4eeb2957793b9d6810d8e5 Mon Sep 17 00:00:00 2001 From: piegames Date: Sat, 24 Feb 2024 11:47:12 +0100 Subject: [PATCH 116/125] List, Attrset: Preserve empty line when there are no items --- src/Nixfmt/Pretty.hs | 11 +++++++---- test/diff/attr_set/in.nix | 8 ++++++++ test/diff/attr_set/out.nix | 10 ++++++++++ test/diff/lists/in.nix | 8 ++++++++ test/diff/lists/out.nix | 10 ++++++++++ 5 files changed, 43 insertions(+), 4 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 65b5ec1e..7057b9ac 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -64,7 +64,10 @@ instance Pretty a => Pretty (Item a) where -- For lists, attribute sets and let bindings prettyItems :: Pretty a => Doc -> Items a -> Doc -prettyItems sep = prettyItems' . unItems +-- Special case: Preserve an empty line with no items +-- usually, trailing newlines after the last element are not preserved +prettyItems _ (Items [DetachedComments []]) = emptyline +prettyItems sep items = prettyItems' $ unItems items where prettyItems' :: Pretty a => [Item a] -> Doc prettyItems' [] = mempty @@ -124,9 +127,9 @@ instance Pretty Binder where -- in some situations even that is not sufficient. The wide parameter will -- be even more eager at expanding, except for empty sets and inherit statements. prettySet :: Bool -> (Maybe Leaf, Leaf, Items Binder, Leaf) -> Doc --- Empty, non-recursive attribute set -prettySet _ (Nothing, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) - = pretty paropen <> hardspace <> pretty parclose +-- Empty attribute set +prettySet _ (krec, Ann [] paropen Nothing, Items [], parclose@(Ann [] _ _)) + = pretty (fmap (, hardspace) krec) <> pretty paropen <> hardspace <> pretty parclose -- Singleton sets are allowed to fit onto one line, -- but apart from that always expand. prettySet wide (krec, Ann pre paropen post, binders, parclose) diff --git a/test/diff/attr_set/in.nix b/test/diff/attr_set/in.nix index 36ceab67..07c182fe 100644 --- a/test/diff/attr_set/in.nix +++ b/test/diff/attr_set/in.nix @@ -5,6 +5,14 @@ {a=1; } + { + + } + + { a = { + + };} + { b=1; } { b=1; /*c*/ } { /*a*/ b=1; } diff --git a/test/diff/attr_set/out.nix b/test/diff/attr_set/out.nix index 7d38543f..397512e3 100644 --- a/test/diff/attr_set/out.nix +++ b/test/diff/attr_set/out.nix @@ -6,6 +6,16 @@ { a = 1; } { a = 1; } + { + + } + + { + a = { + + }; + } + { b = 1; } { b = 1; # c diff --git a/test/diff/lists/in.nix b/test/diff/lists/in.nix index 56352bc1..0839c920 100644 --- a/test/diff/lists/in.nix +++ b/test/diff/lists/in.nix @@ -1,4 +1,12 @@ [ + [ + + ] + + [ [ + + ] ] + [ { # multiline foo = "bar"; diff --git a/test/diff/lists/out.nix b/test/diff/lists/out.nix index 8cbd273a..b389f22a 100644 --- a/test/diff/lists/out.nix +++ b/test/diff/lists/out.nix @@ -1,4 +1,14 @@ [ + [ + + ] + + [ + [ + + ] + ] + [ { # multiline From 6bd07b5362df764f7518f94640164990d5119ff1 Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 26 Feb 2024 20:00:43 +0100 Subject: [PATCH 117/125] Fix parenthesized function application There was some weird edge case involving long lines and "simple" arguments --- src/Nixfmt/Pretty.hs | 2 +- test/diff/apply/in.nix | 2 ++ test/diff/apply/out.nix | 2 ++ 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 7057b9ac..71cceb6d 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -347,7 +347,7 @@ prettyApp indentFunction pre hasPost f a pretty comment' <> ( if isSimple (Application f a) && isJust (renderedFUnexpanded) then - (group' RegularG $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a <> post) + (group' RegularG $ fromJust renderedFUnexpanded <> hardspace <> absorbLast a) else (group' RegularG $ renderedF <> line <> absorbLast a <> post) ) diff --git a/test/diff/apply/in.nix b/test/diff/apply/in.nix index a80d20d0..d8c22eb0 100644 --- a/test/diff/apply/in.nix +++ b/test/diff/apply/in.nix @@ -312,4 +312,6 @@ # ... ) { } ) + + (badge "https://github.com/maralorn/haskell-taskwarrior/actions/workflows/haskell.yml/badge.svg" "https://github.com/maralorn/haskell-taskwarrior/actions") ] diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 8d187057..ce599c16 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -357,4 +357,6 @@ something # ... ) { }) + + (badge "https://github.com/maralorn/haskell-taskwarrior/actions/workflows/haskell.yml/badge.svg" "https://github.com/maralorn/haskell-taskwarrior/actions") ] From 22fa00e788c891171946fc0ccfd349f946ce579e Mon Sep 17 00:00:00 2001 From: piegames Date: Mon, 26 Feb 2024 23:07:55 +0100 Subject: [PATCH 118/125] Parentheses: Move trailing comments up and in --- src/Nixfmt/Pretty.hs | 37 +++++++++++++++++++++---------------- test/diff/apply/out.nix | 2 +- 2 files changed, 22 insertions(+), 17 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 71cceb6d..713ae4b6 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -172,8 +172,11 @@ prettyTerm (List (Ann pre paropen post) items parclose) = prettyTerm (Set krec paropen items parclose) = prettySet False (krec, paropen, items, parclose) -- Parentheses -prettyTerm (Parenthesized paropen expr parclose) - = group $ pretty (moveTrailingCommentUp paropen) <> nest inner <> pretty parclose +prettyTerm (Parenthesized paropen expr (Ann closePre parclose closePost)) + = group $ + pretty (moveTrailingCommentUp paropen) + <> nest (inner <> pretty closePre) + <> pretty (Ann [] parclose closePost) where inner = case expr of @@ -323,15 +326,8 @@ prettyApp indentFunction pre hasPost f a absorbLast (Term t) | isAbsorbable t = group' Priority $ nest $ prettyTerm t - absorbLast (Term (Parenthesized (Ann pre' open post') expr close)) - = group' Priority $ nest $ pretty (Ann pre' open Nothing) - -- Move any trailing comments on the opening parenthesis down into the body - <> (surroundWith line' $ group $ nest $ - mapFirstToken - (\(Ann leading token trailing') -> (Ann (maybeToList (toLineComment <$> post') ++ leading) token trailing')) - expr - ) - <> pretty close + absorbLast (Term (Parenthesized open expr close)) + = absorbParen open expr close absorbLast arg = group' RegularG $ nest $ pretty arg -- Extract comment before the first function and move it out, to prevent functions being force-expanded @@ -393,6 +389,19 @@ isAbsorbable _ = False isAbsorbableTerm :: Term -> Bool isAbsorbableTerm = isAbsorbable +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 $ + pretty (mapFirstToken + (\(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 (Ann [] close post'') + -- Note that unlike for absorbable terms which can be force-absorbed, some expressions -- may turn out to not be absorbable. In that case, they should start with a line' so that -- they properly start on the next line if necessary. @@ -409,11 +418,7 @@ absorbRHS expr = case expr of -- Absorbable expression. Always start on the same line _ | isAbsorbableExpr expr -> hardspace <> group (absorbExpr True expr) -- Parenthesized expression. Same thing as the special case for parenthesized last argument in function calls. - (Term (Parenthesized open expr' close)) -> - group' Priority $ nest $ - hardspace <> pretty open - <> (surroundWith line' . group . nest) expr' - <> pretty close + (Term (Parenthesized open expr' close)) -> hardspace <> absorbParen open expr' close -- Not all strings are absorbable, but in this case we always want to keep them attached. -- Because there's nothing to gain from having them start on a new line. (Term (SimpleString _)) -> hardspace <> group expr diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index ce599c16..3de3f0e4 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -355,7 +355,7 @@ } (function ( something - # ... + # ... ) { }) (badge "https://github.com/maralorn/haskell-taskwarrior/actions/workflows/haskell.yml/badge.svg" "https://github.com/maralorn/haskell-taskwarrior/actions") From f7d9cfe03ec1acc2aa48dc5f4ac2a44c151e3c0b Mon Sep 17 00:00:00 2001 From: piegames Date: Tue, 27 Feb 2024 00:10:08 +0100 Subject: [PATCH 119/125] Application: add some special cases Dunno too tired to properly describe them --- src/Nixfmt/Pretty.hs | 22 +- src/Nixfmt/Types.hs | 7 + test/diff/apply/out.nix | 42 +- test/diff/idioms_lib_5/out.nix | 22 +- test/diff/idioms_nixos_1/out.nix | 12 +- test/diff/idioms_nixos_2/out.nix | 974 +++++++++++++++---------------- test/diff/operation/out.nix | 4 +- 7 files changed, 547 insertions(+), 536 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 713ae4b6..52518f94 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -24,7 +24,7 @@ import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, ParamAttr(..), Parameter(..), Selector(..), SimpleSelector(..), StringPart(..), Term(..), Token(..), TrailingComment(..), Trivium(..), - Whole(..), tokenText, mapFirstToken, mapFirstToken', mapLastToken') + Whole(..), tokenText, mapFirstToken, mapFirstToken', mapLastToken', hasTrivia) toLineComment :: TrailingComment -> Trivium toLineComment (TrailingComment c) = LineComment $ " " <> c @@ -326,6 +326,26 @@ prettyApp indentFunction pre hasPost f a absorbLast (Term t) | isAbsorbable t = group' Priority $ nest $ prettyTerm t + -- Special case: Absorb parenthesized function declaration with absorbable body + absorbLast + (Term (Parenthesized + open (Abstraction (IDParameter name) colon (Term body)) close + )) + | isAbsorbableTerm body && all (not . hasTrivia) [open, name, colon] + = group' Priority $ nest $ + pretty open <> pretty name <> pretty colon <> hardspace + <> prettyTermWide body + <> pretty close + -- Special case: Absorb parenthesized function application with absorbable body + absorbLast + (Term (Parenthesized + open (Application (Term (Token ident@(Ann _ fn@(Identifier _) _))) (Term body)) close + )) + | isAbsorbableTerm body && all (not . hasTrivia) [open, ident, close] + = group' Priority $ nest $ + pretty open <> pretty fn <> hardspace + <> prettyTermWide body + <> pretty close absorbLast (Term (Parenthesized open expr close)) = absorbParen open expr close absorbLast arg = group' RegularG $ nest $ pretty arg diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 4a0347f2..1e8a897d 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -39,6 +39,13 @@ newtype TrailingComment = TrailingComment Text deriving (Eq, Show) data Ann a = Ann Trivia a (Maybe TrailingComment) +hasTrivia :: Ann a -> Bool +hasTrivia (Ann [] _ Nothing) = False +hasTrivia _ = True + +ann :: a -> Ann a +ann a = Ann [] a Nothing + -- | Equality of annotated syntax is defined as equality of their corresponding -- semantics, thus ignoring the annotations. instance Eq a => Eq (Ann a) where diff --git a/test/diff/apply/out.nix b/test/diff/apply/out.nix index 3de3f0e4..42497b7f 100644 --- a/test/diff/apply/out.nix +++ b/test/diff/apply/out.nix @@ -94,12 +94,10 @@ l.mapAttrs ( pname: subOutputs: let - pkg = subOutputs.packages."${pname}".overrideAttrs ( - old: { - buildScript = "true"; - installMethod = "copy"; - } - ); + pkg = subOutputs.packages."${pname}".overrideAttrs (old: { + buildScript = "true"; + installMethod = "copy"; + }); in "${pkg}/lib/node_modules/${pname}/node_modules" ) outputs.subPackages @@ -311,33 +309,27 @@ (callPackage ../generic-builders/manifest.nix { # A lot of values here }).overrideAttrs - ( - prevAttrs: { - # stuff here - } - ); + (prevAttrs: { + # stuff here + }); # Variant with a selection on the function without parentheses foo2 = { # A lot of values here } .overrideAttrs - ( - prevAttrs: { - # stuff here - } - ); + (prevAttrs: { + # stuff here + }); # Also test within parenthesized function instead of just attribute sets foo3 = ( (callPackage ../generic-builders/manifest.nix { # A lot of values here }).overrideAttrs stuff - ( - prevAttrs: { - # stuff here - } - ) + (prevAttrs: { + # stuff here + }) ); # Add a comment at a bad place foo4 = ( @@ -346,11 +338,9 @@ # A lot of values here }).overrideAttrs stuff - ( - prevAttrs: { - # stuff here - } - ) + (prevAttrs: { + # stuff here + }) ); } (function ( diff --git a/test/diff/idioms_lib_5/out.nix b/test/diff/idioms_lib_5/out.nix index 158e55a6..0428fc01 100644 --- a/test/diff/idioms_lib_5/out.nix +++ b/test/diff/idioms_lib_5/out.nix @@ -341,18 +341,16 @@ let insecure = bool; # TODO: refactor once something like Profpatsch's types-simple will land # This is currently dead code due to https://github.com/NixOS/nix/issues/2532 - tests = attrsOf ( - mkOptionType { - name = "test"; - check = - x: - x == { } - || - # Accept {} for tests that are unsupported - (isDerivation x && x ? meta.timeout); - merge = lib.options.mergeOneOption; - } - ); + tests = attrsOf (mkOptionType { + name = "test"; + check = + x: + x == { } + || + # Accept {} for tests that are unsupported + (isDerivation x && x ? meta.timeout); + merge = lib.options.mergeOneOption; + }); timeout = int; # Needed for Hydra to expose channel tarballs: diff --git a/test/diff/idioms_nixos_1/out.nix b/test/diff/idioms_nixos_1/out.nix index de2def62..ca3f3229 100644 --- a/test/diff/idioms_nixos_1/out.nix +++ b/test/diff/idioms_nixos_1/out.nix @@ -46,13 +46,11 @@ in kernelPackages: kernelPackages.extend ( self: super: { - kernel = super.kernel.override ( - originalArgs: { - inherit randstructSeed; - kernelPatches = (originalArgs.kernelPatches or [ ]) ++ kernelPatches; - features = lib.recursiveUpdate super.kernel.features features; - } - ); + kernel = super.kernel.override (originalArgs: { + inherit randstructSeed; + kernelPatches = (originalArgs.kernelPatches or [ ]) ++ kernelPatches; + features = lib.recursiveUpdate super.kernel.features features; + }); } ); # We don't want to evaluate all of linuxPackages for the manual diff --git a/test/diff/idioms_nixos_2/out.nix b/test/diff/idioms_nixos_2/out.nix index a70156de..dd0e43fd 100644 --- a/test/diff/idioms_nixos_2/out.nix +++ b/test/diff/idioms_nixos_2/out.nix @@ -336,13 +336,11 @@ in poolSettings = mkOption { type = with types; - attrsOf ( - oneOf [ - str - int - bool - ] - ); + attrsOf (oneOf [ + str + int + bool + ]); default = { "pm" = "dynamic"; "pm.max_children" = "32"; @@ -747,536 +745,534 @@ in }; }; - config = mkIf cfg.enable ( - mkMerge [ - { - warnings = - let - latest = 26; - upgradeWarning = major: nixos: '' - A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. + config = mkIf cfg.enable (mkMerge [ + { + warnings = + let + latest = 26; + upgradeWarning = major: nixos: '' + A legacy Nextcloud install (from before NixOS ${nixos}) may be installed. - After nextcloud${toString major} is installed successfully, you can safely upgrade - to ${toString (major + 1)}. The latest version available is nextcloud${toString latest}. + After nextcloud${toString major} is installed successfully, you can safely upgrade + to ${toString (major + 1)}. The latest version available is nextcloud${toString latest}. - Please note that Nextcloud doesn't support upgrades across multiple major versions - (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). + Please note that Nextcloud doesn't support upgrades across multiple major versions + (i.e. an upgrade from 16 is possible to 17, but not 16 to 18). - The package can be upgraded by explicitly declaring the service-option - `services.nextcloud.package`. - ''; - in - (optional (cfg.poolConfig != null) '' - Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. - Please migrate your configuration to config.services.nextcloud.poolSettings. - '') - ++ (optional (versionOlder cfg.package.version "23") ( - upgradeWarning 22 "22.05" - )) - ++ (optional (versionOlder cfg.package.version "24") ( - upgradeWarning 23 "22.05" - )) - ++ (optional (versionOlder cfg.package.version "25") ( - upgradeWarning 24 "22.11" - )) - ++ (optional (versionOlder cfg.package.version "26") ( - upgradeWarning 25 "23.05" - )) - ++ (optional cfg.enableBrokenCiphersForSSE '' - You're using PHP's openssl extension built against OpenSSL 1.1 for Nextcloud. - This is only necessary if you're using Nextcloud's server-side encryption. - Please keep in mind that it's using the broken RC4 cipher. - - If you don't use that feature, you can switch to OpenSSL 3 and get - rid of this warning by declaring - - services.nextcloud.enableBrokenCiphersForSSE = false; - - If you need to use server-side encryption you can ignore this warning. - Otherwise you'd have to disable server-side encryption first in order - to be able to safely disable this option and get rid of this warning. - See on how to achieve this. - - For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 - ''); - - services.nextcloud.package = - with pkgs; - mkDefault ( - if pkgs ? nextcloud then - throw '' - The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default - nextcloud defined in an overlay, please set `services.nextcloud.package` to - `pkgs.nextcloud`. - '' - else if versionOlder stateVersion "22.11" then - nextcloud24 - else if versionOlder stateVersion "23.05" then - nextcloud25 - else - nextcloud26 - ); + The package can be upgraded by explicitly declaring the service-option + `services.nextcloud.package`. + ''; + in + (optional (cfg.poolConfig != null) '' + Using config.services.nextcloud.poolConfig is deprecated and will become unsupported in a future release. + Please migrate your configuration to config.services.nextcloud.poolSettings. + '') + ++ (optional (versionOlder cfg.package.version "23") ( + upgradeWarning 22 "22.05" + )) + ++ (optional (versionOlder cfg.package.version "24") ( + upgradeWarning 23 "22.05" + )) + ++ (optional (versionOlder cfg.package.version "25") ( + upgradeWarning 24 "22.11" + )) + ++ (optional (versionOlder cfg.package.version "26") ( + upgradeWarning 25 "23.05" + )) + ++ (optional cfg.enableBrokenCiphersForSSE '' + You're using PHP's openssl extension built against OpenSSL 1.1 for Nextcloud. + This is only necessary if you're using Nextcloud's server-side encryption. + Please keep in mind that it's using the broken RC4 cipher. + + If you don't use that feature, you can switch to OpenSSL 3 and get + rid of this warning by declaring + + services.nextcloud.enableBrokenCiphersForSSE = false; + + If you need to use server-side encryption you can ignore this warning. + Otherwise you'd have to disable server-side encryption first in order + to be able to safely disable this option and get rid of this warning. + See on how to achieve this. + + For more context, here is the implementing pull request: https://github.com/NixOS/nixpkgs/pull/198470 + ''); + + services.nextcloud.package = + with pkgs; + mkDefault ( + if pkgs ? nextcloud then + throw '' + The `pkgs.nextcloud`-attribute has been removed. If it's supposed to be the default + nextcloud defined in an overlay, please set `services.nextcloud.package` to + `pkgs.nextcloud`. + '' + else if versionOlder stateVersion "22.11" then + nextcloud24 + else if versionOlder stateVersion "23.05" then + nextcloud25 + else + nextcloud26 + ); - services.nextcloud.phpPackage = - if versionOlder cfg.package.version "26" then pkgs.php81 else pkgs.php82; - } + services.nextcloud.phpPackage = + if versionOlder cfg.package.version "26" then pkgs.php81 else pkgs.php82; + } - { - assertions = [ - { - assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; - message = ''services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true.''; - } - ]; - } + { + assertions = [ + { + assertion = cfg.database.createLocally -> cfg.config.dbtype == "mysql"; + message = ''services.nextcloud.config.dbtype must be set to mysql if services.nextcloud.database.createLocally is set to true.''; + } + ]; + } - { - systemd.timers.nextcloud-cron = { - wantedBy = [ "timers.target" ]; - after = [ "nextcloud-setup.service" ]; - timerConfig.OnBootSec = "5m"; - timerConfig.OnUnitActiveSec = "5m"; - timerConfig.Unit = "nextcloud-cron.service"; - }; + { + systemd.timers.nextcloud-cron = { + wantedBy = [ "timers.target" ]; + after = [ "nextcloud-setup.service" ]; + timerConfig.OnBootSec = "5m"; + timerConfig.OnUnitActiveSec = "5m"; + timerConfig.Unit = "nextcloud-cron.service"; + }; - systemd.tmpfiles.rules = [ "d ${cfg.home} 0750 nextcloud nextcloud" ]; - - systemd.services = { - # When upgrading the Nextcloud package, Nextcloud can report errors such as - # "The files of the app [all apps in /var/lib/nextcloud/apps] were not replaced correctly" - # Restarting phpfpm on Nextcloud package update fixes these issues (but this is a workaround). - phpfpm-nextcloud.restartTriggers = [ cfg.package ]; - - nextcloud-setup = - let - c = cfg.config; - writePhpArray = - a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]"; - requiresReadSecretFunction = c.dbpassFile != null || c.objectstore.s3.enable; - objectstoreConfig = - let - s3 = c.objectstore.s3; - in - optionalString s3.enable '' - 'objectstore' => [ - 'class' => '\\OC\\Files\\ObjectStore\\S3', - 'arguments' => [ - 'bucket' => '${s3.bucket}', - 'autocreate' => ${boolToString s3.autocreate}, - 'key' => '${s3.key}', - 'secret' => nix_read_secret('${s3.secretFile}'), - ${optionalString (s3.hostname != null) "'hostname' => '${s3.hostname}',"} - ${optionalString (s3.port != null) "'port' => ${toString s3.port},"} - 'use_ssl' => ${boolToString s3.useSsl}, - ${optionalString (s3.region != null) "'region' => '${s3.region}',"} - 'use_path_style' => ${boolToString s3.usePathStyle}, - ${ - optionalString ( - s3.sseCKeyFile != null - ) "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," - } - ], - ] - ''; - - showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; - renderedAppStoreSetting = - let - x = cfg.appstoreEnable; - in - if x == null then "false" else boolToString x; - - nextcloudGreaterOrEqualThan = req: versionAtLeast cfg.package.version req; - - overrideConfig = pkgs.writeText "nextcloud-config.php" '' - [ + nextcloud-setup = + let + c = cfg.config; + writePhpArray = + a: "[${concatMapStringsSep "," (val: ''"${toString val}"'') a}]"; + requiresReadSecretFunction = c.dbpassFile != null || c.objectstore.s3.enable; + objectstoreConfig = + let + s3 = c.objectstore.s3; + in + optionalString s3.enable '' + 'objectstore' => [ + 'class' => '\\OC\\Files\\ObjectStore\\S3', + 'arguments' => [ + 'bucket' => '${s3.bucket}', + 'autocreate' => ${boolToString s3.autocreate}, + 'key' => '${s3.key}', + 'secret' => nix_read_secret('${s3.secretFile}'), + ${optionalString (s3.hostname != null) "'hostname' => '${s3.hostname}',"} + ${optionalString (s3.port != null) "'port' => ${toString s3.port},"} + 'use_ssl' => ${boolToString s3.useSsl}, + ${optionalString (s3.region != null) "'region' => '${s3.region}',"} + 'use_path_style' => ${boolToString s3.usePathStyle}, ${ - optionalString (cfg.extraApps != { }) - "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," + optionalString ( + s3.sseCKeyFile != null + ) "'sse_c_key' => nix_read_secret('${s3.sseCKeyFile}')," } - [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], - [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], ], - ${optionalString (showAppStoreSetting) "'appstoreenabled' => ${renderedAppStoreSetting},"} - 'datadirectory' => '${datadir}/data', - 'skeletondirectory' => '${cfg.skeletonDirectory}', - ${optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu',"} - 'log_type' => '${cfg.logType}', - 'loglevel' => '${builtins.toString cfg.logLevel}', - ${ - optionalString ( - c.overwriteProtocol != null - ) "'overwriteprotocol' => '${c.overwriteProtocol}'," - } - ${optionalString (c.dbname != null) "'dbname' => '${c.dbname}',"} - ${optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}',"} - ${optionalString (c.dbport != null) "'dbport' => '${toString c.dbport}',"} - ${optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}',"} - ${ - optionalString ( - c.dbtableprefix != null - ) "'dbtableprefix' => '${toString c.dbtableprefix}'," - } - ${ - optionalString (c.dbpassFile != null) '' - 'dbpassword' => nix_read_secret( - "${c.dbpassFile}" - ), - '' + ] + ''; + + showAppStoreSetting = cfg.appstoreEnable != null || cfg.extraApps != { }; + renderedAppStoreSetting = + let + x = cfg.appstoreEnable; + in + if x == null then "false" else boolToString x; + + nextcloudGreaterOrEqualThan = req: versionAtLeast cfg.package.version req; + + overrideConfig = pkgs.writeText "nextcloud-config.php" '' + '${c.dbtype}', - 'trusted_domains' => ${ - writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) - }, - 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, + return trim(file_get_contents($file)); + }''} + function nix_decode_json_file($file, $error) { + if (!file_exists($file)) { + throw new \RuntimeException(sprintf($error, $file)); + } + $decoded = json_decode(file_get_contents($file), true); + + if (json_last_error() !== JSON_ERROR_NONE) { + throw new \RuntimeException(sprintf("Cannot decode %s, because: %s", $file, json_last_error_msg())); + } + + return $decoded; + } + $CONFIG = [ + 'apps_paths' => [ ${ - optionalString ( - c.defaultPhoneRegion != null - ) "'default_phone_region' => '${c.defaultPhoneRegion}'," + optionalString (cfg.extraApps != { }) + "[ 'path' => '${cfg.home}/nix-apps', 'url' => '/nix-apps', 'writable' => false ]," } - ${optionalString (nextcloudGreaterOrEqualThan "23") "'profile.enabled' => ${boolToString cfg.globalProfiles},"} - ${objectstoreConfig} - ]; + [ 'path' => '${cfg.home}/apps', 'url' => '/apps', 'writable' => false ], + [ 'path' => '${cfg.home}/store-apps', 'url' => '/store-apps', 'writable' => true ], + ], + ${optionalString (showAppStoreSetting) "'appstoreenabled' => ${renderedAppStoreSetting},"} + 'datadirectory' => '${datadir}/data', + 'skeletondirectory' => '${cfg.skeletonDirectory}', + ${optionalString cfg.caching.apcu "'memcache.local' => '\\OC\\Memcache\\APCu',"} + 'log_type' => '${cfg.logType}', + 'loglevel' => '${builtins.toString cfg.logLevel}', + ${ + optionalString ( + c.overwriteProtocol != null + ) "'overwriteprotocol' => '${c.overwriteProtocol}'," + } + ${optionalString (c.dbname != null) "'dbname' => '${c.dbname}',"} + ${optionalString (c.dbhost != null) "'dbhost' => '${c.dbhost}',"} + ${optionalString (c.dbport != null) "'dbport' => '${toString c.dbport}',"} + ${optionalString (c.dbuser != null) "'dbuser' => '${c.dbuser}',"} + ${ + optionalString ( + c.dbtableprefix != null + ) "'dbtableprefix' => '${toString c.dbtableprefix}'," + } + ${ + optionalString (c.dbpassFile != null) '' + 'dbpassword' => nix_read_secret( + "${c.dbpassFile}" + ), + '' + } + 'dbtype' => '${c.dbtype}', + 'trusted_domains' => ${ + writePhpArray ([ cfg.hostName ] ++ c.extraTrustedDomains) + }, + 'trusted_proxies' => ${writePhpArray (c.trustedProxies)}, + ${ + optionalString ( + c.defaultPhoneRegion != null + ) "'default_phone_region' => '${c.defaultPhoneRegion}'," + } + ${optionalString (nextcloudGreaterOrEqualThan "23") "'profile.enabled' => ${boolToString cfg.globalProfiles},"} + ${objectstoreConfig} + ]; + $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( + "${jsonFormat.generate "nextcloud-extraOptions.json" cfg.extraOptions}", + "impossible: this should never happen (decoding generated extraOptions file %s failed)" + )); + + ${optionalString (cfg.secretFile != null) '' $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( - "${jsonFormat.generate "nextcloud-extraOptions.json" cfg.extraOptions}", - "impossible: this should never happen (decoding generated extraOptions file %s failed)" + "${cfg.secretFile}", + "Cannot start Nextcloud, secrets file %s set by NixOS doesn't exist!" )); - - ${optionalString (cfg.secretFile != null) '' - $CONFIG = array_replace_recursive($CONFIG, nix_decode_json_file( - "${cfg.secretFile}", - "Cannot start Nextcloud, secrets file %s set by NixOS doesn't exist!" - )); - ''} + ''} + ''; + occInstallCmd = + let + mkExport = { arg, value }: "export ${arg}=${value}"; + dbpass = { + arg = "DBPASS"; + value = + if c.dbpassFile != null then ''"$(<"${toString c.dbpassFile}")"'' else ''""''; + }; + adminpass = { + arg = "ADMINPASS"; + value = ''"$(<"${toString c.adminpassFile}")"''; + }; + installFlags = concatStringsSep " \\\n " ( + mapAttrsToList (k: v: "${k} ${toString v}") { + "--database" = ''"${c.dbtype}"''; + # The following attributes are optional depending on the type of + # database. Those that evaluate to null on the left hand side + # will be omitted. + ${if c.dbname != null then "--database-name" else null} = ''"${c.dbname}"''; + ${if c.dbhost != null then "--database-host" else null} = ''"${c.dbhost}"''; + ${ + if c.dbport != null then "--database-port" else null + } = ''"${toString c.dbport}"''; + ${if c.dbuser != null then "--database-user" else null} = ''"${c.dbuser}"''; + "--database-pass" = "\"\$${dbpass.arg}\""; + "--admin-user" = ''"${c.adminuser}"''; + "--admin-pass" = "\"\$${adminpass.arg}\""; + "--data-dir" = ''"${datadir}/data"''; + } + ); + in + '' + ${mkExport dbpass} + ${mkExport adminpass} + ${occ}/bin/nextcloud-occ maintenance:install \ + ${installFlags} ''; - occInstallCmd = - let - mkExport = { arg, value }: "export ${arg}=${value}"; - dbpass = { - arg = "DBPASS"; - value = - if c.dbpassFile != null then ''"$(<"${toString c.dbpassFile}")"'' else ''""''; - }; - adminpass = { - arg = "ADMINPASS"; - value = ''"$(<"${toString c.adminpassFile}")"''; - }; - installFlags = concatStringsSep " \\\n " ( - mapAttrsToList (k: v: "${k} ${toString v}") { - "--database" = ''"${c.dbtype}"''; - # The following attributes are optional depending on the type of - # database. Those that evaluate to null on the left hand side - # will be omitted. - ${if c.dbname != null then "--database-name" else null} = ''"${c.dbname}"''; - ${if c.dbhost != null then "--database-host" else null} = ''"${c.dbhost}"''; - ${ - if c.dbport != null then "--database-port" else null - } = ''"${toString c.dbport}"''; - ${if c.dbuser != null then "--database-user" else null} = ''"${c.dbuser}"''; - "--database-pass" = "\"\$${dbpass.arg}\""; - "--admin-user" = ''"${c.adminuser}"''; - "--admin-pass" = "\"\$${adminpass.arg}\""; - "--data-dir" = ''"${datadir}/data"''; - } - ); - in - '' - ${mkExport dbpass} - ${mkExport adminpass} - ${occ}/bin/nextcloud-occ maintenance:install \ - ${installFlags} - ''; - occSetTrustedDomainsCmd = concatStringsSep "\n" ( - imap0 (i: v: '' - ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ - ${toString i} --value="${toString v}" - '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) - ); - in - { - wantedBy = [ "multi-user.target" ]; - before = [ "phpfpm-nextcloud.service" ]; - path = [ occ ]; - script = '' - ${optionalString (c.dbpassFile != null) '' - if [ ! -r "${c.dbpassFile}" ]; then - echo "dbpassFile ${c.dbpassFile} is not readable by nextcloud:nextcloud! Aborting..." - exit 1 - fi - if [ -z "$(<${c.dbpassFile})" ]; then - echo "dbpassFile ${c.dbpassFile} is empty!" - exit 1 - fi - ''} - if [ ! -r "${c.adminpassFile}" ]; then - echo "adminpassFile ${c.adminpassFile} is not readable by nextcloud:nextcloud! Aborting..." + occSetTrustedDomainsCmd = concatStringsSep "\n" ( + imap0 (i: v: '' + ${occ}/bin/nextcloud-occ config:system:set trusted_domains \ + ${toString i} --value="${toString v}" + '') ([ cfg.hostName ] ++ cfg.config.extraTrustedDomains) + ); + in + { + wantedBy = [ "multi-user.target" ]; + before = [ "phpfpm-nextcloud.service" ]; + path = [ occ ]; + script = '' + ${optionalString (c.dbpassFile != null) '' + if [ ! -r "${c.dbpassFile}" ]; then + echo "dbpassFile ${c.dbpassFile} is not readable by nextcloud:nextcloud! Aborting..." exit 1 fi - if [ -z "$(<${c.adminpassFile})" ]; then - echo "adminpassFile ${c.adminpassFile} is empty!" + if [ -z "$(<${c.dbpassFile})" ]; then + echo "dbpassFile ${c.dbpassFile} is empty!" exit 1 fi + ''} + if [ ! -r "${c.adminpassFile}" ]; then + echo "adminpassFile ${c.adminpassFile} is not readable by nextcloud:nextcloud! Aborting..." + exit 1 + fi + if [ -z "$(<${c.adminpassFile})" ]; then + echo "adminpassFile ${c.adminpassFile} is empty!" + exit 1 + fi + + ln -sf ${cfg.package}/apps ${cfg.home}/ + + # Install extra apps + ln -sfT \ + ${ + pkgs.linkFarm "nix-apps" ( + mapAttrsToList (name: path: { inherit name path; }) cfg.extraApps + ) + } \ + ${cfg.home}/nix-apps + + # create nextcloud directories. + # if the directories exist already with wrong permissions, we fix that + for dir in ${datadir}/config ${datadir}/data ${cfg.home}/store-apps ${cfg.home}/nix-apps; do + if [ ! -e $dir ]; then + install -o nextcloud -g nextcloud -d $dir + elif [ $(stat -c "%G" $dir) != "nextcloud" ]; then + chgrp -R nextcloud $dir + fi + done - ln -sf ${cfg.package}/apps ${cfg.home}/ + ln -sf ${overrideConfig} ${datadir}/config/override.config.php - # Install extra apps - ln -sfT \ - ${ - pkgs.linkFarm "nix-apps" ( - mapAttrsToList (name: path: { inherit name path; }) cfg.extraApps - ) - } \ - ${cfg.home}/nix-apps - - # create nextcloud directories. - # if the directories exist already with wrong permissions, we fix that - for dir in ${datadir}/config ${datadir}/data ${cfg.home}/store-apps ${cfg.home}/nix-apps; do - if [ ! -e $dir ]; then - install -o nextcloud -g nextcloud -d $dir - elif [ $(stat -c "%G" $dir) != "nextcloud" ]; then - chgrp -R nextcloud $dir - fi - done - - ln -sf ${overrideConfig} ${datadir}/config/override.config.php - - # Do not install if already installed - if [[ ! -e ${datadir}/config/config.php ]]; then - ${occInstallCmd} - fi + # Do not install if already installed + if [[ ! -e ${datadir}/config/config.php ]]; then + ${occInstallCmd} + fi - ${occ}/bin/nextcloud-occ upgrade + ${occ}/bin/nextcloud-occ upgrade - ${occ}/bin/nextcloud-occ config:system:delete trusted_domains + ${occ}/bin/nextcloud-occ config:system:delete trusted_domains - ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' - # Try to enable apps - ${occ}/bin/nextcloud-occ app:enable ${concatStringsSep " " (attrNames cfg.extraApps)} - ''} + ${optionalString (cfg.extraAppsEnable && cfg.extraApps != { }) '' + # Try to enable apps + ${occ}/bin/nextcloud-occ app:enable ${concatStringsSep " " (attrNames cfg.extraApps)} + ''} - ${occSetTrustedDomainsCmd} - ''; - serviceConfig.Type = "oneshot"; - serviceConfig.User = "nextcloud"; - # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent - # an automatic creation of the database user. - environment.NC_setup_create_db_user = lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; - }; - nextcloud-cron = { - after = [ "nextcloud-setup.service" ]; - environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; - serviceConfig.Type = "oneshot"; - serviceConfig.User = "nextcloud"; - serviceConfig.ExecStart = "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; - }; - nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { - after = [ "nextcloud-setup.service" ]; + ${occSetTrustedDomainsCmd} + ''; serviceConfig.Type = "oneshot"; - serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; serviceConfig.User = "nextcloud"; - startAt = cfg.autoUpdateApps.startAt; + # On Nextcloud ≥ 26, it is not necessary to patch the database files to prevent + # an automatic creation of the database user. + environment.NC_setup_create_db_user = lib.mkIf (nextcloudGreaterOrEqualThan "26") "false"; }; + nextcloud-cron = { + after = [ "nextcloud-setup.service" ]; + environment.NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + serviceConfig.Type = "oneshot"; + serviceConfig.User = "nextcloud"; + serviceConfig.ExecStart = "${phpPackage}/bin/php -f ${cfg.package}/cron.php"; }; - - services.phpfpm = { - pools.nextcloud = { - user = "nextcloud"; - group = "nextcloud"; - phpPackage = phpPackage; - phpEnv = { - NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; - PATH = "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; - }; - settings = - mapAttrs (name: mkDefault) { - "listen.owner" = config.services.nginx.user; - "listen.group" = config.services.nginx.group; - } - // cfg.poolSettings; - extraConfig = cfg.poolConfig; - }; + nextcloud-update-plugins = mkIf cfg.autoUpdateApps.enable { + after = [ "nextcloud-setup.service" ]; + serviceConfig.Type = "oneshot"; + serviceConfig.ExecStart = "${occ}/bin/nextcloud-occ app:update --all"; + serviceConfig.User = "nextcloud"; + startAt = cfg.autoUpdateApps.startAt; }; + }; - users.users.nextcloud = { - home = "${cfg.home}"; + services.phpfpm = { + pools.nextcloud = { + user = "nextcloud"; group = "nextcloud"; - isSystemUser = true; - }; - users.groups.nextcloud.members = [ - "nextcloud" - config.services.nginx.user - ]; - - environment.systemPackages = [ occ ]; - - services.mysql = lib.mkIf cfg.database.createLocally { - enable = true; - package = lib.mkDefault pkgs.mariadb; - ensureDatabases = [ cfg.config.dbname ]; - ensureUsers = [ - { - name = cfg.config.dbuser; - ensurePermissions = { - "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; - }; + phpPackage = phpPackage; + phpEnv = { + NEXTCLOUD_CONFIG_DIR = "${datadir}/config"; + PATH = "/run/wrappers/bin:/nix/var/nix/profiles/default/bin:/run/current-system/sw/bin:/usr/bin:/bin"; + }; + settings = + mapAttrs (name: mkDefault) { + "listen.owner" = config.services.nginx.user; + "listen.group" = config.services.nginx.group; } - ]; - initialScript = pkgs.writeText "mysql-init" '' - CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; - CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; - GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, - CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' - IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; - FLUSH privileges; - ''; + // cfg.poolSettings; + extraConfig = cfg.poolConfig; }; + }; - services.nginx.enable = mkDefault true; + users.users.nextcloud = { + home = "${cfg.home}"; + group = "nextcloud"; + isSystemUser = true; + }; + users.groups.nextcloud.members = [ + "nextcloud" + config.services.nginx.user + ]; - services.nginx.virtualHosts.${cfg.hostName} = { - root = cfg.package; - locations = { - "= /robots.txt" = { - priority = 100; - extraConfig = '' - allow all; - access_log off; - ''; - }; - "= /" = { - priority = 100; - extraConfig = '' - if ( $http_user_agent ~ ^DavClnt ) { - return 302 /remote.php/webdav/$is_args$args; - } - ''; - }; - "/" = { - priority = 900; - extraConfig = "rewrite ^ /index.php;"; - }; - "~ ^/store-apps" = { - priority = 201; - extraConfig = "root ${cfg.home};"; - }; - "~ ^/nix-apps" = { - priority = 201; - extraConfig = "root ${cfg.home};"; - }; - "^~ /.well-known" = { - priority = 210; - extraConfig = '' - absolute_redirect off; - location = /.well-known/carddav { - return 301 /remote.php/dav; - } - location = /.well-known/caldav { - return 301 /remote.php/dav; - } - location ~ ^/\.well-known/(?!acme-challenge|pki-validation) { - return 301 /index.php$request_uri; - } - try_files $uri $uri/ =404; - ''; - }; - "~ ^/(?:build|tests|config|lib|3rdparty|templates|data)(?:$|/)".extraConfig = '' - return 404; - ''; - "~ ^/(?:\\.(?!well-known)|autotest|occ|issue|indie|db_|console)".extraConfig = '' - return 404; - ''; - "~ ^\\/(?:index|remote|public|cron|core\\/ajax\\/update|status|ocs\\/v[12]|updater\\/.+|oc[ms]-provider\\/.+|.+\\/richdocumentscode\\/proxy)\\.php(?:$|\\/)" = { - priority = 500; - extraConfig = '' - include ${config.services.nginx.package}/conf/fastcgi.conf; - fastcgi_split_path_info ^(.+?\.php)(\\/.*)$; - set $path_info $fastcgi_path_info; - try_files $fastcgi_script_name =404; - fastcgi_param PATH_INFO $path_info; - fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; - fastcgi_param HTTPS ${if cfg.https then "on" else "off"}; - fastcgi_param modHeadersAvailable true; - fastcgi_param front_controller_active true; - fastcgi_pass unix:${fpm.socket}; - fastcgi_intercept_errors on; - fastcgi_request_buffering off; - fastcgi_read_timeout ${builtins.toString cfg.fastcgiTimeout}s; - ''; + environment.systemPackages = [ occ ]; + + services.mysql = lib.mkIf cfg.database.createLocally { + enable = true; + package = lib.mkDefault pkgs.mariadb; + ensureDatabases = [ cfg.config.dbname ]; + ensureUsers = [ + { + name = cfg.config.dbuser; + ensurePermissions = { + "${cfg.config.dbname}.*" = "ALL PRIVILEGES"; }; - "~ \\.(?:css|js|woff2?|svg|gif|map)$".extraConfig = '' - try_files $uri /index.php$request_uri; - expires 6M; + } + ]; + initialScript = pkgs.writeText "mysql-init" '' + CREATE USER '${cfg.config.dbname}'@'localhost' IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; + CREATE DATABASE IF NOT EXISTS ${cfg.config.dbname}; + GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, INDEX, ALTER, + CREATE TEMPORARY TABLES ON ${cfg.config.dbname}.* TO '${cfg.config.dbuser}'@'localhost' + IDENTIFIED BY '${builtins.readFile (cfg.config.dbpassFile)}'; + FLUSH privileges; + ''; + }; + + services.nginx.enable = mkDefault true; + + services.nginx.virtualHosts.${cfg.hostName} = { + root = cfg.package; + locations = { + "= /robots.txt" = { + priority = 100; + extraConfig = '' + allow all; access_log off; ''; - "~ ^\\/(?:updater|ocs-provider|ocm-provider)(?:$|\\/)".extraConfig = '' - try_files $uri/ =404; - index index.php; + }; + "= /" = { + priority = 100; + extraConfig = '' + if ( $http_user_agent ~ ^DavClnt ) { + return 302 /remote.php/webdav/$is_args$args; + } ''; - "~ \\.(?:png|html|ttf|ico|jpg|jpeg|bcmap|mp4|webm)$".extraConfig = '' - try_files $uri /index.php$request_uri; - access_log off; + }; + "/" = { + priority = 900; + extraConfig = "rewrite ^ /index.php;"; + }; + "~ ^/store-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "~ ^/nix-apps" = { + priority = 201; + extraConfig = "root ${cfg.home};"; + }; + "^~ /.well-known" = { + priority = 210; + extraConfig = '' + absolute_redirect off; + location = /.well-known/carddav { + return 301 /remote.php/dav; + } + location = /.well-known/caldav { + return 301 /remote.php/dav; + } + location ~ ^/\.well-known/(?!acme-challenge|pki-validation) { + return 301 /index.php$request_uri; + } + try_files $uri $uri/ =404; ''; }; - extraConfig = '' - index index.php index.html /index.php$request_uri; - ${optionalString (cfg.nginx.recommendedHttpHeaders) '' - add_header X-Content-Type-Options nosniff; - add_header X-XSS-Protection "1; mode=block"; - add_header X-Robots-Tag "noindex, nofollow"; - add_header X-Download-Options noopen; - add_header X-Permitted-Cross-Domain-Policies none; - add_header X-Frame-Options sameorigin; - add_header Referrer-Policy no-referrer; - ''} - ${optionalString (cfg.https) '' - add_header Strict-Transport-Security "max-age=${toString cfg.nginx.hstsMaxAge}; includeSubDomains" always; - ''} - client_max_body_size ${cfg.maxUploadSize}; - fastcgi_buffers 64 4K; - fastcgi_hide_header X-Powered-By; - gzip on; - gzip_vary on; - gzip_comp_level 4; - gzip_min_length 256; - gzip_proxied expired no-cache no-store private no_last_modified no_etag auth; - gzip_types application/atom+xml application/javascript application/json application/ld+json application/manifest+json application/rss+xml application/vnd.geo+json application/vnd.ms-fontobject application/x-font-ttf application/x-web-app-manifest+json application/xhtml+xml application/xml font/opentype image/bmp image/svg+xml image/x-icon text/cache-manifest text/css text/plain text/vcard text/vnd.rim.location.xloc text/vtt text/x-component text/x-cross-domain-policy; - - ${optionalString cfg.webfinger '' - rewrite ^/.well-known/host-meta /public.php?service=host-meta last; - rewrite ^/.well-known/host-meta.json /public.php?service=host-meta-json last; - ''} + "~ ^/(?:build|tests|config|lib|3rdparty|templates|data)(?:$|/)".extraConfig = '' + return 404; + ''; + "~ ^/(?:\\.(?!well-known)|autotest|occ|issue|indie|db_|console)".extraConfig = '' + return 404; + ''; + "~ ^\\/(?:index|remote|public|cron|core\\/ajax\\/update|status|ocs\\/v[12]|updater\\/.+|oc[ms]-provider\\/.+|.+\\/richdocumentscode\\/proxy)\\.php(?:$|\\/)" = { + priority = 500; + extraConfig = '' + include ${config.services.nginx.package}/conf/fastcgi.conf; + fastcgi_split_path_info ^(.+?\.php)(\\/.*)$; + set $path_info $fastcgi_path_info; + try_files $fastcgi_script_name =404; + fastcgi_param PATH_INFO $path_info; + fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name; + fastcgi_param HTTPS ${if cfg.https then "on" else "off"}; + fastcgi_param modHeadersAvailable true; + fastcgi_param front_controller_active true; + fastcgi_pass unix:${fpm.socket}; + fastcgi_intercept_errors on; + fastcgi_request_buffering off; + fastcgi_read_timeout ${builtins.toString cfg.fastcgiTimeout}s; + ''; + }; + "~ \\.(?:css|js|woff2?|svg|gif|map)$".extraConfig = '' + try_files $uri /index.php$request_uri; + expires 6M; + access_log off; + ''; + "~ ^\\/(?:updater|ocs-provider|ocm-provider)(?:$|\\/)".extraConfig = '' + try_files $uri/ =404; + index index.php; + ''; + "~ \\.(?:png|html|ttf|ico|jpg|jpeg|bcmap|mp4|webm)$".extraConfig = '' + try_files $uri /index.php$request_uri; + access_log off; ''; }; - } - ] - ); + extraConfig = '' + index index.php index.html /index.php$request_uri; + ${optionalString (cfg.nginx.recommendedHttpHeaders) '' + add_header X-Content-Type-Options nosniff; + add_header X-XSS-Protection "1; mode=block"; + add_header X-Robots-Tag "noindex, nofollow"; + add_header X-Download-Options noopen; + add_header X-Permitted-Cross-Domain-Policies none; + add_header X-Frame-Options sameorigin; + add_header Referrer-Policy no-referrer; + ''} + ${optionalString (cfg.https) '' + add_header Strict-Transport-Security "max-age=${toString cfg.nginx.hstsMaxAge}; includeSubDomains" always; + ''} + client_max_body_size ${cfg.maxUploadSize}; + fastcgi_buffers 64 4K; + fastcgi_hide_header X-Powered-By; + gzip on; + gzip_vary on; + gzip_comp_level 4; + gzip_min_length 256; + gzip_proxied expired no-cache no-store private no_last_modified no_etag auth; + gzip_types application/atom+xml application/javascript application/json application/ld+json application/manifest+json application/rss+xml application/vnd.geo+json application/vnd.ms-fontobject application/x-font-ttf application/x-web-app-manifest+json application/xhtml+xml application/xml font/opentype image/bmp image/svg+xml image/x-icon text/cache-manifest text/css text/plain text/vcard text/vnd.rim.location.xloc text/vtt text/x-component text/x-cross-domain-policy; + + ${optionalString cfg.webfinger '' + rewrite ^/.well-known/host-meta /public.php?service=host-meta last; + rewrite ^/.well-known/host-meta.json /public.php?service=host-meta-json last; + ''} + ''; + }; + } + ]); meta.doc = ./nextcloud.md; } diff --git a/test/diff/operation/out.nix b/test/diff/operation/out.nix index 95be0fee..f094d0d2 100644 --- a/test/diff/operation/out.nix +++ b/test/diff/operation/out.nix @@ -69,7 +69,9 @@ # Don't bother wrapping unless we actually have plugins, since the wrapper will stop automatic downloading # of plugins, which might be counterintuitive if someone just wants a vanilla Terraform. if actualPlugins == [ ] then - terraform.overrideAttrs (orig: { passthru = orig.passthru // passthru; }) + terraform.overrideAttrs (orig: { + passthru = orig.passthru // passthru; + }) else lib.appendToName "with-plugins" ( stdenv.mkDerivation { From 25792d47b63c3390842c1c028fa878b41e42a538 Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 1 Mar 2024 16:59:17 +0100 Subject: [PATCH 120/125] Comments: use RFC style --- src/Nixfmt/Lexer.hs | 82 ++++++--- src/Nixfmt/Pretty.hs | 27 ++- src/Nixfmt/Types.hs | 36 ++-- test/diff/comment/out.nix | 120 +++++++------ test/diff/idioms_lib_2/out.nix | 313 ++++++++++++++++++--------------- test/diff/idioms_lib_3/out.nix | 7 +- test/diff/lambda/out.nix | 5 +- test/diff/monsters_2/out.nix | 11 +- test/diff/root/out.nix | 14 +- 9 files changed, 346 insertions(+), 269 deletions(-) diff --git a/src/Nixfmt/Lexer.hs b/src/Nixfmt/Lexer.hs index 9c32763c..f94b465e 100644 --- a/src/Nixfmt/Lexer.hs +++ b/src/Nixfmt/Lexer.hs @@ -4,7 +4,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -{-# LANGUAGE BlockArguments, FlexibleContexts, LambdaCase, OverloadedStrings #-} +{-# LANGUAGE BlockArguments, FlexibleContexts, LambdaCase, OverloadedStrings, TupleSections #-} module Nixfmt.Lexer (lexeme, pushTrivia, takeTrivia, whole) where @@ -14,23 +14,24 @@ import Data.List (dropWhileEnd) import Data.Maybe (fromMaybe) import Data.Text as Text (Text, length, lines, null, pack, replace, replicate, strip, stripEnd, - stripPrefix, stripStart, takeWhile, unwords) + stripPrefix, stripStart, takeWhile, unwords, isPrefixOf) import Data.Void (Void) import Text.Megaparsec (Parsec, SourcePos(..), Pos, anySingle, chunk, getSourcePos, hidden, many, - manyTill, some, try, unPos, (<|>)) -import Text.Megaparsec.Char (eol) + manyTill, some, try, unPos, (<|>), notFollowedBy) +import Text.Megaparsec.Char (eol, char) import Nixfmt.Types (Ann(..), Whole(..), Parser, TrailingComment(..), Trivia, Trivium(..)) -import Nixfmt.Util (manyP) -- import Debug.Trace (traceShow, traceShowId) +import Nixfmt.Util (manyP, isSpaces) data ParseTrivium = PTNewlines Int -- Track the column where the comment starts | PTLineComment Text Pos - | PTBlockComment [Text] + -- Track whether it is a doc comment + | PTBlockComment Bool [Text] deriving (Show) preLexeme :: Parser a -> Parser a @@ -39,21 +40,6 @@ preLexeme p = p <* manyP (\x -> isSpace x && x /= '\n' && x /= '\r') newlines :: Parser ParseTrivium newlines = PTNewlines . Prelude.length <$> some (preLexeme eol) -splitLines :: Text -> [Text] -splitLines = dropWhile Text.null . dropWhileEnd Text.null - . map Text.stripEnd . Text.lines . replace "\r\n" "\n" - -stripIndentation :: Int -> Text -> Text -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 (==' ')) - -fixLines :: Int -> [Text] -> [Text] -fixLines _ [] = [] -fixLines n (h : t) = strip h - : map (stripIndentation $ commonIndentationLength n $ filter (/="") t) t - lineComment :: Parser ParseTrivium lineComment = preLexeme $ do SourcePos{sourceColumn = col} <- getSourcePos @@ -63,16 +49,54 @@ lineComment = preLexeme $ do blockComment :: Parser ParseTrivium blockComment = try $ preLexeme $ do - _ <- chunk "/*" SourcePos{sourceColumn = pos} <- getSourcePos + -- Positions start counting at 1, which we don't want here + 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 + chars <- manyTill anySingle $ chunk "*/" - return $ PTBlockComment $ fixLines (unPos pos) $ splitLines $ pack chars + return $ PTBlockComment isDoc $ dropWhile Text.null $ fixIndent pos' $ removeStars pos' $ splitLines $ pack chars + + where + -- Normalize line ends and stuff + splitLines :: Text -> [Text] + splitLines = dropWhileEnd Text.null . map Text.stripEnd . Text.lines . replace "\r\n" "\n" + + -- If all lines (but the first) start with a star (and the star is at the correct position), + -- replace that star with whitespace. + removeStars :: Int -> [Text] -> [Text] + removeStars _ [] = [] + removeStars pos (h : t) = + -- Replace the * with whitespace. Only do so when all lines correctly match. + -- The * must be aligned with the opening /* + h : (fromMaybe t . traverse (fmap (newStart <>) . stripPrefix start) $ t) + where + start = Text.replicate pos " " <> " *" + newStart = Text.replicate pos " " + + -- Strip the indented prefix of all lines + -- If the first line is empty, we set the minimum indentation to +2. + -- However, if there is a first line and it is aligned with the others, use +3 instead. + fixIndent :: Int -> [Text] -> [Text] + fixIndent _ [] = [] + fixIndent pos (h : t) + = strip h : map (stripIndentation $ commonIndentationLength offset $ filter (not . isSpaces) t) t + where + offset = if " " `isPrefixOf` h then pos + 3 else pos + 2 + + stripIndentation :: Int -> Text -> Text + 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 (==' ')) -- This should be called with zero or one elements, as per `span isTrailing` convertTrailing :: [ParseTrivium] -> Maybe TrailingComment convertTrailing = toMaybe . join . map toText where toText (PTLineComment c _) = strip c - toText (PTBlockComment [c]) = strip c + toText (PTBlockComment False [c]) = strip c toText _ = "" join = Text.unwords . filter (/="") toMaybe "" = Nothing @@ -83,14 +107,14 @@ convertLeading = concatMap (\case PTNewlines 1 -> [] PTNewlines _ -> [EmptyLine] PTLineComment c _ -> [LineComment c] - PTBlockComment [] -> [] - PTBlockComment [c] -> [LineComment $ " " <> strip c] - PTBlockComment cs -> [BlockComment cs]) + PTBlockComment _ [] -> [] + PTBlockComment False [c] -> [LineComment $ " " <> strip c] + PTBlockComment isDoc cs -> [BlockComment isDoc cs]) isTrailing :: ParseTrivium -> Bool isTrailing (PTLineComment _ _) = True -isTrailing (PTBlockComment []) = True -isTrailing (PTBlockComment [_]) = True +isTrailing (PTBlockComment False []) = True +isTrailing (PTBlockComment False [_]) = True isTrailing _ = False convertTrivia :: [ParseTrivium] -> Pos -> (Maybe TrailingComment, Trivia) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 52518f94..c9601a5c 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -12,7 +12,7 @@ import Prelude hiding (String) import Data.Char (isSpace) import Data.Maybe (fromMaybe, isJust, fromJust, maybeToList) -import Data.Text (Text, isPrefixOf, stripPrefix) +import Data.Text (Text) import qualified Data.Text as Text (null, takeWhile) -- import Debug.Trace (traceShowId) @@ -29,10 +29,6 @@ import Nixfmt.Types toLineComment :: TrailingComment -> Trivium toLineComment (TrailingComment c) = LineComment $ " " <> c --- The prime variant also strips leading * prefix -toLineComment' :: Text -> Trivium -toLineComment' c = LineComment $ fromMaybe (" " <> c) $ stripPrefix "*" c - -- If the token has some trailing comment after it, move that in front of the token moveTrailingCommentUp :: Ann a -> Ann a moveTrailingCommentUp (Ann pre a (Just post)) = Ann (pre ++ [toLineComment post]) a Nothing @@ -45,18 +41,17 @@ instance Pretty TrailingComment where instance Pretty Trivium where pretty EmptyLine = emptyline pretty (LineComment c) = comment ("#" <> c) <> hardline - pretty (BlockComment c) - | all ("*" `isPrefixOf`) (tail c) = hcat (map toLineComment' c) - | otherwise - = comment "/*" <> hardspace - -- Add an offset to manually indent the comment by one - <> (offset 3 $ hcat $ map prettyCommentLine c) + pretty (BlockComment isDoc c) = + comment (if isDoc then "/**" else "/*") <> hardline + -- Indent the comment using offset instead of nest + <> (offset 2 $ hcat $ map prettyCommentLine c) <> comment "*/" <> hardline - where - prettyCommentLine :: Text -> Doc - prettyCommentLine l - | Text.null l = emptyline - | otherwise = comment l <> hardline + where + prettyCommentLine :: Text -> Doc + prettyCommentLine l + | Text.null l = emptyline + | otherwise = comment l <> hardline + instance Pretty a => Pretty (Item a) where pretty (DetachedComments trivia) = pretty trivia diff --git a/src/Nixfmt/Types.hs b/src/Nixfmt/Types.hs index 1e8a897d..975ffe62 100644 --- a/src/Nixfmt/Types.hs +++ b/src/Nixfmt/Types.hs @@ -28,8 +28,12 @@ type ParseErrorBundle = MP.ParseErrorBundle Text Void data Trivium = EmptyLine - | LineComment Text - | BlockComment [Text] + -- Single line comments, either with # or /*. (We don't need to track which one it is, + -- as they will all be normalized to # comments. + | LineComment Text + -- Multi-line comments with /* or /**. Multiple # comments are treated as a list of `LineComment`. + -- The bool indicates a doc comment (/**) + | BlockComment Bool [Text] deriving (Eq, Show) type Trivia = [Trivium] @@ -277,21 +281,33 @@ instance LanguageElement Term where (Parenthesized open expr close) -> first (Parenthesized open expr) (f close) walkSubprograms = \case + -- Map each item to a singleton list, then handle that + (List _ items _) | Prelude.length (unItems items) == 1 -> case Prelude.head (unItems items) of + (CommentedItem c item) -> [emptySet c, Term item] + (DetachedComments _) -> [] (List _ items _) -> unItems items >>= \case - CommentedItem _ item -> [Term item] - DetachedComments _ -> [] + CommentedItem comment item -> + [ Term (List (ann TBrackOpen) (Items [CommentedItem comment item]) (ann TBrackClose)) ] + DetachedComments c -> + [ Term (List (ann TBrackOpen) (Items [DetachedComments c]) (ann TBrackClose)) ] + (Set _ _ items _) | Prelude.length (unItems items) == 1 -> case Prelude.head (unItems items) of - (CommentedItem _ (Inherit _ from sels _)) -> (Term <$> maybeToList from) ++ concatMap walkSubprograms sels - (CommentedItem _ (Assignment sels _ expr _)) -> expr : concatMap walkSubprograms sels + (CommentedItem c (Inherit _ from sels _)) -> + (Term <$> maybeToList from) ++ concatMap walkSubprograms sels ++ [emptySet c] + (CommentedItem c (Assignment sels _ expr _)) -> + expr : concatMap walkSubprograms sels ++ [emptySet c] (DetachedComments _) -> [] (Set _ _ items _) -> unItems items >>= \case -- Map each binding to a singleton set - (CommentedItem _ item) -> [ Term (Set Nothing (Ann [] TBraceOpen Nothing) (Items [(CommentedItem [] item)]) (Ann [] TBraceClose Nothing)) ] - (DetachedComments _) -> [] + (CommentedItem comment item) -> + [ Term (Set Nothing (ann TBraceOpen) (Items [CommentedItem comment item]) (ann TBraceClose)) ] + (DetachedComments c) -> [ emptySet c ] (Selection term sels) -> Term term : (sels >>= walkSubprograms) (Parenthesized _ expr _) -> [expr] -- The others are already minimal _ -> [] + where + emptySet c = Term (Set Nothing (ann TBraceOpen) (Items [DetachedComments c]) (ann TBraceClose)) instance LanguageElement Expression where mapFirstToken' f = \case @@ -326,12 +342,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 Nothing) (Items [(CommentedItem [] item)]) (Ann [] TBraceClose Nothing)) ] + (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 Nothing) (Term (Token (Ann [] (Identifier "_") Nothing)))), 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) diff --git a/test/diff/comment/out.nix b/test/diff/comment/out.nix index 674ded91..c9e956c6 100644 --- a/test/diff/comment/out.nix +++ b/test/diff/comment/out.nix @@ -2,89 +2,101 @@ # @ - /* * - @ - * + /** + @ + * */ - /* @ - @ + /* + @ @ + @ */ - /* @ + /* + @ + @ @ - @ */ - /* @ - @ - @ + /* + @ + @ + @ */ - /* @ - @ + /* + @ @ + @ */ - # test - # test - - # * FOO + /* + test + test + */ - # # FOO - # FOO - # BAR + /** + FOO + */ - /* * - Concatenate a list of strings with a separator between each element + /* + FOO + BAR + */ - # Example + /** + Concatenate a list of strings with a separator between each element - ```nix - concatStringsSep "/" ["usr" "local" "bin"] - => "usr/local/bin" - ``` + # Example - # Type + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` - ``` - concatStringsSep :: string -> [string] -> string - ``` + # Type + + ``` + concatStringsSep :: string -> [string] -> string + ``` */ - /* Concatenate a list of strings with a separator between each element + /* + Concatenate a list of strings with a separator between each element - # Example + # Example - ```nix - concatStringsSep "/" ["usr" "local" "bin"] - => "usr/local/bin" - ``` + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` - # Type + # Type - ``` - concatStringsSep :: string -> [string] -> string - ``` + ``` + concatStringsSep :: string -> [string] -> string + ``` */ - # Concatenate a list of strings with a separator between each element - # - # # Example - # - # ```nix - # concatStringsSep "/" ["usr" "local" "bin"] - # => "usr/local/bin" - # ``` - # - # # Type - # - # ``` - # concatStringsSep :: string -> [string] -> string - # ``` + /* + Concatenate a list of strings with a separator between each element + + # Example + + ```nix + concatStringsSep "/" ["usr" "local" "bin"] + => "usr/local/bin" + ``` + + # Type + + ``` + concatStringsSep :: string -> [string] -> string + ``` + */ [ # 1 diff --git a/test/diff/idioms_lib_2/out.nix b/test/diff/idioms_lib_2/out.nix index e434bff7..1fc274f0 100644 --- a/test/diff/idioms_lib_2/out.nix +++ b/test/diff/idioms_lib_2/out.nix @@ -4,24 +4,26 @@ rec { ## Simple (higher order) functions - /* The identity function - For when you need a function that does “nothing”. + /* + The identity function + For when you need a function that does “nothing”. - Type: id :: a -> a + Type: id :: a -> a */ id = # The value to return x: x; - /* The constant function + /* + The constant function - Ignores the second argument. If called with only one argument, - constructs a function that always returns a static value. + Ignores the second argument. If called with only one argument, + constructs a function that always returns a static value. - Type: const :: a -> b -> a - Example: - let f = const 5; in f 10 - => 5 + Type: const :: a -> b -> a + Example: + let f = const 5; in f 10 + => 5 */ const = # Value to return @@ -30,34 +32,35 @@ rec { y: x; - /* Pipes a value through a list of functions, left to right. + /* + Pipes a value through a list of functions, left to right. - Type: pipe :: a -> [] -> - Example: - pipe 2 [ - (x: x + 2) # 2 + 2 = 4 - (x: x * 2) # 4 * 2 = 8 - ] - => 8 + Type: pipe :: a -> [] -> + Example: + pipe 2 [ + (x: x + 2) # 2 + 2 = 4 + (x: x * 2) # 4 * 2 = 8 + ] + => 8 - # ideal to do text transformations - pipe [ "a/b" "a/c" ] [ + # ideal to do text transformations + pipe [ "a/b" "a/c" ] [ - # create the cp command - (map (file: ''cp "${src}/${file}" $out\n'')) + # create the cp command + (map (file: ''cp "${src}/${file}" $out\n'')) - # concatenate all commands into one string - lib.concatStrings + # concatenate all commands into one string + lib.concatStrings - # make that string into a nix derivation - (pkgs.runCommand "copy-to-out" {}) + # make that string into a nix derivation + (pkgs.runCommand "copy-to-out" {}) - ] - => + ] + => - The output type of each function has to be the input type - of the next function, and the last function returns the - final value. + The output type of each function has to be the input type + of the next function, and the last function returns the + final value. */ pipe = val: functions: @@ -73,13 +76,14 @@ rec { ## Named versions corresponding to some builtin operators. - /* Concatenate two lists + /* + Concatenate two lists - Type: concat :: [a] -> [a] -> [a] + Type: concat :: [a] -> [a] -> [a] - Example: - concat [ 1 2 ] [ 3 4 ] - => [ 1 2 3 4 ] + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] */ concat = x: y: x ++ y; @@ -106,23 +110,25 @@ rec { # bitwise “not” bitNot = builtins.sub (-1); - /* Convert a boolean to a string. + /* + Convert a boolean to a string. - This function uses the strings "true" and "false" to represent - boolean values. Calling `toString` on a bool instead returns "1" - and "" (sic!). + This function uses the strings "true" and "false" to represent + boolean values. Calling `toString` on a bool instead returns "1" + and "" (sic!). - Type: boolToString :: bool -> string + Type: boolToString :: bool -> string */ boolToString = b: if b then "true" else "false"; - /* Merge two attribute sets shallowly, right side trumps left + /* + Merge two attribute sets shallowly, right side trumps left - mergeAttrs :: attrs -> attrs -> attrs + mergeAttrs :: attrs -> attrs -> attrs - Example: - mergeAttrs { a = 1; b = 2; } { b = 3; c = 4; } - => { a = 1; b = 3; c = 4; } + Example: + mergeAttrs { a = 1; b = 2; } { b = 3; c = 4; } + => { a = 1; b = 3; c = 4; } */ mergeAttrs = # Left attribute set @@ -131,25 +137,27 @@ rec { y: x // y; - /* Flip the order of the arguments of a binary function. + /* + Flip the order of the arguments of a binary function. - Type: flip :: (a -> b -> c) -> (b -> a -> c) + Type: flip :: (a -> b -> c) -> (b -> a -> c) - Example: - flip concat [1] [2] - => [ 2 1 ] + Example: + flip concat [1] [2] + => [ 2 1 ] */ flip = f: a: b: f b a; - /* Apply function if the supplied argument is non-null. + /* + Apply function if the supplied argument is non-null. - Example: - mapNullable (x: x+1) null - => null - mapNullable (x: x+1) 22 - => 23 + Example: + mapNullable (x: x+1) null + => null + mapNullable (x: x+1) 22 + => 23 */ mapNullable = # Function to call @@ -181,10 +189,11 @@ rec { # Returns the current nixpkgs release number as string. release = lib.strings.fileContents ../.version; - /* Returns the current nixpkgs release code name. + /* + Returns the current nixpkgs release code name. - On each release the first letter is bumped and a new animal is chosen - starting with that new letter. + On each release the first letter is bumped and a new animal is chosen + starting with that new letter. */ codeName = "Quokka"; @@ -198,10 +207,11 @@ rec { else "pre-git"; - /* Attempts to return the the current revision of nixpkgs and - returns the supplied default value otherwise. + /* + Attempts to return the the current revision of nixpkgs and + returns the supplied default value otherwise. - Type: revisionWithDefault :: string -> string + Type: revisionWithDefault :: string -> string */ revisionWithDefault = # Default value to return if revision can not be determined @@ -219,10 +229,11 @@ rec { nixpkgsVersion = builtins.trace "`lib.nixpkgsVersion` is deprecated, use `lib.version` instead!" version; - /* Determine whether the function is being called from inside a Nix - shell. + /* + Determine whether the function is being called from inside a Nix + shell. - Type: inNixShell :: bool + Type: inNixShell :: bool */ inNixShell = builtins.getEnv "IN_NIX_SHELL" != ""; @@ -234,23 +245,25 @@ rec { # Return maximum of two numbers. max = x: y: if x > y then x else y; - /* Integer modulus + /* + Integer modulus - Example: - mod 11 10 - => 1 - mod 1 10 - => 1 + Example: + mod 11 10 + => 1 + mod 1 10 + => 1 */ mod = base: int: base - (int * (builtins.div base int)); ## Comparisons - /* C-style comparisons + /* + C-style comparisons - a < b, compare a b => -1 - a == b, compare a b => 0 - a > b, compare a b => 1 + a < b, compare a b => -1 + a == b, compare a b => 0 + a > b, compare a b => 1 */ compare = a: b: @@ -261,23 +274,24 @@ rec { else 0; - /* Split type into two subtypes by predicate `p`, take all elements - of the first subtype to be less than all the elements of the - second subtype, compare elements of a single subtype with `yes` - and `no` respectively. + /* + Split type into two subtypes by predicate `p`, take all elements + of the first subtype to be less than all the elements of the + second subtype, compare elements of a single subtype with `yes` + and `no` respectively. - Type: (a -> bool) -> (a -> a -> int) -> (a -> a -> int) -> (a -> a -> int) + Type: (a -> bool) -> (a -> a -> int) -> (a -> a -> int) -> (a -> a -> int) - Example: - let cmp = splitByAndCompare (hasPrefix "foo") compare compare; in + Example: + let cmp = splitByAndCompare (hasPrefix "foo") compare compare; in - cmp "a" "z" => -1 - cmp "fooa" "fooz" => -1 + cmp "a" "z" => -1 + cmp "fooa" "fooz" => -1 - cmp "f" "a" => 1 - cmp "fooa" "a" => -1 - # while - compare "fooa" "a" => 1 + cmp "f" "a" => 1 + cmp "fooa" "a" => -1 + # while + compare "fooa" "a" => 1 */ splitByAndCompare = # Predicate @@ -297,15 +311,17 @@ rec { else no a b; - /* Reads a JSON file. + /* + Reads a JSON file. - Type :: path -> any + Type :: path -> any */ importJSON = path: builtins.fromJSON (builtins.readFile path); - /* Reads a TOML file. + /* + Reads a TOML file. - Type :: path -> any + Type :: path -> any */ importTOML = path: builtins.fromTOML (builtins.readFile path); @@ -324,14 +340,15 @@ rec { # TODO: figure out a clever way to integrate location information from # something like __unsafeGetAttrPos. - /* Print a warning before returning the second argument. This function behaves - like `builtins.trace`, but requires a string message and formats it as a - warning, including the `warning: ` prefix. + /* + Print a warning before returning the second argument. This function behaves + like `builtins.trace`, but requires a string message and formats it as a + warning, including the `warning: ` prefix. - To get a call stack trace and abort evaluation, set the environment variable - `NIX_ABORT_ON_WARN=true` and set the Nix options `--option pure-eval false --show-trace` + To get a call stack trace and abort evaluation, set the environment variable + `NIX_ABORT_ON_WARN=true` and set the Nix options `--option pure-eval false --show-trace` - Type: string -> a -> a + Type: string -> a -> a */ warn = if @@ -348,41 +365,44 @@ rec { else msg: builtins.trace "warning: ${msg}"; - /* Like warn, but only warn when the first argument is `true`. + /* + Like warn, but only warn when the first argument is `true`. - Type: bool -> string -> a -> a + Type: bool -> string -> a -> a */ warnIf = cond: msg: if cond then warn msg else id; - /* Like the `assert b; e` expression, but with a custom error message and - without the semicolon. + /* + Like the `assert b; e` expression, but with a custom error message and + without the semicolon. - If true, return the identity function, `r: r`. + If true, return the identity function, `r: r`. - If false, throw the error message. + If false, throw the error message. - Calls can be juxtaposed using function application, as `(r: r) a = a`, so - `(r: r) (r: r) a = a`, and so forth. + Calls can be juxtaposed using function application, as `(r: r) a = a`, so + `(r: r) (r: r) a = a`, and so forth. - Type: bool -> string -> a -> a + Type: bool -> string -> a -> a - Example: + Example: - throwIfNot (lib.isList overlays) "The overlays argument to nixpkgs must be a list." - lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays - pkgs + throwIfNot (lib.isList overlays) "The overlays argument to nixpkgs must be a list." + lib.foldr (x: throwIfNot (lib.isFunction x) "All overlays passed to nixpkgs must be functions.") (r: r) overlays + pkgs */ throwIfNot = cond: msg: if cond then x: x else throw msg; - /* Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. + /* + Check if the elements in a list are valid values from a enum, returning the identity function, or throwing an error message otherwise. - Example: - let colorVariants = ["bright" "dark" "black"] - in checkListOfEnum "color variants" [ "standard" "light" "dark" ] colorVariants; - => - error: color variants: bright, black unexpected; valid ones: standard, light, dark + Example: + let colorVariants = ["bright" "dark" "black"] + in checkListOfEnum "color variants" [ "standard" "light" "dark" ] colorVariants; + => + error: color variants: bright, black unexpected; valid ones: standard, light, dark - Type: String -> List ComparableVal -> List ComparableVal -> a -> a + Type: String -> List ComparableVal -> List ComparableVal -> a -> a */ checkListOfEnum = msg: valid: given: @@ -398,15 +418,16 @@ rec { ## Function annotations - /* Add metadata about expected function arguments to a function. - The metadata should match the format given by - builtins.functionArgs, i.e. a set from expected argument to a bool - representing whether that argument has a default or not. - setFunctionArgs : (a → b) → Map String Bool → (a → b) + /* + Add metadata about expected function arguments to a function. + The metadata should match the format given by + builtins.functionArgs, i.e. a set from expected argument to a bool + representing whether that argument has a default or not. + setFunctionArgs : (a → b) → Map String Bool → (a → b) - This function is necessary because you can't dynamically create a - function of the { a, b ? foo, ... }: format, but some facilities - like callPackage expect to be able to query expected arguments. + This function is necessary because you can't dynamically create a + function of the { a, b ? foo, ... }: format, but some facilities + like callPackage expect to be able to query expected arguments. */ setFunctionArgs = f: args: { # TODO: Should we add call-time "type" checking like built in? @@ -414,11 +435,12 @@ rec { __functionArgs = args; }; - /* Extract the expected function arguments from a function. - This works both with nix-native { a, b ? foo, ... }: style - functions and functions with args set with 'setFunctionArgs'. It - has the same return type and semantics as builtins.functionArgs. - setFunctionArgs : (a → b) → Map String Bool. + /* + Extract the expected function arguments from a function. + This works both with nix-native { a, b ? foo, ... }: style + functions and functions with args set with 'setFunctionArgs'. It + has the same return type and semantics as builtins.functionArgs. + setFunctionArgs : (a → b) → Map String Bool. */ functionArgs = f: @@ -427,20 +449,22 @@ rec { else builtins.functionArgs f; - /* Check whether something is a function or something - annotated with function args. + /* + Check whether something is a function or something + annotated with function args. */ isFunction = f: builtins.isFunction f || (f ? __functor && isFunction (f.__functor f)); - /* Convert the given positive integer to a string of its hexadecimal - representation. For example: + /* + Convert the given positive integer to a string of its hexadecimal + representation. For example: - toHexString 0 => "0" + toHexString 0 => "0" - toHexString 16 => "10" + toHexString 16 => "10" - toHexString 250 => "FA" + toHexString 250 => "FA" */ toHexString = i: @@ -462,14 +486,15 @@ rec { in lib.concatMapStrings toHexDigit (toBaseDigits 16 i); - /* `toBaseDigits base i` converts the positive integer i to a list of its - digits in the given base. For example: + /* + `toBaseDigits base i` converts the positive integer i to a list of its + digits in the given base. For example: - toBaseDigits 10 123 => [ 1 2 3 ] + toBaseDigits 10 123 => [ 1 2 3 ] - toBaseDigits 2 6 => [ 1 1 0 ] + toBaseDigits 2 6 => [ 1 1 0 ] - toBaseDigits 16 250 => [ 15 10 ] + toBaseDigits 16 250 => [ 15 10 ] */ toBaseDigits = base: i: diff --git a/test/diff/idioms_lib_3/out.nix b/test/diff/idioms_lib_3/out.nix index eed1ae66..990350f6 100644 --- a/test/diff/idioms_lib_3/out.nix +++ b/test/diff/idioms_lib_3/out.nix @@ -330,9 +330,10 @@ rec { # as possible. toPretty = { - /* If this option is true, attrsets like { __pretty = fn; val = …; } - will use fn to convert val to a pretty printed representation. - (This means fn is type Val -> String.) + /* + If this option is true, attrsets like { __pretty = fn; val = …; } + will use fn to convert val to a pretty printed representation. + (This means fn is type Val -> String.) */ allowPrettyValues ? false, # If this option is true, the output is indented with newlines for attribute sets and lists diff --git a/test/diff/lambda/out.nix b/test/diff/lambda/out.nix index b6f42993..64078167 100644 --- a/test/diff/lambda/out.nix +++ b/test/diff/lambda/out.nix @@ -10,8 +10,9 @@ in foo ) ( - /* Collection of functions useful for debugging - Some comment + /* + Collection of functions useful for debugging + Some comment */ { lib }: let diff --git a/test/diff/monsters_2/out.nix b/test/diff/monsters_2/out.nix index 09f521f8..3051815f 100644 --- a/test/diff/monsters_2/out.nix +++ b/test/diff/monsters_2/out.nix @@ -1,13 +1,14 @@ { lib = { - /* Concatenate two lists + /* + Concatenate two lists - Type: concat :: [a] -> [a] -> [a] + Type: concat :: [a] -> [a] -> [a] - Example: - concat [ 1 2 ] [ 3 4 ] - => [ 1 2 3 4 ] + Example: + concat [ 1 2 ] [ 3 4 ] + => [ 1 2 3 4 ] */ concat = x: y: x ++ y; }; diff --git a/test/diff/root/out.nix b/test/diff/root/out.nix index 1cadc1b6..12820fc5 100644 --- a/test/diff/root/out.nix +++ b/test/diff/root/out.nix @@ -1,10 +1,12 @@ -/* Some functions f - name attribute. +/* + Some functions f + name attribute. */ -/* Add to or over - derivation. +/* + Add to or over + derivation. - Example: - addMetaAttrs {des + Example: + addMetaAttrs {des */ 1 From 2b5ee820690bae64cb4003e46917ae43541e3e0b Mon Sep 17 00:00:00 2001 From: piegames Date: Fri, 1 Mar 2024 18:07:15 +0100 Subject: [PATCH 121/125] String interpolation: Indentation fixes --- src/Nixfmt/Pretty.hs | 21 +++++++++-- test/diff/string_interpol/in.nix | 53 ++++++++++++++++++++++++++++ test/diff/string_interpol/out.nix | 58 ++++++++++++++++++++++++++++--- 3 files changed, 126 insertions(+), 6 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index c9601a5c..70fce906 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -656,9 +656,26 @@ instance Pretty StringPart where instance Pretty [StringPart] where -- When the interpolation is the only thing on the string line, - -- then absorb the content (i.e. don't surround with line') + -- then absorb the content (i.e. don't surround with line'). + -- Only do this when there are no comments + pretty [Interpolation (Whole expr [])] + = group $ text "${" <> nest inner <> text "}" + where + -- Code copied over from parentheses. Could be factored out into a common function one day + inner = case expr of + -- Start on the same line for these + _ | isAbsorbableExpr expr -> group $ absorbExpr False expr + -- Parenthesized application + (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' + -- Start on a new line for the others + _ -> line' <> group expr <> line' + + -- Fallback case: there are some comments around it. Always surround with line' then pretty [Interpolation expr] - = group $ text "${" <> pretty expr <> text "}" + = group $ text "${" <> surroundWith line' (nest expr) <> text "}" -- If we split a string line over multiple code lines due to large -- interpolations, make sure to indent based on the indentation of the line diff --git a/test/diff/string_interpol/in.nix b/test/diff/string_interpol/in.nix index a861ff8e..01c0d0dd 100644 --- a/test/diff/string_interpol/in.nix +++ b/test/diff/string_interpol/in.nix @@ -1,5 +1,6 @@ [ "${/*a*/"${/*b*/"${c}"}"/*d*/}" + ''${/*a*/''${/*b*/''${c}''}''/*d*/}'' { ExecStart = "${pkgs.openarena}/bin/oa_ded +set fs_basepath ${pkgs.openarena}/openarena-0.8.8 +set fs_homepath /var/lib/openarena ${ concatMapStringsSep (x: x) " " cfg.extraFlags @@ -26,4 +27,56 @@ } ''; } + { + system.nixos.versionSuffix1 = ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified + or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }.${self.shortRev or "dirty"}"; + + system.nixos.versionSuffix2 = ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified + or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }"; + + system.nixos.versionSuffix3 = "${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified + or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }"; + } + ( + system nixos versionSuffix1 ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified + or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }.${self.shortRev or "dirty"}" + ) + ( + system nixos versionSuffix2 ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified + or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }" + ) + ( + system nixos versionSuffix3 "${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified + or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }" + ) ] diff --git a/test/diff/string_interpol/out.nix b/test/diff/string_interpol/out.nix index ed65b6bf..643949e4 100644 --- a/test/diff/string_interpol/out.nix +++ b/test/diff/string_interpol/out.nix @@ -1,10 +1,18 @@ [ "${ - # a - "${ - # b - "${c}"}" # d + # a + "${ + # b + "${c}" + }" # d }" + ''${ + # a + ''${ + # b + ''${c}'' + }'' # d + }'' { ExecStart = "${pkgs.openarena}/bin/oa_ded +set fs_basepath ${pkgs.openarena}/openarena-0.8.8 +set fs_homepath /var/lib/openarena ${ concatMapStringsSep (x: x) " " cfg.extraFlags @@ -42,4 +50,46 @@ } ''; } + { + system.nixos.versionSuffix1 = ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }.${self.shortRev or "dirty"}"; + + system.nixos.versionSuffix2 = ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }"; + + system.nixos.versionSuffix3 = "${final.substring 0 8 ( + self.lastModifiedDate or self.lastModified or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + )}"; + } + (system nixos versionSuffix1 + ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }.${self.shortRev or "dirty"}" + ) + (system nixos versionSuffix2 + ".${ + final.substring 0 8 ( + self.lastModifiedDate or self.lastModified or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + ) + }" + ) + (system nixos versionSuffix3 + "${final.substring 0 8 ( + self.lastModifiedDate or self.lastModified or "19700101" + self.lastModifiedDate or self.lastModified or "19700101" + )}" + ) ] From 4eb99c16c5139355bccbde55141d23b990157b7d Mon Sep 17 00:00:00 2001 From: Silvan Mosberger Date: Thu, 14 Mar 2024 00:19:37 +0100 Subject: [PATCH 122/125] Use /usr/bin/env shebang in tests --- src/Nixfmt/Pretty.hs | 17 +++++++++++++---- test/test.sh | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/src/Nixfmt/Pretty.hs b/src/Nixfmt/Pretty.hs index 989b8789..d0cf7b09 100644 --- a/src/Nixfmt/Pretty.hs +++ b/src/Nixfmt/Pretty.hs @@ -17,7 +17,7 @@ import qualified Data.Text as Text (null, takeWhile) import Nixfmt.Predoc (Doc, GroupAnn(..), Pretty, emptyline, group, group', hardline, hardspace, hcat, line, line', - nest, offset, newline, pretty, sepBy, surroundWith, softline, text, comment, trailingComment, trailing, textWidth, + nest, offset, newline, pretty, sepBy, surroundWith, softline, softline', text, comment, trailingComment, trailing, textWidth, unexpandSpacing') import Nixfmt.Types (Ann(..), Binder(..), Expression(..), Item(..), Items(..), Leaf, @@ -139,9 +139,18 @@ prettyTerm (Token t) = pretty t prettyTerm (SimpleString (Ann leading s trailing')) = pretty leading <> prettySimpleString s <> pretty trailing' prettyTerm (IndentedString (Ann leading s trailing')) = pretty leading <> prettyIndentedString s <> pretty trailing' prettyTerm (Path p) = pretty p -prettyTerm (Selection term selectors Nothing) = pretty term <> hcat selectors -prettyTerm (Selection term selectors (Just (kw, def))) = - pretty term <> hcat selectors <> hardspace <> pretty kw <> hardspace <> pretty def +prettyTerm (Selection term selectors rest) = + pretty term <> sep <> hcat selectors + <> pretty ((\(kw, def) -> softline <> nest (pretty kw <> hardspace <> pretty def)) <$> rest) + where + -- Selection (`foo.bar.baz`) case distinction on the first element (`foo`): + sep = case term of + -- If it is an ident, keep it all together + (Token _) -> mempty + -- If it is a parenthesized expression, maybe add a line break + (Parenthesized _ _ _) -> softline' + -- Otherwise, very likely add a line break + _ -> line' -- Empty list prettyTerm (List (Ann leading paropen Nothing) (Items []) (Ann [] parclose trailing')) diff --git a/test/test.sh b/test/test.sh index 63befab4..397affe8 100755 --- a/test/test.sh +++ b/test/test.sh @@ -1,4 +1,4 @@ -#!/bin/env bash +#!/usr/bin/env bash set -euo pipefail # Simple test runner for nixfmt. From 08b34c0b667c141b321661c3b9bd0dbb2ba5cc27 Mon Sep 17 00:00:00 2001 From: Silvan Mosberger Date: Thu, 14 Mar 2024 00:51:53 +0100 Subject: [PATCH 123/125] Comply with REUSE --- .envrc | 3 +++ .reuse/dep5 | 4 ++++ test/test.sh | 3 +++ 3 files changed, 10 insertions(+) diff --git a/.envrc b/.envrc index 4a4726a5..349accec 100644 --- a/.envrc +++ b/.envrc @@ -1 +1,4 @@ +# © 2024 piegames +# SPDX-License-Identifier: MPL-2.0 + use_nix diff --git a/.reuse/dep5 b/.reuse/dep5 index e0212ff3..e8700c0b 100644 --- a/.reuse/dep5 +++ b/.reuse/dep5 @@ -5,6 +5,10 @@ Copyright: 2019 Serokell 2019 Lars Jellema License: MPL-2.0 +Files: test/diff/* +Copyright: 2024 piegames +License: MPL-2.0 + Files: test/correct/* Copyright: 2022 Serokell 2022 Lars Jellema diff --git a/test/test.sh b/test/test.sh index 397affe8..8bdef272 100755 --- a/test/test.sh +++ b/test/test.sh @@ -1,4 +1,7 @@ #!/usr/bin/env bash +# © 2024 piegames +# SPDX-License-Identifier: MPL-2.0 + set -euo pipefail # Simple test runner for nixfmt. From f43ec86912d0750c9bc2685d5c62a6641ff53d61 Mon Sep 17 00:00:00 2001 From: Silvan Mosberger Date: Thu, 14 Mar 2024 00:53:58 +0100 Subject: [PATCH 124/125] Remove accidentally committed file --- test/dist-newstyle/cache/compiler | Bin 18340 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 test/dist-newstyle/cache/compiler diff --git a/test/dist-newstyle/cache/compiler b/test/dist-newstyle/cache/compiler deleted file mode 100644 index ac4874862e65fe737a8895c1ceb844f54ae32871..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 18340 zcmeHPNs}DMb zy?c|qUTj}|($PP_5&j*%IqV2U_&50MlfTTWmz})~9W$g(rXr+iPum0_mfBpSme{}et|MSoNcUk_Q3&v~3uP2*vIN9WbB=a__(=kuE6*tRKHXfzN z_N3SDO#^>|5<9NArXM(FXQRAPHOJu~FjLFvS-!_N?J(X1W*EQvm;d_r|G4*y3#9$W zn)b#t8%=s?aNLi>;}biyd*hQ55~Sz{QQAd=b4*d=y<5<_%iJ-)cr_P#~bxZHJ+8jS=a5>Cc(JwH?vl` zR_}NHlSyZW0U9`g7j@0@My0V)7Dg@9+}G5UM^W7LCr-z%j$ZB8eq~xNmn*GqyAw{NrWFl( zTPAUL(kb_9v#3+IVtYF3owO^XY*glLx5_6|(~m;iF{>N3hFNLWOyPO+Uj0yOi`#JO z6CSm!k$>V$TIF=y?nkp)lvc`ay*+K24qSdX2qO-cu4qag=t{WdXMMXiZq?hzQ(hkX z(J1S-8cjaV%I%;b>d$qMebBOwrc7^9SZj}477rZw{H#6;Dq-87*>=ropjoZTWUg#U ziQXcoXIK1gQ0t!5I+d{5_Pbf^q~SQSFyyV)u^BtVjCCC96Ra64V+mPwmT=CN?@OsDo41mz-%w(>G1+{-_g`r`4ct zwX<2kTm43>SqrN@C-mDDlf$(m__x!8s`f^C$r<#S61G~kz_O-MHXFOa%!=Yk+^C4x2I zt_HT!l<1SB+Rn<;%CysuTg^()JC3T=Mt@wL^|GnkIkB3i9}l_bn)L+@-`6bTccM10 zc6+tf_@sK`^d~3XQE)P9*Xq`^YNunN!Oy%D1E!C>-iT=0nDv6R?v^W#Uw2%8V)xSW zNwpQ#;#wIa?_1-Z*}!n?Q$ue=r^d&2IH`3T=}CFkj>mC%=FX}-?sZSnb_xxc85RP@ zMomWZBJgyye#FPE#>lo&C->7Z4H}ivY}|;O;mCD5Qy<}C7N$^8scNRwhqXEy$Nj8a zp84JJxY}zvCr*cRn~z+-4Zr554Fy$bfPXA`hu)Q_6_$^W`-slHiqnfbfs-|Q$F|)Y zjnZys%0*ZDR?owb)U=l9tAp#-T9sPA-yWYt^{nbPjwh3Hx6$@1&A8jI2d0gQFYIZi zm8PacZ$@+6XjOw&r&>RWr=xDGJ&P*!k;NMox9ykv?L3?#_O&*26?!wAdMj>rWA2W4 za~7n%jul6C+6fx9>X^67V{{2Q78o7T?+olD@Z@hMsTrkr8Ylt1we6=-_JIy}mi**=CeDR-~0)mZkGBenVsN zdGY3Q9l0JJSjb(vku^xI-ljK6lWZVUlEUNO&9#O0=JBY%>3Usj7!9=A-=^9(c{uQ1 zVUddp$vX-ed9j;hIyRRQ>xhoLx4xP4eiYi}pDRc^F6agMZ_1z8RrBSeJY06#l%QNw zWz}+}oC_GQlgOJZd|d~zt`;nz;S{}}Q~71{<%^hGU5|Z6MQFlNHspgbY#mJ53o3uZ ze0eB{9u?d*Uv5QFGT!Rjp+8K9{Aikb+)(&C=F9zL4TJqXX#is@8hBZ34Z@MPXHApg z;Q27}48?da*Rh7f{(-c7`xGrlnH6K$!z8vML$NK=;Gg z%BFkpZcJouDClh|wE(i;A-Olrm)l!uxV!t{iG;mw~2WX%!30%{ri$+9UQP< z5(6dMFAkq@LzO@~G>J0yePUr8w-clqnH9#KyB%4aKlKJd;&MZAK9F+jS?ncgx}|9v zJi*e=4Tara(2%3-4@eR{+_45$E~84}?)!-#L$^*#5n0=c`P7s1UH=|d@g z3XMG`U9jU$vK70JyGMZ+KZv+zC``_jC6xUsNs73F1-Q4B`NO^!!}ArC$CU+;T_8Ec zf}I3yHdKj>1+t8##6r~H8KzO_EO$^bWYk~FVSh|oFqp-W0y%6I!a2cXva&1O=3sH1Vur0 z`^kC|tCAi>v4>kbM~BmRU`-5FETh;QU=`wHUWsCEs1iA^WEp!%ER55`N83d&9`{AA ze2|5GLlNXSt)sASk`5R`##}23XP&$7jl}{-G0af3Z;D=?PGsL&qYwMuWqpdapl_AP zZje6A0rX7HfdebE`rJ^EoCAv>`+(#S3l)@k(a`k_g~?dBgtEURN%$8q*b>t>!tC|j zgM<$Zh082=4TJrVG{C)qXPzr(ex4k1L&0+XtrFO4BrjSJJ4xVWh$HhEpzyo}s|+?K z4H$Tl5A0g~Fq$s-t)fW3T~A`4kRCWF)sMu68w$X%>?b>OZ!LwvMh58)1b;eG6yWxQ9I^tUCH{VqvjwD&?=Wb_IIQKYv3NTY%3EAxS`5r)}bNn+a!Ut^r_{C4mOT~p-Sais><1Y zVxxsmv8Qsk6XDfJEjWTIHxw>gxQ4+7%NlmA5Mh)LeJc~|s>0_Q78&drX}~z5hGb8i zHed^c>_|a!92Y@WBRLG1fUwKTr4%4NScljpl0h~ifPRvtLCE{hJ#1q_M~uAz#hFU|q>XT%rN1!)}G z`~vG$#>JrqHxw-6&nkgEB6(q&gJ{T~sJ*Fzq^%c0_Mt9^d?Qa^4~B3N1?6%JAPbk} zJ`W>z+sZJu3YyC)ko}zG1SlsPjuL1;tUwtvmSOfMn(QNQvKuAVK*=gl$}Yp~kYr`( zgk_z~vpD?tvB(Ora}-IQBFPM6KUq&>4(XC(6-C(6>+Yf8Vyu=4%qDp;XNP@cxM5!$ z2dHv6_cequl7Px**cnCm1SH!|36>(rtYIC6jYtP9FA0f-9C6RGJyfkgX}x8b{SnC` zQfeTQWo{@;M#?3Wl}Qrl9K-$$&F6+f5vBH%6`cKmq~X;E`8Upd@#cntq?av%>}Lyd zh|ZB0;atd?azjCdoDQ;!BnMDTdm*=nUW(vpC{WsH8D;^=B5nW_dkDEE%+C}QL&lA@ z9QF;;0v{-5@WY{;Rtk|T<^sm9lN796Aljm-P-*2AocSaT&4kiQrZ73WODOv(Nn%Yp zNTO+eTBAzknxx9vRbmSZft|-_M;JGW<;GPpatp2Fus_$d&?XIsRCE#rk5mk)Wi5yO zh_r~2MvB-CC(m%;Y~e(N8w$)vdI@GfCRy|k+IjftFc~07t8zJiHH7``qC}pVBD+%M zBtZy!lO(WyJh$RrHBS#zv0Ojq0K2lp-_QA~Sn+d!?GYdSf9~N(T%I8ndmIJI{x8GK zBw5imdFCP43ss!gr2zJO#D{<7e6=1J3X}e|gtFI35|##r@2PoKs>-F^G=%*lNdS57 zMb<=wIB`;KC`8Vm1&q~63UQ`Dgo8q{p&%JA7D4uhBqw^7MBY{$C;3{!4Ta@BTSVD4 zlEj=mbduC_#ejW=)JhzBaYNxUyIR9wACU$O(joTQt`%VxsokG~{6IBFJKr!`Zxu`_8~nMe=MuFJyh<$@U1I zIQ}tIanT+E*gM3B?TPCZ=itP=n`C{pgeg?61S>e( zC27o_Bb@qqhn`HGxuFm_dloQuLQ)uh;l*l~C^i}jl(A$PW*Nz1)CKrB7XNFgVmaz_ zfPIJf07S9eC5tm11&9PV(INIR$%tM-W*+DjlJ`o-*gcZM1QJrk=8pEw+)xCWbFHJW zCh0)UFJe1EG?J#{hC*b`3mBV`6rx^%91gLoROQgNpJ)g(NCIsY+Xg3;;e6g!MUZV> zM`4_Fzy~$L;SkFr?R*qR`rs)n_Fd8>dmTE7D~u-&&lFPhTEp0HlN7w@MT~`TfX&G6 zV_{crC{TLQGR*#Zjcjpz#SH~6$P&!9NfsXUS?G<69ETeUkRGK&#b@IE;_vnQ3D*Ct zBtBVS8&Q?6ZoX>P&0*Y&lW}ZDxWqImu(!8M4l*Nr zw$H?mJ|awk=og31d1Y+VaSCNOwQBI`-seR*{kf~*XkM?RldhXx+>kLN_lG{dLX`@c z4>S=zOyxCzk{Kr^E+rI{3qO5uSp0l@`{R%2J=L`r1a^7Hvxk03S@yO4XC%8bjd4uo zll-|Lsmb5RyjJ0%VG*p^5aP_#gS|148bR8X!;El8()kBYu< zlJ9x27aAtamml^NislaX2F?$6LbAlCU%6Km72bX7q0yzpKE|5QmwNbAtJOXCRm{!E z-4KDIsPXnSCOe5Z zdbe9`*K2O0=DMzDw_6RzuGAZr-R@Ld)rMy|jXDkXTcivThQih+zRi{}-?I=GXz;`0 zeljkpc_G8KJW47ZPVpg;!u$i%9e+w(&HU!o)$qbBJ=ghh(@(gcN4jVSR6|CAuHsIa!v3mQ4XIT ztfIFGMd!paU=EUGmGus>(&9v?WSZg<;VSceVrCvj0xiSk&wk>H@29KekBK}8!Z;R= zi50qpuRdrA{z3N8y;|$o?IXF*E5%ruN`nN`&0W)=dq*;m(ArkAVI+LUq{i%TKP-OU zD2QjsFRs6cGhC5?n`R+C;uVVKlj+(E?v-}L`1|P33VcPth)m*xP5z&`=v9Fo1vp`K z*BI`GK)-N3xCI7R7VLS-<23_{=1D&starI9)^ggUKY=*=4e(8iBGP4O)<@MiDGYEM z0H=J%8kEG9%L39GejWGk;$eSzEd4&svKvm8a2bG+{H-(n4L6F!E%&7ueMMZQ-0b2c znQDEnn4Ygh2z!Oe5iN<_S|Jqey@G6RG3oq`tN@o$jc&@KcJ>y^Lj>6U7bUe?XePV^ zSQ*+DiM6T1yheLpr-@wJ!qPB|$2ja-9hL>1V&rf`o>uU=XWu|%USr2gMRB3_TC#?7 zQ5F`A>)4t@X356-rTcSuXs)xU;cA|Pl&s7NilQr9`2AAuIEs=F3Q}P4(ncsggp^#w zckKB`9LQ{)Py2Qf zQ4pDr!<&UnLeQmWhkM%Q>0W_TJVYDC7l)$TUzCxNBreptB}~;4;%#Wrrf%MXn?((h z$8rCn&~3DfAJ+!S&p9Q+ zEnWVcyKr5_8DDJaqUU_7rK>pm8?6QDbMFXrEoYB-y7c*59(% z@=90o<;M0r54QB$&;C+Nmpr*RT_RMdrbm6l-uKHy8Dbdoas!!wtrTiI`TwBEJD)l2T7Z0db^c2u( zFQ*EzlDNrvRG1 zOX6@8kH`!4^v|#J68Zll@O55t&PU^Vr1&~7k*~0IlYE_*obBnjZo9AZlK Date: Thu, 14 Mar 2024 17:44:15 +0100 Subject: [PATCH 125/125] Parser: Fix operator parsing Closes #122 --- src/Nixfmt/Parser.hs | 16 ++++++++++++---- test/correct/operator-after-operator.nix | 3 +++ 2 files changed, 15 insertions(+), 4 deletions(-) create mode 100644 test/correct/operator-after-operator.nix diff --git a/src/Nixfmt/Parser.hs b/src/Nixfmt/Parser.hs index 647283d9..92ca7622 100644 --- a/src/Nixfmt/Parser.hs +++ b/src/Nixfmt/Parser.hs @@ -342,12 +342,20 @@ list = List <$> symbol TBrackOpen <*> items term <*> symbol TBrackClose -- OPERATORS -opChars :: [Char] -opChars = "<>=+*/." - operator :: Token -> Parser Leaf operator t = label "operator" $ try $ lexeme $ - rawSymbol t <* notFollowedBy (oneOf opChars) + rawSymbol t <* notFollowedBy (oneOf ( + -- Resolve ambiguities between operators which are prefixes of others + case t of + TPlus -> "+" :: [Char] + TMinus -> ">" + TMul -> "/" + TDiv -> "/*" + TLess -> "=" + TGreater -> "=" + TNot -> "=" + _ -> "" + )) opCombiner :: Operator -> MPExpr.Operator Parser Expression opCombiner Apply = MPExpr.InfixL $ return Application diff --git a/test/correct/operator-after-operator.nix b/test/correct/operator-after-operator.nix new file mode 100644 index 00000000..d4ba6740 --- /dev/null +++ b/test/correct/operator-after-operator.nix @@ -0,0 +1,3 @@ +# https://github.com/NixOS/nixfmt/issues/122 +(1+/**/1) +(1+.4)