Disallow tab characters as spaces (#1523)

examples/milestone/Collatz/Collatz.juvix

@@ -11,7 +11,7 @@ div2 zero ≔ just zero;
 div2 (suc (suc n)) ≔ mapMaybe suc (div2 n);
 div2 _ ≔ nothing;
 
-collatzNext : ℕ → ℕ;
+collatzNext : ℕ → ℕ;
 collatzNext n ≔ fromMaybe (suc (3 * n)) (div2 n);
 
 collatz : ℕ → ℕ;

src/Juvix/Parser/Lexer.hs

@@ -1,20 +1,15 @@
+-- | This module contains lexing functions common to all parsers in the pipeline
+-- (Juvix, JuvixCore, JuvixAsm).
 module Juvix.Parser.Lexer where
 
-{-
-
-This module contains lexing functions common to all parsers in the pipeline
-(Juvix, JuvixCore, JuvixAsm).
-
--}
-
 import Control.Monad.Trans.Class (lift)
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import GHC.Unicode
 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)
+import Text.Megaparsec.Char hiding (space, space1)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 type ParsecS r = ParsecT Void Text (Sem r)
@@ -28,6 +23,12 @@ makeLenses ''ParserParams
 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
+  where
+    isWhiteSpace :: Char -> Bool
+    isWhiteSpace = (`elem` [' ', '\n'])
+
 space' :: forall r. Bool -> (forall a. ParsecS r a -> ParsecS r ()) -> ParsecS r ()
 space' judoc comment_ = L.space space1 lineComment block
   where
@@ -99,7 +100,7 @@ reservedSymbols :: [Char]
 reservedSymbols = "\";(){}[].≔λ\\"
 
 validFirstChar :: Char -> Bool
-validFirstChar c = not $ isNumber c || isSpace c || (c `elem` reservedSymbols)
+validFirstChar c = not (isNumber c || isSpace c || (c `elem` reservedSymbols))
 
 curLoc :: Member (Reader ParserParams) r => ParsecS r Loc
 curLoc = do

test/Main.hs

@@ -4,6 +4,7 @@ import Arity qualified
 import BackendC qualified
 import Base
 import Core qualified
+import Parsing qualified
 import Reachability qualified
 import Scope qualified
 import Termination qualified
@@ -21,7 +22,8 @@ fastTests :: TestTree
 fastTests =
   testGroup
     "Juvix fast tests"
-    [ Scope.allTests,
+    [ Parsing.allTests,
+      Scope.allTests,
       Termination.allTests,
       Arity.allTests,
       TypeCheck.allTests,

test/Parsing.hs

@@ -0,0 +1,10 @@
+module Parsing
+  ( allTests,
+  )
+where
+
+import Base
+import Parsing.Negative qualified as N
+
+allTests :: TestTree
+allTests = testGroup "Parsing tests" [N.allTests]

test/Parsing/Negative.hs

@@ -0,0 +1,44 @@
+module Parsing.Negative where
+
+import Base
+import Juvix.Compiler.Pipeline
+import Juvix.Parser.Error
+
+root :: FilePath
+root = "tests/negative"
+
+data NegTest = NegTest
+  { _name :: String,
+    _relDir :: FilePath,
+    _file :: FilePath
+  }
+
+testDescr :: NegTest -> TestDescr
+testDescr NegTest {..} =
+  let tRoot = root </> _relDir
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Single $ do
+            let entryPoint = defaultEntryPoint _file
+            res <- runIOEither (upToParsing entryPoint)
+            case mapLeft fromJuvixError res of
+              Left (Just (_ :: ParserError)) -> return ()
+              Left Nothing -> assertFailure "The parser did not find an error."
+              Right _ -> assertFailure "An error ocurred but it was not in the parser."
+        }
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "Parsing negative tests"
+    ( map (mkTest . testDescr) scoperErrorTests
+    )
+
+scoperErrorTests :: [NegTest]
+scoperErrorTests =
+  [ NegTest
+      "Tab character"
+      "."
+      "Tab.juvix"
+  ]

tests/negative/Tab.juvix

@@ -0,0 +1,3 @@
+module 	Tab;
+
+end;