Skip to content
Browse files

taggable scenarios

  • Loading branch information...
1 parent f6c4a68 commit c37e59b61f469014c9d3fba5aa660cefa77dfbc0 @sakari committed May 21, 2012
Showing with 77 additions and 48 deletions.
  1. +4 −2 Language/Gherkin/AST.hs
  2. +21 −7 Language/Gherkin/Parser.hs
  3. +11 −5 Language/Gherkin/Pretty.hs
  4. +31 −29 tests/Instances.hs
  5. +10 −5 tests/Main.hs
View
6 Language/Gherkin/AST.hs
@@ -10,10 +10,12 @@ data Feature = Feature { feature_tags :: [Tag]
type Tag = String
-data Scenario = Scenario { scenario_name :: String
+data Scenario = Scenario { scenario_tags :: [Tag]
+ , scenario_name :: String
, scenario_steps :: [Step]
}
- | ScenarioOutline { scenario_name :: String
+ | ScenarioOutline { scenario_tags :: [Tag]
+ , scenario_name :: String
, scenario_steps :: [Step]
, scenario_table :: Table
}
View
28 Language/Gherkin/Parser.hs
@@ -9,7 +9,7 @@ import Control.Applicative
parseFeature :: Parser Feature
parseFeature = do
- tags <- option [] $ line $ parseTag `sepBy` ws
+ tags <- parseTags
string_ "Feature:"
name <- parseLine
description <- parseDescription
@@ -26,8 +26,11 @@ parseFeature = do
emptyLines :: Parser ()
emptyLines = skipMany $ try $ ws >> newline_
-parseTag :: Parser Tag
-parseTag = char '@' >> many1 alphaNum
+parseTags :: Parser [Tag]
+parseTags = option [] $ line $ parseTag `sepBy` ws
+ where
+ parseTag :: Parser Tag
+ parseTag = char '@' >> many1 alphaNum
parseDescription :: Parser String
parseDescription = fmap concat $ description
@@ -39,6 +42,7 @@ parseDescription = fmap concat $ description
, string_ "Scenario:"
, string_ "Feature:"
, string_ "Background:"
+ , string_ "@"
, eof])
parseBackground :: Parser Background
@@ -68,25 +72,35 @@ parseScenarioOutline :: Parser Scenario
parseScenarioOutline = scenarioOutline
where
scenarioOutline = do
- try $ ws >> string_ "Scenario-outline:"
+ tags <- try $ parseTags `followedBy`
+ (ws >> string_ "Scenario-outline:")
name <- parseLine
steps <- many parseStep
line $ string_ "Examples:"
table <- parseTable
- return $ ScenarioOutline { scenario_name = name
+ return $ ScenarioOutline { scenario_tags = tags
+ , scenario_name = name
, scenario_steps = steps
, scenario_table = table
}
+followedBy :: Parser a -> Parser () -> Parser a
+followedBy p by = do
+ r <- p
+ by
+ return r
+
parseScenario :: Parser Scenario
parseScenario = scenario
where
scenario = do
- try $ ws >> string_ "Scenario:"
+ tags <- try $ parseTags `followedBy`
+ (ws >> string_ "Scenario:")
name <- parseLine
steps <- many parseStep
spaces_
- return $ Scenario { scenario_name = name
+ return $ Scenario { scenario_tags = tags
+ , scenario_name = name
, scenario_steps = steps
}
View
16 Language/Gherkin/Pretty.hs
@@ -25,15 +25,21 @@ prettyBackground (Background steps) = text "Background:" $+$
vcat $ map prettyStep steps)
prettyScenario :: Scenario -> Doc
-prettyScenario Scenario { scenario_name
+prettyScenario Scenario { scenario_tags
+ , scenario_name
, scenario_steps
- } = text "Scenario:" <+> text scenario_name $+$
- (nest 4 $
- vcat $ map prettyStep scenario_steps)
-prettyScenario ScenarioOutline { scenario_name
+ } =
+ hsep (map (text . ("@" ++)) scenario_tags) $+$
+ text "Scenario:" <+> text scenario_name $+$
+ (nest 4 $
+ vcat $ map prettyStep scenario_steps)
+
+prettyScenario ScenarioOutline { scenario_tags
+ , scenario_name
, scenario_steps
, scenario_table
} =
+ hsep (map (text . ("@" ++)) scenario_tags) $+$
text "Scenario-outline:" <+>
text scenario_name $+$
(nest 4 $
View
60 tests/Instances.hs
@@ -16,24 +16,24 @@ shrinkTag :: String -> [String]
shrinkTag tag = filter notEmpty $ shrinkList1 (`elem` tagChars) tag
where
notEmpty t = not $ null t
-
+
shrinkTags :: [String] -> [[String]]
shrinkTags = shrinkList shrinkTag
-
+
shrinkList1 :: Arbitrary a => (a -> Bool) -> [a] -> [[a]]
shrinkList1 p ls = filter null $ fmap (filter p) $ shrink ls
-
+
shrinkName :: String -> [String]
shrinkName name = shrinkList1 (`elem` nameChars) name
nameChars :: String
nameChars = ['a' .. 'z'] ++
['0' .. '9'] ++
"+/"
-
+
genName :: Gen String
genName = do
- h <- elements nameChars
+ h <- elements nameChars
t <- listOf $ elements (' ':nameChars)
e <- elements nameChars
return $ h:t ++ [e]
@@ -44,7 +44,7 @@ genStepText = do
t <- listOf $ elements (' ':stepChars)
e <- elements stepChars
return $ h:t ++ [e]
-
+
stepChars :: String
stepChars = ['a' .. 'z'] ++ ['0' .. '9'] ++ "\"'-_<>()[]{}.,;"
@@ -62,61 +62,63 @@ smaller :: Gen a -> Gen a
smaller gen = sized $ \s -> resize (s `div` 2) gen
instance Arbitrary Scenario where
- arbitrary = oneof [Scenario <$> genName <*> arbitrary
- , ScenarioOutline <$> genName <*> arbitrary <*> arbitrary
+ arbitrary = oneof [Scenario <$> listOf1 genTag <*> genName <*> arbitrary
+ , ScenarioOutline <$> listOf1 genTag <*> genName <*> arbitrary <*> arbitrary
]
- shrink (Scenario name steps) = tail' $ Scenario <$>
- (name : shrinkName name) <*>
- (steps : shrink steps)
- shrink (ScenarioOutline name steps table) = tail' $ ScenarioOutline <$>
- (name : shrinkName name) <*>
- (steps : shrink steps) <*>
- (table : shrink table)
+ shrink (Scenario tags name steps) =
+ tail' $ Scenario tags <$>
+ (name : shrinkName name) <*>
+ (steps : shrink steps)
+ shrink (ScenarioOutline tags name steps table) =
+ tail' $ ScenarioOutline tags <$>
+ (name : shrinkName name) <*>
+ (steps : shrink steps) <*>
+ (table : shrink table)
instance Arbitrary Step where
arbitrary = elements [Given, Then, When, And] <*> arbitrary
shrink (Given steps) = Given <$> shrink steps
shrink (Then steps) = [Given steps] ++ (Then <$> shrink steps)
shrink (When steps) = [Given steps] ++ (When <$> shrink steps)
shrink (And steps) = [Given steps] ++ (And <$> shrink steps)
-
+
instance Arbitrary Background where
arbitrary = Background <$> listOf1 arbitrary
shrink (Background steps) = tail' $ Background <$> filter (not . null) (steps:shrink steps)
-
+
instance Arbitrary StepText where
- arbitrary = smaller $
+ arbitrary = smaller $
StepText <$> genStepText <*> arbitrary
- shrink (StepText step block) = filter noEmptySteps $ tail' $ StepText
- <$> return step
+ shrink (StepText step block) = filter noEmptySteps $ tail' $ StepText
+ <$> return step
<*> (block : shrink block)
where
noEmptySteps (StepText ts _) = not $ null ts
-
-
+
+
instance Arbitrary BlockArg where
arbitrary = smaller $ oneof [table, pystring]
where
pystring = BlockPystring <$> arbitrary
table = BlockTable <$> arbitrary
-
-instance Arbitrary Table where
+
+instance Arbitrary Table where
arbitrary = Table <$> listOf1 genTag <*> listOf1 (listOf1 genTag)
shrink Table { table_headers
- , table_values } = tail' $ Table <$>
+ , table_values } = tail' $ Table <$>
(table_headers : shrinkRow table_headers) <*>
(table_values : shrinkRows table_values)
where
- shrinkRow [_] = []
+ shrinkRow [_] = []
shrinkRow (_:as) = [as]
shrinkRow _ = error "shrinkRow"
shrinkRows [[_]] = []
shrinkRows [(_:as)] = [[as]]
shrinkRows _ = error "shrinkRows"
instance Arbitrary Feature where
- arbitrary = Feature <$> smaller (listOf genTag) <*>
+ arbitrary = Feature <$> smaller (listOf genTag) <*>
smaller genName <*>
smaller genDescription <*>
smaller arbitrary <*>
@@ -127,7 +129,7 @@ instance Arbitrary Feature where
, feature_description
, feature_background
, feature_scenarios
- } = tail' $ Feature <$>
+ } = tail' $ Feature <$>
(feature_tags : shrinkTags feature_tags) <*>
(feature_name : shrinkName feature_name) <*>
(feature_description : shrink feature_description) <*>
@@ -136,4 +138,4 @@ instance Arbitrary Feature where
tail' :: [a] -> [a]
tail' [] = []
-tail' (_:as) = as
+tail' (_:as) = as
View
15 tests/Main.hs
@@ -55,7 +55,8 @@ tests = [
prop parseRow "|a|b|" =.= ["a", "b"]
, testProperty "roundtrip for scenario with tables" $
- let s = Scenario {scenario_name = ""
+ let s = Scenario { scenario_tags = []
+ , scenario_name = ""
, scenario_steps =
[Given (StepText "c"
(Just (BlockTable (Table {table_headers = ["y"]
@@ -76,7 +77,8 @@ tests = [
, testProperty "parse scenario-outline" $
prop parseFeature "Feature: feature\nScenario-outline: scenario\nGiven bar\nExamples:\n| header |\n|value|" =.=
feature { feature_scenarios =
- [ScenarioOutline { scenario_name = "scenario"
+ [ScenarioOutline { scenario_tags = []
+ , scenario_name = "scenario"
, scenario_steps =
[Given $ StepText
"bar" Nothing]
@@ -127,9 +129,11 @@ tests = [
, testProperty "allow empty scenarios" $
prop parseFeature "Feature: feature\nScenario: empty scenario\nScenario: second empty" =.=
- feature { feature_scenarios = [ Scenario { scenario_name = "empty scenario"
+ feature { feature_scenarios = [ Scenario { scenario_tags = []
+ , scenario_name = "empty scenario"
, scenario_steps = []}
- , Scenario { scenario_name = "second empty"
+ , Scenario { scenario_tags = []
+ , scenario_name = "second empty"
, scenario_steps = []}
]}
@@ -139,7 +143,8 @@ tests = [
, testProperty "parse feature with scenario" $
prop parseFeature "\nFeature: feature\nScenario: a scenario\nGiven first step\nThen second step" =.= feature {
- feature_scenarios = [ Scenario { scenario_name = "a scenario"
+ feature_scenarios = [ Scenario { scenario_tags = []
+ , scenario_name = "a scenario"
, scenario_steps =
[Given
(StepText "first step" Nothing)

0 comments on commit c37e59b

Please sign in to comment.
Something went wrong with that request. Please try again.