summaryrefslogtreecommitdiff
path: root/src/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser.hs')
-rw-r--r--src/Parser.hs30
1 files changed, 24 insertions, 6 deletions
diff --git a/src/Parser.hs b/src/Parser.hs
index 6d6809b..e63f854 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -6,7 +6,6 @@ module Parser (
import Control.Monad
import Control.Monad.State
-import Control.Monad.Writer
import Data.Map qualified as M
import Data.Maybe
@@ -17,6 +16,7 @@ import Data.Text.Lazy.IO qualified as TL
import Text.Megaparsec hiding (State)
import Text.Megaparsec.Char
+import Text.Megaparsec.Char.Lexer qualified as L
import System.Directory
import System.Exit
@@ -28,13 +28,29 @@ import Parser.Statement
import Test
import Test.Builtins
-parseTestDefinition :: TestParser ()
+parseTestDefinition :: TestParser Toplevel
parseTestDefinition = label "test definition" $ toplevel ToplevelTest $ do
block (\name steps -> return $ Test name $ concat steps) header testStep
where header = do
wsymbol "test"
lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':')
+parseDefinition :: TestParser Toplevel
+parseDefinition = label "symbol definition" $ toplevel ToplevelDefinition $ do
+ def <- localState $ L.indentBlock scn $ do
+ wsymbol "def"
+ name <- varName
+ choice
+ [ do
+ symbol ":"
+ let finish steps = do
+ return $ ( name, ) $ SomeVarValue mempty $ \_ _ -> TestBlock $
+ concat steps
+ return $ L.IndentSome Nothing finish testStep
+ ]
+ modify $ \s -> s { testVars = fmap someVarValueType def : testVars s }
+ return def
+
parseTestModule :: FilePath -> TestParser Module
parseTestModule absPath = do
moduleName <- choice
@@ -51,12 +67,14 @@ parseTestModule absPath = do
, do
return $ [ T.pack $ takeBaseName absPath ]
]
- (_, toplevels) <- listen $ many $ choice
+ toplevels <- many $ choice
[ parseTestDefinition
+ , parseDefinition
]
- let moduleTests = catMaybes $ map (\case ToplevelTest x -> Just x; {- _ -> Nothing -}) toplevels
+ let moduleTests = catMaybes $ map (\case ToplevelTest x -> Just x; _ -> Nothing) toplevels
+ moduleDefinitions = catMaybes $ map (\case ToplevelDefinition x -> Just x; _ -> Nothing) toplevels
eof
- return Module { .. }
+ return Module {..}
parseTestFile :: FilePath -> IO Module
parseTestFile path = do
@@ -70,7 +88,7 @@ parseTestFile path = do
, testNextTypeVar = 0
, testTypeUnif = M.empty
}
- (res, _) = runWriter $ flip (flip runParserT path) content $ flip evalStateT initState $ parseTestModule absPath
+ res = runTestParser path content initState $ parseTestModule absPath
case res of
Left err -> putStr (errorBundlePretty err) >> exitFailure