Draft: Allow trailing triple-slash comments in Prisma

waspc/src/Wasp/Psl/Parser/Argument.hs

@@ -9,9 +9,9 @@ where
 import Text.Megaparsec (choice, optional, try)
 import qualified Text.Megaparsec.Char as C
 import qualified Wasp.Psl.Ast.Argument as Psl.Argument
-import Wasp.Psl.Parser.Common
-  ( Parser,
-    brackets,
+import Wasp.Psl.Parser.Common (Parser)
+import Wasp.Psl.Parser.Tokens
+  ( brackets,
     colon,
     commaSep,
     float,

waspc/src/Wasp/Psl/Parser/Common.hs

@@ -1,111 +1,14 @@
 module Wasp.Psl.Parser.Common
-  ( whiteSpace,
-    reserved,
-    identifier,
-    braces,
-    symbol,
-    parens,
-    stringLiteral,
-    brackets,
-    commaSep1,
-    commaSep,
-    colon,
-    float,
-    integer,
-    lexeme,
-    SourceCode,
+  ( SourceCode,
     Parser,
   )
 where
 
-import Control.Applicative (liftA2)
-import Data.Functor (void)
 import Data.Void (Void)
 import Text.Megaparsec
   ( Parsec,
-    between,
-    empty,
-    many,
-    manyTill,
-    notFollowedBy,
-    sepBy,
-    sepBy1,
-    takeWhileP,
-    try,
-    (<?>),
-    (<|>),
   )
-import qualified Text.Megaparsec.Char as C
-import qualified Text.Megaparsec.Char.Lexer as L
 
 type Parser = Parsec Void SourceCode
 
 type SourceCode = String
-
-reserved :: String -> Parser ()
-reserved name =
-  lexeme $ try $ C.string name >> (notFollowedBy identLetter <?> ("end of " ++ show name))
-
-identifier :: Parser String
-identifier =
-  lexeme $ try (ident <?> "identifier")
-  where
-    ident = liftA2 (:) identHead identTail
-    identHead = C.letterChar
-    identTail = many identLetter
-
-identLetter :: Parser Char
-identLetter = C.alphaNumChar <|> C.char '_'
-
-braces :: Parser a -> Parser a
-braces = between (symbol "{") (symbol "}")
-
-parens :: Parser a -> Parser a
-parens = between (symbol "(") (symbol ")")
-
-stringLiteral :: Parser String
-stringLiteral = lexeme $ quote >> manyTill L.charLiteral quote
-  where
-    quote = C.char '"'
-
-brackets :: Parser a -> Parser a
-brackets = between (symbol "[") (symbol "]")
-
-commaSep1 :: Parser a -> Parser [a]
-commaSep1 = flip sepBy1 comma
-
-commaSep :: Parser a -> Parser [a]
-commaSep = flip sepBy comma
-
-comma :: Parser String
-comma = symbol ","
-
-colon :: Parser String
-colon = symbol ":"
-
-symbol :: String -> Parser String
-symbol = L.symbol whiteSpace
-
-float :: Parser Double
-float = L.signed whiteSpace unsignedFloat
-  where
-    unsignedFloat = lexeme L.float
-
-integer :: Parser Integer
-integer = L.signed whiteSpace unsignedInteger
-  where
-    unsignedInteger = lexeme L.decimal
-
-lexeme :: Parser a -> Parser a
-lexeme = L.lexeme whiteSpace
-
-whiteSpace :: Parser ()
-whiteSpace =
-  L.space (void C.spaceChar) (void lineComment) empty
-
-lineComment :: Parser String
-lineComment =
-  try doubleSlashSymbol
-    >> takeWhileP (Just "character") (/= '\n')
-  where
-    doubleSlashSymbol = C.string "//" >> notFollowedBy (C.char '/')

waspc/src/Wasp/Psl/Parser/ConfigBlock.hs

@@ -6,12 +6,13 @@ module Wasp.Psl.Parser.ConfigBlock
   )
 where
 
-import Text.Megaparsec (choice, many, try)
+import Text.Megaparsec (choice, sepEndBy, try)
 import qualified Wasp.Psl.Ast.ConfigBlock as Psl.ConfigBlock
 import Wasp.Psl.Parser.Argument (expression)
-import Wasp.Psl.Parser.Common
-  ( Parser,
-    braces,
+import Wasp.Psl.Parser.Common (Parser)
+import Wasp.Psl.Parser.Lexer (compulsoryNewline)
+import Wasp.Psl.Parser.Tokens
+  ( braces,
     identifier,
     reserved,
     symbol,
@@ -35,7 +36,7 @@ configBlock = do
   Psl.ConfigBlock.ConfigBlock configBlockType name <$> configBlockBody
 
 configBlockBody :: Parser [Psl.ConfigBlock.KeyValuePair]
-configBlockBody = braces (many keyValuePair)
+configBlockBody = braces $ keyValuePair `sepEndBy` compulsoryNewline
 
 -- | Parses a key-value pair.
 -- Example of PSL key-value pair:

waspc/src/Wasp/Psl/Parser/Enum.hs

@@ -3,12 +3,13 @@ module Wasp.Psl.Parser.Enum
   )
 where
 
-import Text.Megaparsec (choice, many, some, try)
+import Text.Megaparsec (choice, many, sepEndBy1, try)
 import qualified Wasp.Psl.Ast.Enum as Psl.Enum
 import Wasp.Psl.Parser.Attribute (attribute, blockAttribute)
-import Wasp.Psl.Parser.Common
-  ( Parser,
-    braces,
+import Wasp.Psl.Parser.Common (Parser)
+import Wasp.Psl.Parser.Lexer (compulsoryNewline)
+import Wasp.Psl.Parser.Tokens
+  ( braces,
     identifier,
     reserved,
   )
@@ -25,7 +26,7 @@ enum :: Parser Psl.Enum.Enum
 enum = do
   reserved "enum"
   enumName <- identifier
-  Psl.Enum.Enum enumName <$> braces (some $ withCtx enumField)
+  Psl.Enum.Enum enumName <$> braces (withCtx enumField `sepEndBy1` compulsoryNewline)
 
 enumField :: Parser Psl.Enum.Element
 enumField =

waspc/src/Wasp/Psl/Parser/Lexer.hs

@@ -0,0 +1,63 @@
+module Wasp.Psl.Parser.Lexer
+  ( compulsoryNewline,
+    lexeme,
+    spaceConsumer,
+    spaceConsumerNL,
+  )
+where
+
+import qualified Data.Char as Char
+import Data.Functor (void)
+import Text.Megaparsec
+  ( MonadParsec (label),
+    empty,
+    notFollowedBy,
+    satisfy,
+    takeWhileP,
+    try,
+    (<?>),
+    (<|>),
+  )
+import qualified Text.Megaparsec.Char as C
+import qualified Text.Megaparsec.Char.Lexer as L
+import Wasp.Psl.Parser.Common (Parser)
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme spaceConsumer
+
+compulsoryNewline :: Parser ()
+compulsoryNewline = newline >> spaceConsumerNL
+
+spaceConsumerNL :: Parser ()
+spaceConsumerNL =
+  L.space
+    whiteSpaceNL
+    (void lineComment)
+    empty
+
+spaceConsumer :: Parser ()
+spaceConsumer =
+  L.space
+    whiteSpace
+    lineComment
+    empty
+
+lineComment :: Parser ()
+lineComment =
+  void $
+    label "line comment" $
+      try commentSymbol
+        >> takeWhileP (Just "character") (/= '\n')
+  where
+    commentSymbol = C.string "//" >> notFollowedBy newline
+
+whiteSpaceNL :: Parser ()
+whiteSpaceNL = whiteSpace <|> newline
+
+newline :: Parser ()
+newline = void C.newline <|> void C.crlf
+
+whiteSpace :: Parser ()
+whiteSpace = void (satisfy isNonNewlineSpace <?> "white space")
+  where
+    isNonNewlineSpace c = Char.Space == Char.generalCategory c

waspc/src/Wasp/Psl/Parser/Model.hs

@@ -7,20 +7,22 @@ where
 
 import Control.Arrow (left)
 import Data.Maybe (maybeToList)
-import Text.Megaparsec (choice, errorBundlePretty, many, optional, some, try)
+import Text.Megaparsec (choice, errorBundlePretty, many, optional, sepEndBy1, try)
 import qualified Text.Megaparsec as Megaparsec
 import qualified Wasp.Psl.Ast.Model as Psl.Model
 import Wasp.Psl.Parser.Attribute (attribute, blockAttribute)
 import Wasp.Psl.Parser.Common
   ( Parser,
     SourceCode,
-    braces,
+  )
+import Wasp.Psl.Parser.Lexer (compulsoryNewline, spaceConsumerNL)
+import Wasp.Psl.Parser.Tokens
+  ( braces,
     identifier,
     parens,
     reserved,
     stringLiteral,
     symbol,
-    whiteSpace,
   )
 import Wasp.Psl.Parser.WithCtx (withCtx)
 
@@ -29,7 +31,7 @@ import Wasp.Psl.Parser.WithCtx (withCtx)
 -- parser directly (meaning not as part of parsing the whole schema) which means that the
 -- leading whitespace is not consumed by the `schema` parser.
 parseBody :: SourceCode -> Either String Psl.Model.Body
-parseBody = left errorBundlePretty . Megaparsec.parse (whiteSpace >> body) ""
+parseBody = left errorBundlePretty . Megaparsec.parse (spaceConsumerNL >> body) ""
 
 -- | Parses PSL (Prisma Schema Language model).
 -- Example of PSL model:
@@ -48,7 +50,7 @@ model = do
 -- which is everything besides model keyword, name and braces:
 --   `model User { <body> }`.
 body :: Parser Psl.Model.Body
-body = Psl.Model.Body <$> some (withCtx element)
+body = Psl.Model.Body <$> (withCtx element `sepEndBy1` compulsoryNewline)
 
 element :: Parser Psl.Model.Element
 element =

waspc/src/Wasp/Psl/Parser/Schema.hs

@@ -6,12 +6,13 @@ module Wasp.Psl.Parser.Schema
 where
 
 import Control.Arrow (left)
-import Text.Megaparsec (choice, eof, errorBundlePretty, many)
+import Text.Megaparsec (choice, eof, errorBundlePretty, sepEndBy)
 import qualified Text.Megaparsec as Megaparsec
 import qualified Wasp.Psl.Ast.Schema as Psl.Schema
-import Wasp.Psl.Parser.Common (Parser, SourceCode, whiteSpace)
+import Wasp.Psl.Parser.Common (Parser, SourceCode)
 import Wasp.Psl.Parser.ConfigBlock (configBlock)
 import Wasp.Psl.Parser.Enum (enum)
+import Wasp.Psl.Parser.Lexer (compulsoryNewline, spaceConsumerNL)
 import Wasp.Psl.Parser.Model (model)
 import Wasp.Psl.Parser.Type (typeBlock)
 import Wasp.Psl.Parser.View (view)
@@ -26,8 +27,8 @@ schema = do
   -- Megaparsec's lexeme parsers in the sub-parsers (model, enum, configBlock)
   -- which consume the (trailing) whitespace themselves. It's a bit of an
   -- implict behaviour that we need to be aware of.
-  whiteSpace
-  elements <- many $ withCtx block
+  spaceConsumerNL
+  elements <- withCtx block `sepEndBy` compulsoryNewline
   -- We want to throw and if there is any source code left after parsing the schema.
   -- If we don't do this, the parser sometimes returns an empty schema when there
   -- are some syntax errors in the schema.