Comments: use RFC style

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)

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

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)