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