Allow standalone comments in lists and sets

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)

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
 

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,25 @@ 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 paropen items parclose)
     = base $ pretty paropen <> line
-        <> nest 2 (sepBy line (map group items)) <> 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,21 +161,22 @@ 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
 
 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,20 +219,28 @@ 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
           <> nest 2 (group cond) <> pretty semicolon)
           <> 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 +276,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

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