From 06f36e701ad8a036229aa7cbadf4cd47527cdcc2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 3 Aug 2024 19:18:43 +0200
Subject: Check if module name matches file path

---
 src/Parser.hs | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index 9029e0f..cd9b590 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -6,13 +6,15 @@ module Parser (
 
 import Control.Monad.State
 
-import Data.Text (Text)
+import Data.Set qualified as S
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.IO qualified as TL
 
 import Text.Megaparsec hiding (State)
+import Text.Megaparsec.Char
 
+import System.Directory
 import System.Exit
 import System.FilePath
 
@@ -28,15 +30,21 @@ parseTestDefinition = label "test definition" $ toplevel $ do
               wsymbol "test"
               lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':')
 
-parseTestModule :: Text -> TestParser Module
-parseTestModule defaultName = do
+parseTestModule :: FilePath -> TestParser Module
+parseTestModule absPath = do
     moduleName <- choice
         [ label "module declaration" $ do
             wsymbol "module"
+            off <- stateOffset <$> getParserState
             x <- identifier
-            (x:) <$> many (symbol "." >> identifier)
+            name <- (x:) <$> many (symbol "." >> identifier)
+            when (or (zipWith (/=) (reverse name) (reverse $ map T.pack $ splitDirectories $ dropExtension $ absPath))) $ do
+                parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
+                    "module name does not match file path"
+            eol >> scn
+            return name
         , do
-            return $ [ defaultName ]
+            return $ [ T.pack $ takeBaseName absPath ]
         ]
     moduleTests <- many parseTestDefinition
     eof
@@ -45,11 +53,11 @@ parseTestModule defaultName = do
 parseTestFile :: FilePath -> IO Module
 parseTestFile path = do
     content <- TL.readFile path
+    absPath <- makeAbsolute path
     let initState = TestParserState
             { testVars = []
             , testContext = SomeExpr RootNetwork
             }
-        defaultModuleName = T.pack $ takeBaseName path
-    case evalState (runParserT (parseTestModule defaultModuleName) path content) initState of
+    case evalState (runParserT (parseTestModule absPath) path content) initState of
          Left err -> putStr (errorBundlePretty err) >> exitFailure
-         Right tests -> return tests
+         Right testModule -> return testModule
-- 
cgit v1.2.3