wip comments

src/Juvix/Compiler/Backend/Geb/Translation/FromSource/Lexer.hs

@@ -13,7 +13,7 @@ import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 space :: forall r. ParsecS r ()
-space = L.space space1 lineCmnt blockCmnt
+space = L.space whiteSpace1 lineCmnt blockCmnt
   where
     lineCmnt :: ParsecS r () = L.skipLineComment ";"
     blockCmnt :: ParsecS r () = L.skipBlockComment "#|" "|#"

src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs

@@ -9,7 +9,7 @@ where
 import Data.Text qualified as Text
 import GHC.Unicode
 import Juvix.Compiler.Concrete.Data.ParsedInfoTableBuilder
-import Juvix.Compiler.Concrete.Extra hiding (Pos, space, string')
+import Juvix.Compiler.Concrete.Extra hiding (Pos, hspace, space, string')
 import Juvix.Compiler.Concrete.Extra qualified as P
 import Juvix.Compiler.Concrete.Keywords
 import Juvix.Data.Keyword
@@ -72,10 +72,10 @@ string :: (Members '[InfoTableBuilder] r) => ParsecS r (Text, Interval)
 string = lexemeInterval string'
 
 judocExampleStart :: ParsecS r ()
-judocExampleStart = P.chunk Str.judocExample >> hspace
+judocExampleStart = P.chunk Str.judocExample >> hspace_
 
 judocStart :: ParsecS r ()
-judocStart = P.chunk Str.judocStart >> hspace
+judocStart = P.chunk Str.judocStart >> hspace_
 
 judocEmptyLine :: (Members '[InfoTableBuilder] r) => ParsecS r ()
 judocEmptyLine = lexeme (void (P.try (judocStart >> P.newline)))

src/Juvix/Data/Comment.hs

@@ -26,6 +26,8 @@ data CommentType
 data Comment = Comment
   { _commentType :: CommentType,
     _commentText :: Text,
+    -- | Used for grouping comments during formatting
+    _commentPreceedingEmptyLine :: Bool,
     _commentInterval :: Interval
   }
   deriving stock (Show, Eq, Ord, Generic, Data)

src/Juvix/Parser/Lexer.hs

@@ -9,49 +9,78 @@ import GHC.Unicode
 import Juvix.Data.Keyword
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
-import Text.Megaparsec as P hiding (sepBy1, sepEndBy1, some)
-import Text.Megaparsec.Char hiding (space, space1)
+import Juvix.Prelude.Parsing as P hiding (hspace, space, space1)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 type ParsecS r = ParsecT Void Text (Sem r)
 
 parseFailure :: Int -> String -> ParsecS r a
 parseFailure off str = P.parseError $ P.FancyError off (Set.singleton (P.ErrorFail str))
 
-space1 :: (MonadParsec e s m, Token s ~ Char) => m ()
-space1 = void $ takeWhile1P (Just "white space (only spaces and newlines allowed)") isWhiteSpace
+whiteSpace1 :: (MonadParsec e s m, Token s ~ Char) => m ()
+whiteSpace1 = void (takeWhile1P (Just spaceMsg) isWhiteSpace)
+
+whiteSpace :: (MonadParsec e s m, Token s ~ Char) => m ()
+whiteSpace = void (takeWhileP (Just spaceMsg) isWhiteSpace)
+
+isWhiteSpace :: Char -> Bool
+isWhiteSpace = (`elem` [' ', '\n'])
+
+hspace :: (MonadParsec e s m, Token s ~ Char) => m (Tokens s)
+hspace = takeWhileP (Just spaceMsg) isHWhiteSpace
   where
-    isWhiteSpace :: Char -> Bool
-    isWhiteSpace = (`elem` [' ', '\n'])
-
-space' :: forall r. Bool -> ParsecS r [Comment]
-space' judoc = do
-  catMaybes
-    <$> P.many
-      ( hidden
-          ( choice
-              [space1 $> Nothing, Just <$> (lineComment <|> blockComment)]
-          )
-      )
+    isHWhiteSpace :: Char -> Bool
+    isHWhiteSpace = (== ' ')
+
+hspace_ :: (MonadParsec e s m, Token s ~ Char) => m ()
+hspace_ = void hspace
+
+spaceMsg :: String
+spaceMsg = "white space (only spaces and newlines allowed)"
+
+space' :: forall e m. MonadParsec e Text m => Bool -> m [Comment]
+space' judoc = comments
   where
-    lineComment :: ParsecS r Comment
-    lineComment = do
-      let _commentType = CommentOneLine
-      when
-        judoc
-        (notFollowedBy (P.chunk Str.judocStart))
-      (_commentText, _commentInterval) <- interval $ do
-        void (P.chunk "--")
-        P.takeWhileP Nothing (/= '\n')
-      return Comment {..}
-
-    blockComment :: ParsecS r Comment
-    blockComment = do
-      let _commentType = CommentBlock
-      (_commentText, _commentInterval) <- interval $ do
-        void (P.chunk "{-")
-        pack <$> P.manyTill anySingle (P.chunk "-}")
-      return Comment {..}
+    comments :: m [Comment]
+    comments = hidden (go [])
+
+    go :: [Comment] -> m [Comment]
+    go acc = do
+      s <- sepSpace
+      m <- optional (comment s)
+      case m of
+        Nothing -> return (reverse acc)
+        Just c -> go (c : acc)
+      where
+        -- Returns `True` if it consumes at least one empty line
+        sepSpace :: m Bool
+        sepSpace = do
+          hspace_
+          s <- isJust <$> optional (newline >> hspace_ >> newline)
+          optional whiteSpace
+          return s
+
+    comment :: Bool -> m Comment
+    comment _commentPreceedingEmptyLine = lineComment <|> blockComment
+      where
+        lineComment :: m Comment
+        lineComment = do
+          let _commentType = CommentOneLine
+          when
+            judoc
+            (notFollowedBy (P.chunk Str.judocStart))
+          (_commentText, _commentInterval) <- interval $ do
+            void (P.chunk "--")
+            P.takeWhileP Nothing (/= '\n')
+          return Comment {..}
+
+        blockComment :: m Comment
+        blockComment = do
+          let _commentType = CommentBlock
+          (_commentText, _commentInterval) <- interval $ do
+            void (P.chunk "{-")
+            pack <$> P.manyTill anySingle (P.chunk "-}")
+          return Comment {..}
 
 integer' :: ParsecS r (Integer, Interval) -> ParsecS r (Integer, Interval)
 integer' dec = do
@@ -133,7 +162,7 @@ isDelimiter = (`elem` delimiterSymbols)
 validFirstChar :: Char -> Bool
 validFirstChar c = not (isNumber c || isSpace c || (c `elem` reservedSymbols))
 
-curLoc :: ParsecS r Loc
+curLoc :: MonadParsec e Text m => m Loc
 curLoc = do
   sp <- getSourcePos
   offset <- getOffset
@@ -142,7 +171,7 @@ curLoc = do
 onlyInterval :: ParsecS r a -> ParsecS r Interval
 onlyInterval = fmap snd . interval
 
-interval :: ParsecS r a -> ParsecS r (a, Interval)
+interval :: MonadParsec e Text m => m a -> m (a, Interval)
 interval ma = do
   start <- curLoc
   res <- ma