diff options
Diffstat (limited to 'src/Parser.hs')
| -rw-r--r-- | src/Parser.hs | 96 |
1 files changed, 72 insertions, 24 deletions
diff --git a/src/Parser.hs b/src/Parser.hs index 2ab64ef..5b8f003 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -75,7 +75,7 @@ block :: (a -> [b] -> TestParser c) -> TestParser a -> TestParser b -> TestParse block merge header item = L.indentBlock scn $ do h <- header choice - [ do try $ void $ lexeme $ char ':' + [ do symbol ":" return $ L.IndentSome Nothing (merge h) item , L.IndentNone <$> merge h [] ] @@ -285,15 +285,19 @@ getSourceLine = do letStatement :: TestParser [TestStep] letStatement = do line <- getSourceLine + indent <- L.indentLevel wsymbol "let" name <- VarName . (:[]) <$> identifier symbol "=" SomeExpr (e :: Expr a) <- someExpr void $ eol + s <- get addVarName @a Proxy name - return [Let line name e] + body <- testBlock indent + put s + return [Let line name e body] class Typeable a => ParamType a where parseParam :: TestParser a @@ -347,51 +351,79 @@ param name = CommandDef [(name, SomeParam (Proxy @a))] (\[SomeParam (Identity x) cmdLine :: CommandDef SourceLine cmdLine = param "" -command :: String -> CommandDef a -> TestParser [a] +data InnerBlock + +instance ParamType InnerBlock where + parseParam = mzero + showParamType _ = "<code block>" + +instance ParamType TestStep where + parseParam = mzero + showParamType _ = "<code line>" + +innerBlock :: CommandDef [TestStep] +innerBlock = CommandDef [("", SomeParam (Proxy @InnerBlock))] (\[SomeParam (Identity x)] -> fromJust $ cast x) + +command :: String -> CommandDef TestStep -> TestParser [TestStep] command name (CommandDef types ctor) = do + indent <- L.indentLevel line <- getSourceLine - L.indentBlock scn $ do - wsymbol name - helper line $ map (fmap $ \(SomeParam (_ :: Proxy p)) -> SomeParam $ Nothing @p) types + wsymbol name + restOfLine indent [] line $ map (fmap $ \(SomeParam (_ :: Proxy p)) -> SomeParam $ Nothing @p) types where - helper line params = choice + restOfLine :: Pos -> [(Pos, [(String, SomeParam Maybe)])] -> SourceLine -> [(String, SomeParam Maybe)] -> TestParser [TestStep] + restOfLine cmdi partials line params = choice [do void $ lookAhead eol iparams <- forM params $ \case (_, SomeParam (Nothing :: Maybe p)) | Just (Refl :: p :~: SourceLine) <- eqT -> return $ SomeParam $ Identity line + | Just (Refl :: p :~: InnerBlock) <- eqT -> SomeParam . Identity <$> restOfParts cmdi partials (sym, SomeParam (Nothing :: Maybe p)) -> choice [ SomeParam . Identity <$> paramDefault @p , fail $ "missing " ++ (if null sym then "" else "'" ++ sym ++ "' ") ++ showParamType @p Proxy ] (_, SomeParam (Just x)) -> return $ SomeParam $ Identity x - return $ L.IndentNone [ctor iparams] + return [ctor iparams] ,do symbol ":" - return $ L.IndentSome Nothing (return . concat) $ do - line' <- getSourceLine - L.indentBlock scn $ helper line' params + scn + indent <- L.indentLevel + restOfParts cmdi ((indent, params) : partials) - ,do tryParams line [] params + ,do tryParams cmdi partials line [] params ] + restOfParts :: Pos -> [(Pos, [(String, SomeParam Maybe)])] -> TestParser [TestStep] + restOfParts cmdi [] = testBlock cmdi + restOfParts cmdi partials@((partIndent, params) : rest) = do + scn + pos <- L.indentLevel + line <- getSourceLine + optional eof >>= \case + Just _ -> return [] + _ | pos < partIndent -> restOfParts cmdi rest + | pos == partIndent -> (++) <$> restOfLine cmdi partials line params <*> restOfParts cmdi partials + | otherwise -> L.incorrectIndent EQ partIndent pos + tryParam sym (SomeParam (cur :: Maybe p)) = do when (not $ null sym) $ wsymbol sym when (isJust cur) $ do fail $ "multiple " ++ (if null sym then "unnamed" else "'" ++ sym ++ "'") ++ " parameters" SomeParam . Just <$> parseParam @p - tryParams line prev ((sym, p) : ps) = choice $ + tryParams cmdi partIndent line prev ((sym, p) : ps) = choice $ (if null sym then reverse else id) {- try unnamed parameter as last option -} $ [do p' <- tryParam sym p - helper line $ concat [reverse prev, [(sym, p')], ps] - ,do tryParams line ((sym, p) : prev) ps + restOfLine cmdi partIndent line $ concat [reverse prev, [(sym, p')], ps] + ,do tryParams cmdi partIndent line ((sym, p) : prev) ps ] - tryParams _ _ [] = mzero + tryParams _ _ _ _ [] = mzero testSpawn :: TestParser [TestStep] testSpawn = command "spawn" $ Spawn <$> param "as" <*> param "on" + <*> innerBlock testSend :: TestParser [TestStep] testSend = command "send" $ Send @@ -404,6 +436,7 @@ testExpect = command "expect" $ Expect <*> param "from" <*> param "" <*> param "capture" + <*> innerBlock testGuard :: TestParser [TestStep] testGuard = command "guard" $ Guard @@ -416,16 +449,31 @@ testWait = do wsymbol "wait" return [Wait] +testBlock :: Pos -> TestParser [TestStep] +testBlock indent = concat <$> go + where + go = do + scn + pos <- L.indentLevel + optional eof >>= \case + Just _ -> return [] + _ | pos < indent -> return [] + | pos == indent -> (:) <$> testStep <*> go + | otherwise -> L.incorrectIndent EQ indent pos + +testStep :: TestParser [TestStep] +testStep = choice + [ letStatement + , testSpawn + , testSend + , testExpect + , testGuard + , testWait + ] + parseTestDefinition :: TestParser Test parseTestDefinition = label "test definition" $ toplevel $ do - block (\name steps -> return $ Test name $ concat steps) header $ choice - [ letStatement - , testSpawn - , testSend - , testExpect - , testGuard - , testWait - ] + block (\name steps -> return $ Test name $ concat steps) header testStep where header = do wsymbol "test" lexeme $ TL.toStrict <$> takeWhileP (Just "test name") (/=':') |