blob: 4fd60b5d6e513b9d05de9067b0e06dc6b6c9ed7a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
{-# OPTIONS_GHC -Wno-orphans #-}
module Parser (
parseTestFile,
) where
import Control.Monad.State
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
import Parser.Core
import Parser.Expr
import Parser.Statement
import Test
parseTestDefinition :: TestParser Test
parseTestDefinition = label "test definition" $ toplevel $ do
block (\name steps -> return $ Test name $ concat steps) header testStep
where header = do
wsymbol "test"
lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':')
parseTestModule :: FilePath -> TestParser Module
parseTestModule absPath = do
moduleName <- choice
[ label "module declaration" $ do
wsymbol "module"
off <- stateOffset <$> getParserState
x <- identifier
name <- (x:) <$> many (symbol "." >> identifier)
when (or (zipWith (/=) (reverse name) (reverse $ map T.pack $ splitDirectories $ dropExtension $ absPath))) $ do
registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
"module name does not match file path"
eol >> scn
return name
, do
return $ [ T.pack $ takeBaseName absPath ]
]
moduleTests <- many parseTestDefinition
eof
return Module { .. }
parseTestFile :: FilePath -> IO Module
parseTestFile path = do
content <- TL.readFile path
absPath <- makeAbsolute path
let initState = TestParserState
{ testVars = []
, testContext = SomeExpr RootNetwork
}
case evalState (runParserT (parseTestModule absPath) path content) initState of
Left err -> putStr (errorBundlePretty err) >> exitFailure
Right testModule -> return testModule
|