From c3efce4ff72f6284b1036df27edddbe0eae8026b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 2 Aug 2024 21:02:44 +0200
Subject: Module name declaration

Changelog: Accept module name declaration
---
 src/Main.hs        |  6 +++---
 src/Parser.hs      | 29 +++++++++++++++++++++--------
 src/Parser/Expr.hs |  2 ++
 src/Test.hs        |  6 ++++++
 4 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 594de0c..61afbd8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -149,10 +149,10 @@ main = do
     out <- startOutput (optVerbose opts) useColor
 
     tests <- forM files $ \(path, mbTestName) -> do
-        fileTests <- parseTestFile path
+        Module { .. } <- parseTestFile path
         return $ case mbTestName of
-            Nothing -> fileTests
-            Just name -> filter ((==name) . testName) fileTests
+            Nothing -> moduleTests
+            Just name -> filter ((==name) . testName) moduleTests
 
     ok <- allM (runTest out $ optTest opts) $
         concat $ replicate (optRepeat opts) $ concat tests
diff --git a/src/Parser.hs b/src/Parser.hs
index 830093f..9029e0f 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -6,14 +6,18 @@ module Parser (
 
 import Control.Monad.State
 
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.IO as TL
+import Data.Text (Text)
+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 System.Exit
+import System.FilePath
 
 import Parser.Core
+import Parser.Expr
 import Parser.Statement
 import Test
 
@@ -24,19 +28,28 @@ parseTestDefinition = label "test definition" $ toplevel $ do
               wsymbol "test"
               lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':')
 
-parseTestDefinitions :: TestParser [Test]
-parseTestDefinitions = do
-    tests <- many parseTestDefinition
+parseTestModule :: Text -> TestParser Module
+parseTestModule defaultName = do
+    moduleName <- choice
+        [ label "module declaration" $ do
+            wsymbol "module"
+            x <- identifier
+            (x:) <$> many (symbol "." >> identifier)
+        , do
+            return $ [ defaultName ]
+        ]
+    moduleTests <- many parseTestDefinition
     eof
-    return tests
+    return Module { .. }
 
-parseTestFile :: FilePath -> IO [Test]
+parseTestFile :: FilePath -> IO Module
 parseTestFile path = do
     content <- TL.readFile path
     let initState = TestParserState
             { testVars = []
             , testContext = SomeExpr RootNetwork
             }
-    case evalState (runParserT parseTestDefinitions path content) initState of
+        defaultModuleName = T.pack $ takeBaseName path
+    case evalState (runParserT (parseTestModule defaultModuleName) path content) initState of
          Left err -> putStr (errorBundlePretty err) >> exitFailure
          Right tests -> return tests
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index 894856e..fee5c25 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -1,4 +1,6 @@
 module Parser.Expr (
+    identifier,
+
     varName,
     newVarName,
     addVarName,
diff --git a/src/Test.hs b/src/Test.hs
index d080cae..7f698a2 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -1,4 +1,5 @@
 module Test (
+    Module(..),
     Test(..),
     TestStep(..),
     SourceLine(..),
@@ -30,6 +31,11 @@ import {-# SOURCE #-} Network
 import {-# SOURCE #-} Process
 import Util
 
+data Module = Module
+    { moduleName :: [ Text ]
+    , moduleTests :: [ Test ]
+    }
+
 data Test = Test
     { testName :: Text
     , testSteps :: [TestStep]
-- 
cgit v1.2.3