chuchu 0.1.2 → 0.1.3

raw patch · 7 files changed

+224/−43 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Test/Chuchu.hs +101/−40
• Test/Chuchu/Types.hs +1/−1
• chuchu.cabal +28/−2
• tests/background_and_multiple_scenarios.hs +32/−0
• tests/data/background_and_multiple_scenarios.feature +21/−0
• tests/data/multiple_scenarios.feature +13/−0
• tests/multiple_scenarios.hs +28/−0

@@ -83,6 +83,7 @@ import System.Environment import System.Exit import System.IO+import qualified Data.IORef as I  -- text import qualified Data.Text as T@@ -109,67 +110,116 @@ import Test.Chuchu.Types import Test.Chuchu.Parser ++----------------------------------------------------------------------++ -- | The main function for the test file.  It expects the @.feature@ file as the -- first parameter on the command line.  If you want to use it inside a library, -- consider using 'withArgs'.-chuchuMain :: MonadIO m => Chuchu m -> (m () -> IO ()) -> IO ()+chuchuMain :: (MonadIO m, Applicative m) => Chuchu m -> (m () -> IO ()) -> IO () chuchuMain cc runMIO   = do     path <- getPath     parsed <- parseFile path     case parsed of-      (Right abacate)-        -> runMIO-          $ runReaderT-            (do-              code <- processAbacate abacate-              unless code $ liftIO exitFailure)-          $ runChuchu cc-      (Left e) -> error $ "Could not parse " ++ path ++ ": " ++ show e+      Right abacate -> do+        ret <- processAbacate cc runMIO abacate+        unless ret exitFailure+      Left e -> error $ "Could not parse " ++ path ++ ": " ++ show e -type CM m a = ReaderT (Parser (m ())) m a +---------------------------------------------------------------------- -processAbacate :: MonadIO m => Abacate -> CM m Bool-processAbacate feature-  = do-    -- Print feature description.-    putDoc $ describeAbacate feature -    -- Execute features.-    bCode-      <- case fBackground feature of-        Nothing -> return True-        Just background -> processBasicScenario BackgroundKind background-    feCode <- processFeatureElements $ fFeatureElements feature-    return $ bCode && feCode+-- | An execution plan for a scenario.  Currently just a simple+-- record with a background (optional) and a scenario.+data ExecutionPlan =+  ExecutionPlan+    { epBackground :: Maybe Background+    , epScenario   :: FeatureElement+    }+  deriving (Show) ++-- | Creates an execution plan for a feature.+createExecutionPlans :: Abacate -> [ExecutionPlan]+createExecutionPlans feature =+  ExecutionPlan (fBackground feature) `map` fFeatureElements feature+++----------------------------------------------------------------------+++-- | Monad used when executing a feature's scenario.  'ReaderT'+-- is used to carry along the step parser.+type Execution m a = ReaderT (Parser (m ())) m a++ -- | Print a 'D.Doc' describing what we're currently processing.-putDoc :: MonadIO m => D.Doc -> CM m ()+putDoc :: (MonadIO m, Applicative m) => D.Doc -> m () putDoc = liftIO . D.putDoc . (D.<> D.linebreak) ++-- | Same as 'D.text' but using 'T.Text'.+t2d :: T.Text -> D.Doc+t2d = D.text . T.unpack+++-- | Run the 'Execution' monad.+runExecution :: (MonadIO m, Applicative m) =>+                Chuchu m -> (m () -> IO ()) -> Execution m () -> IO ()+runExecution cc runMIO act = runMIO $ runReaderT act $ runChuchu cc+++----------------------------------------------------------------------+++-- | Process a whole Abacate file, that is, a whole feature.+-- Runs each background+scenario combination on a different+-- instance of the 'Execution' monad.+processAbacate :: (MonadIO m, Applicative m) =>+                  Chuchu m+               -> (m () -> IO ())+               -> Abacate+               -> IO Bool+processAbacate cc runMIO feature = do+  -- Print feature description.+  putDoc $ describeAbacate feature++  -- Execute features.+  let plans = createExecutionPlans feature+  retVar <- liftIO $ I.newIORef True+  let checkRet ret = unless ret $ liftIO $ I.writeIORef retVar False+  mapM_ (runExecution cc runMIO . (>>= checkRet) . processExecutionPlan) plans+  liftIO $ I.readIORef retVar+++-- | Process a single execution plan, a combination of+-- background+scenario, inside the 'Execution' monad.+processExecutionPlan :: (MonadIO m, Applicative m) => ExecutionPlan -> Execution m Bool+processExecutionPlan (ExecutionPlan mbackground scenario) = do+  putDoc D.empty -- empty line+  (&&) <$> maybe (return True) (processBasicScenario BackgroundKind) mbackground+       <*> processFeatureElement scenario++ -- | Creates a pretty description of the feature. describeAbacate :: Abacate -> D.Doc describeAbacate feature =-  (if null (fTags feature) then id else (describeTags (fTags feature) D.<$>)) $-  D.white (t2d (fHeader feature))+  D.vsep $+  describeTags (fTags feature) ++ [D.white $ t2d $ fHeader feature] + -- | Creates a vertical list of tags.-describeTags :: Tags -> D.Doc-describeTags = D.vsep . map (D.dullcyan . ("@" D.<>) . t2d)+describeTags :: Tags -> [D.Doc]+describeTags = map (D.dullcyan . ("@" D.<>) . t2d) --- | Same as 'D.text' but using 'T.Text'.-t2d :: T.Text -> D.Doc-t2d = D.text . T.unpack +---------------------------------------------------------------------- -processFeatureElements :: MonadIO m => FeatureElements -> CM m Bool-processFeatureElements featureElements-  = do-    codes <- mapM processFeatureElement featureElements-    return $ and codes -processFeatureElement :: MonadIO m => FeatureElement -> CM m Bool+processFeatureElement :: (MonadIO m, Applicative m) => FeatureElement -> Execution m Bool processFeatureElement (FESO _)   = liftIO (hPutStrLn stderr "Scenario Outlines are not supported yet.")     >> return False@@ -179,11 +229,13 @@  data BasicScenarioKind = BackgroundKind | ScenarioKind Tags -processBasicScenario :: MonadIO m => BasicScenarioKind -> BasicScenario -> CM m Bool++processBasicScenario :: (MonadIO m, Applicative m) => BasicScenarioKind -> BasicScenario -> Execution m Bool processBasicScenario kind scenario = do   putDoc $ describeBasicScenario kind scenario   processSteps (bsSteps scenario) + -- | Creates a pretty description of the basic scenario's header. describeBasicScenario :: BasicScenarioKind -> BasicScenario -> D.Doc describeBasicScenario kind scenario =@@ -194,17 +246,20 @@           describeBasicScenarioKind (ScenarioKind _) = "Scenario:"            prettyTags BackgroundKind      = id-          prettyTags (ScenarioKind tags) = (describeTags tags D.<$>)+          prettyTags (ScenarioKind tags) = D.vsep . (describeTags tags ++) . (:[])  +---------------------------------------------------------------------- -processSteps :: MonadIO m => Steps -> CM m Bool++processSteps :: (MonadIO m, Applicative m) => Steps -> Execution m Bool processSteps steps   = do     codes <- mapM processStep steps     return $ and codes -processStep :: MonadIO m => Step -> CM m Bool++processStep :: (MonadIO m, Applicative m) => Step -> Execution m Bool processStep step   = do     cc <- ask@@ -225,8 +280,10 @@         lift m         return True + data StepResult = SuccessfulStep | UnknownStep + -- | Pretty-prints a step that has already finished executing. describeStep :: StepResult -> Step -> D.Doc describeStep result step =@@ -237,9 +294,13 @@       color UnknownStep    = D.yellow  +----------------------------------------------------------------------++ data Options   = Options {file_ :: FilePath}     deriving (Eq, Show, Typeable, Data)+  getPath :: IO FilePath getPath

@@ -30,7 +30,7 @@   fromString s = ChuchuParser (string s >> return ())  --- | The most command use case where the return value of the Monad is ignored.+-- | The most common use case where the return value of the Monad is ignored. type Chuchu m  = ChuchuM m ()  -- | The Monad on which the step rules are constructed.  'Given', 'When',

@@ -1,5 +1,5 @@ name: chuchu-version: 0.1.2+version: 0.1.3 cabal-version: >= 1.8 build-type: Simple license: OtherLicense@@ -20,7 +20,9 @@ extra-source-files:   tests/data/environment.feature,   tests/data/calculator.feature,-  tests/data/prefix.feature+  tests/data/prefix.feature,+  tests/data/multiple_scenarios.feature,+  tests/data/background_and_multiple_scenarios.feature  source-repository head   type:     git@@ -72,6 +74,30 @@ Test-Suite prefix   type: exitcode-stdio-1.0   main-is: prefix.hs+  hs-source-dirs: tests+  build-depends:+    base >= 4 && < 5,+    transformers >= 0.3 && < 0.4,+    chuchu,+    HUnit >= 1.2 && < 1.3+  extensions: OverloadedStrings+  ghc-options: -Wall++Test-Suite multiple_scenarios+  type: exitcode-stdio-1.0+  main-is: multiple_scenarios.hs+  hs-source-dirs: tests+  build-depends:+    base >= 4 && < 5,+    transformers >= 0.3 && < 0.4,+    chuchu,+    HUnit >= 1.2 && < 1.3+  extensions: OverloadedStrings+  ghc-options: -Wall++Test-Suite background_and_multiple_scenarios+  type: exitcode-stdio-1.0+  main-is: background_and_multiple_scenarios.hs   hs-source-dirs: tests   build-depends:     base >= 4 && < 5,

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Control.Applicative+import Control.Monad.Trans.State+import System.Environment+import Test.Chuchu+++type Bathroom = StateT Door IO+++data Door = Open | Locked+++defs :: Chuchu Bathroom+defs = do++  Given "that the bathroom's door is open" $ \_ ->+         put Open++  Given ("that " *> text <* " has entered the bathroom and locked the door") $ \_ -> do+    door <- get+    case door of+      Open -> put Locked+      Locked -> fail "Door was already locked."+++main :: IO ()+main =  withArgs ["tests/data/background_and_multiple_scenarios.feature"] $+        chuchuMain defs (`evalStateT` Locked)

@@ -0,0 +1,21 @@+Feature: A Background and Multiple scenarios++  This feature has a background that must be executed before the+  execution of each scenario. Both scenarios succeed when executed in+  different features and must succeed when executed in the same+  feature.++  However, due to a bug in chuchu (<= 0.1.2), the test fails if both+  scenarios are in the same feature because chuchu only executes the+  background on the beginning of the test and not before each+  scenario.+++  Background: Bathroom's door is open+    Given that the bathroom's door is open++  Scenario: Anybody can use the bathroom+    Given that "Bob" has entered the bathroom and locked the door++  Scenario: Anybody can use the bathroom+    Given that "Alice" has entered the bathroom and locked the door

@@ -0,0 +1,13 @@+Feature: Multiple scenarios++  This feature consists of two scenarios that must succeed regardless+  of being in the same feature.++  However, due to a bug in chuchu (<= 0.1.2), the scenarios succeed+  if executed individually but fail if executed together.++  Scenario: Anybody can use the bathroom+    Given that "Bob" has entered the bathroom and locked the door++  Scenario: Anybody can use the bathroom+    Given that "Alice" has entered the bathroom and locked the door

@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Control.Applicative+import Control.Monad.Trans.State+import System.Environment+import Test.Chuchu+++type Bathroom = StateT Door IO+++data Door = Open | Locked+++defs :: Chuchu Bathroom+defs = do++  Given ("that " *> text <* " has entered the bathroom and locked the door") $ \_ -> do+    door <- get+    case door of+      Open -> put Locked+      Locked -> fail "Door was already locked."++main :: IO ()+main = withArgs ["tests/data/multiple_scenarios.feature"] $+       chuchuMain defs (`evalStateT` Open)