chuchu-0.1.2: Behaviour Driven Development like Cucumber for Haskell

Portabilitynon-portable (DeriveDataTypeable)
Stabilityunstable
MaintainerMarco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>
Safe HaskellNone

Test.Chuchu

Description

Chuchu is a system similar to Ruby's Cucumber for Behaviour Driven Development. It works with a language similar to Cucumber's Gherkin, which is parsed using package abacate.

This module provides the main function for a test file based on Behaviour Driven Development for Haskell.

Example for a Stack calculator:

calculator.feature:

Feature: Division
  In order to avoid silly mistakes
  Cashiers must be able to calculate a fraction

Scenario: Regular numbers
    Given that I have entered 3 into the calculator
    And that I have entered 2 into the calculator
    When I press divide
    Then the result should be 1.5 on the screen

calculator.hs:

import Control.Applicative
import Control.Monad.IO.Class
import Control.Monad.Trans.State
import Test.Chuchu
import Test.HUnit

type CalculatorT m = StateT [Double] m

enterNumber :: Monad m => Double -> CalculatorT m ()
enterNumber = modify . (:)

getDisplay :: Monad m => CalculatorT m Double
getDisplay
  = do
    ns <- get
    return $ head $ ns ++ [0]

divide :: Monad m => CalculatorT m ()
divide = do
  (n1:n2:ns) <- get
  put $ (n2 / n1) : ns

defs :: Chuchu (CalculatorT IO)
defs
  = do
    Given
      ("that I have entered " *> number <* " into the calculator")
      enterNumber
    When "I press divide" $ const divide
    Then ("the result should be " *> number <* " on the screen")
      $ \n
        -> do
          d <- getDisplay
          liftIO $ d @?= n

main :: IO ()
main = chuchuMain defs (`evalStateT` [])

Synopsis

Documentation

chuchuMain :: MonadIO m => Chuchu m -> (m () -> IO ()) -> IO ()Source

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.