allow whitespace before world DSL terms!

src/Swarm/Game/World/Parse.hs

@@ -20,6 +20,7 @@ import Data.Void
 import Data.Yaml (FromJSON (parseJSON), withText)
 import Swarm.Game.World.Syntax
 import Swarm.Util (failT, showT, squote)
+import Swarm.Util.Parse (fully)
 import Text.Megaparsec hiding (runParser)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer qualified as L
@@ -252,13 +253,13 @@ parseImport = WImport . into @Text <$> between (symbol "\"") (symbol "\"") (some
 -- Utility
 
 runParser :: Parser a -> Text -> Either ParserError a
-runParser p = parse p ""
+runParser p = parse (fully sc p) ""
 
 ------------------------------------------------------------
 -- JSON instance
 
 instance FromJSON WExp where
   parseJSON = withText "World DSL program" $ \t ->
-    case runParser (parseWExp <* eof) t of
+    case runParser parseWExp t of
       Left err -> error (errorBundlePretty err)
       Right wexp -> return wexp

src/Swarm/Language/Parse.hs

@@ -55,6 +55,7 @@ import Data.Void
 import Swarm.Language.Syntax
 import Swarm.Language.Types
 import Swarm.Util (failT, findDup, squote)
+import Swarm.Util.Parse (fully, fullyMaybe)
 import Text.Megaparsec hiding (runParser)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer qualified as L
@@ -481,7 +482,7 @@ runParser p t = first (from . errorBundlePretty) (parse (runReaderT p DisallowAn
 --   "Swarm.Language.Parse.QQ"), with a specified source position.
 runParserTH :: (Monad m, MonadFail m) => (String, Int, Int) -> Parser a -> String -> m a
 runParserTH (file, line, col) p s =
-  case snd (runParser' (runReaderT (fully p) AllowAntiquoting) initState) of
+  case snd (runParser' (runReaderT (fully sc p) AllowAntiquoting) initState) of
     Left err -> fail $ errorBundlePretty err
     Right e -> return e
  where
@@ -505,29 +506,18 @@ runParserTH (file, line, col) p s =
       , stateParseErrors = []
       }
 
--- | Run a parser "fully", consuming leading whitespace and ensuring
---   that the parser extends all the way to eof.
-fully :: Parser a -> Parser a
-fully p = sc *> p <* eof
-
--- | Run a parser "fully", consuming leading whitespace (including the
---   possibility that the input is nothing but whitespace) and
---   ensuring that the parser extends all the way to eof.
-fullyMaybe :: Parser a -> Parser (Maybe a)
-fullyMaybe = fully . optional
-
 -- | Parse some input 'Text' completely as a 'Term', consuming leading
 --   whitespace and ensuring the parsing extends all the way to the
 --   end of the input 'Text'.  Returns either the resulting 'Term' (or
 --   @Nothing@ if the input was only whitespace) or a pretty-printed
 --   parse error message.
 readTerm :: Text -> Either Text (Maybe Syntax)
-readTerm = runParser (fullyMaybe parseTerm)
+readTerm = runParser (fullyMaybe sc parseTerm)
 
 -- | A lower-level `readTerm` which returns the megaparsec bundle error
 --   for precise error reporting.
 readTerm' :: Text -> Either ParserError (Maybe Syntax)
-readTerm' = parse (runReaderT (fullyMaybe parseTerm) DisallowAntiquoting) ""
+readTerm' = parse (runReaderT (fullyMaybe sc parseTerm) DisallowAntiquoting) ""
 
 -- | A utility for converting a ParserError into a one line message:
 --   <line-nr>: <error-msg>

src/Swarm/Util/Parse.hs

@@ -0,0 +1,19 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Parsing utilities for Swarm.
+module Swarm.Util.Parse where
+
+import Control.Applicative (optional)
+import Text.Megaparsec (MonadParsec, eof)
+
+-- | Run a parser "fully", consuming leading whitespace and ensuring
+--   that the parser extends all the way to eof.
+fully :: (MonadParsec e s f) => f () -> f a -> f a
+fully sc p = sc *> p <* eof
+
+-- | Run a parser "fully", consuming leading whitespace (including the
+--   possibility that the input is nothing but whitespace) and
+--   ensuring that the parser extends all the way to eof.
+fullyMaybe :: (MonadParsec e s f) => f () -> f a -> f (Maybe a)
+fullyMaybe sc = fully sc . optional

swarm.cabal

@@ -198,6 +198,7 @@ library
                       Swarm.Util.Effect
                       Swarm.Util.Erasable
                       Swarm.Util.Lens
+                      Swarm.Util.Parse
                       Swarm.Util.Yaml
                       Swarm.Version
                       Swarm.Web