diff options
Diffstat (limited to 'src/Parser.hs')
-rw-r--r-- | src/Parser.hs | 30 |
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 |