From 321859ab1fe4a6b1f3cc7084b8836474ff872e2b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 29 Sep 2024 14:26:21 +0200
Subject: User-defined test functions without parameters

---
 src/Parser/Core.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

(limited to 'src/Parser')

diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index cb66529..10a572b 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -1,8 +1,9 @@
 module Parser.Core where
 
+import Control.Applicative
 import Control.Monad
+import Control.Monad.Identity
 import Control.Monad.State
-import Control.Monad.Writer
 
 import Data.Map (Map)
 import Data.Map qualified as M
@@ -20,14 +21,25 @@ import qualified Text.Megaparsec.Char.Lexer as L
 import Network ()
 import Test
 
-type TestParser = StateT TestParserState (ParsecT Void TestStream (Writer [ Toplevel ]))
+newtype TestParser a = TestParser (StateT TestParserState (ParsecT Void TestStream Identity) a)
+    deriving
+        ( Functor, Applicative, Alternative, Monad
+        , MonadState TestParserState
+        , MonadPlus
+        , MonadFail
+        , MonadParsec Void TestStream
+        )
 
 type TestStream = TL.Text
 
 type TestParseError = ParseError TestStream Void
 
+runTestParser :: String -> TestStream -> TestParserState -> TestParser a -> Either (ParseErrorBundle TestStream Void) a
+runTestParser path content initState (TestParser parser) = runIdentity . flip (flip runParserT path) content . flip evalStateT initState $ parser
+
 data Toplevel
     = ToplevelTest Test
+    | ToplevelDefinition ( VarName, SomeVarValue )
 
 data TestParserState = TestParserState
     { testVars :: [ ( VarName, SomeExprType ) ]
@@ -191,8 +203,8 @@ localState inner = do
     put s
     return x
 
-toplevel :: (a -> Toplevel) -> TestParser a -> TestParser ()
-toplevel f = tell . (: []) . f <=< L.nonIndented scn
+toplevel :: (a -> Toplevel) -> TestParser a -> TestParser Toplevel
+toplevel f = return . f <=< L.nonIndented scn
 
 block :: (a -> [b] -> TestParser c) -> TestParser a -> TestParser b -> TestParser c
 block merge header item = L.indentBlock scn $ do
-- 
cgit v1.2.3