bdd (empty) → 0.1.0.0

raw patch · 8 files changed

+232/−0 lines, 8 filesdep +HUnitdep +basedep +directorysetup-changed

Dependencies added: HUnit, base, directory, mtl, process, test-framework, test-framework-hunit, transformers

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• bdd.cabal +38/−0
• changelog.md +3/−0
• src/Test/Bdd.hs +56/−0
• src/Test/Bdd/Internal.hs +20/−0
• tests/system/BddTest.hs +83/−0
• tests/system/SystemTests.hs +10/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 Irek Jozwiak++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,38 @@+Name:                bdd+Version:             0.1.0.0+Synopsis:            Behavior-Driven Development DSL+Homepage:            http://github.com/humane-software/haskell-bdd+License:             MIT+License-File:        LICENSE+Author:              Irek Jozwiak, Pavlo Kerestey+Maintainer:          irek@humane.software+Category:            Testing+Stability:           experimental+Build-Type:          Simple+Cabal-Version:       >=1.10+Description:         A domain-specific language for testing programs using Behavior-Driven Development (BDD) process.++extra-source-files:+  changelog.md++Library+  exposed-modules:     Test.Bdd, Test.Bdd.Internal+  hs-source-dirs:      src+  default-language:    Haskell2010+  build-depends:       base ==4.*+                      ,HUnit+                      ,mtl+                      ,transformers+  +Test-Suite system-tests+  type:       exitcode-stdio-1.0+  other-modules:       BddTest+  main-is:    SystemTests.hs+  hs-source-dirs: tests/system, src+  build-depends: base+                ,directory+                ,HUnit+                ,mtl+                ,process+                ,test-framework+                ,test-framework-hunit

@@ -0,0 +1,3 @@+0.1.0.0++* Initial version

@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification, FlexibleContexts, ImpredicativeTypes, Rank2Types, ScopedTypeVariables #-}+module Test.Bdd (+  (^?=)+ ,Given+ ,Then+ ,When+ ,andAfter_+ ,expectError_+ ,given_+ ,noError+ ,testThat+ ,then_+ ,when_+ ) where++import Control.Monad.Error.Class+import Test.Bdd.Internal+import Test.HUnit ((@?=))++type Given m a = Monad m => m a++type When m a = Monad m => m a++type Then m a = Monad m => a -> m ()++testThat :: GivenWithTeardown m+testThat = []++infixl 1 `given_`, `when_`, `then_`+infixl 2 `andAfter_`++given_ :: (StorableAsGivenWithTeardown m g,Monad m) => GivenWithTeardown m -> g -> GivenWithTeardown m+given_ gs g = gs ++ mkGiven g++andAfter_ :: m a -> (a -> m ()) -> (m a, a -> m ())+andAfter_ = (,)++when_ :: Monad m => GivenWithTeardown m -> When m b -> m b+when_ (GivenStore (g,t):gs) w = do+  v <- g+  res <- when_ gs w+  t v+  return res+when_ [] w = w++then_ :: When m a -> Then m a -> When m a+then_ !w t = w >>= (\res-> (t $! res) >> return res)++expectError_ :: MonadError e m => When m a -> Then m e -> When m ()+expectError_ w t = (w >> fail "expected exception was not thrown") `catchError` (\e->t e)++noError :: Then m a+noError = const (return ())++(^?=) :: (Eq a, Show a) => IO a -> a -> b -> IO ()+actualF ^?= expected = (\_->actualF >>= (@?= expected))

@@ -0,0 +1,20 @@+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, MultiParamTypeClasses, Rank2Types #-}++module Test.Bdd.Internal (+  GivenStore(..)+ ,GivenWithTeardown+ ,StorableAsGivenWithTeardown(..)+ ) where++data GivenStore m = forall a. GivenStore (m a, a -> m ())++type GivenWithTeardown m = Monad m => [GivenStore m]++class StorableAsGivenWithTeardown m g where+  mkGiven :: g -> GivenWithTeardown m++instance StorableAsGivenWithTeardown m (m a) where+  mkGiven g = [GivenStore (g,const (return ()))]++instance StorableAsGivenWithTeardown m (m a, a -> m ()) where+  mkGiven = return . GivenStore

@@ -0,0 +1,83 @@+{-# LANGUAGE FlexibleContexts,RankNTypes,ScopedTypeVariables #-}++module BddTest (tests) where++import Control.Applicative ((<$>))+import Control.Arrow ((>>>))+import Control.Monad (when)+import Control.Exception+import Control.Monad.Writer+import System.Directory+import System.Process (runCommand)+import Test.Bdd+import Test.Bdd.Internal+import Test.HUnit++tests = test [++  "the most rudimentary construct (doesn't test anything yet)" ~:+    let runSomeImaginaryIOAction :: IO ()+        runSomeImaginaryIOAction = return ()+    in TestCase $+      testThat+      `when_` runSomeImaginaryIOAction++ ,"assert something" ~: do+    testThat+      `when_` writeFile "/tmp/BddTestFile" "xxx"+      `then_` readFile "/tmp/BddTestFile" ^?= "xxx"+    -- we'll explain how to teardown later+    void (runCommand "rm -f /tmp/BddTestFile")++ ,"multiple thens are possible" ~: do+    testThat+      `when_` writeFile "/tmp/BddTestFile" "xxx"+      `then_` readFile "/tmp/BddTestFile" ^?= "xxx"+      `then_` (elem "BddTestFile" <$> getDirectoryContents "/tmp/") ^?= True+    -- we'll explain how to teardown later+    void (runCommand "rm -f /tmp/BddTestFile")++ ,"preconditions are possible as givens" ~:+    let noFile :: FilePath -> Given IO ()+        noFile f = doesFileExist f >>= \b-> when b (removeFile f)+    in do+      testThat+        `given_` noFile "/tmp/BddTestFile"+        `when_` writeFile "/tmp/BddTestFile" "xxx"+        `then_` readFile "/tmp/BddTestFile" ^?= "xxx"+      -- we'll explain how to teardown later+      void (runCommand "rm -f /tmp/BddTestFile")++ -- TODO: to be implemented+ -- ,"given can have a teardown, it takes given's return value" ~:+ --    let directory :: FilePath -> Given IO FilePath+ --        directory f = removeDir f >> createDirectory f >> return f+ --        removeDir :: FilePath -> IO ()+ --        removeDir f = doesDirectoryExist f >>= \exists->+ --                      when exists (removeDirectoryRecursive f)+ --    in testThat+ --      `given_` directory "/tmp/BddTestDir" `andAfter_` removeDir+ --      `when_` writeFile "/tmp/BddTestDir/test" "xxx"+ --      `then_` readFile "/tmp/BddTestDir/test" ^?= "xxx"++ -- ,"order of execution" ~:+ --    execWriter (+ --      (testThat::GivenWithTeardown (Writer [String]))+ --      `given_` (tell ["given"]::Writer [String] ()) `andAfter_` const (tell ["teardown"])+ --      `when_` tell ["when"]+ --      `then_` const (tell ["then"])+ --     ) @?= ["given","when","then","teardown"]++ ,"can expect an error" ~:+    testThat+    `when_` readFile "/that_surely_not_exists"+    `expectError_` (show >>> (@?= "/that_surely_not_exists: openFile: does not exist (No such file or directory)"))++ ,"test will fail if expected exception not thrown" ~:+    (do+       testThat+         `when_` readFile "/etc/passwd"+         `expectError_` (show >>> (@?= "this will never be thrown"))+       fail "should fail but didn't"+     ) `catch` (\(e::SomeException)->assertBool "expectError did not fail" (show e /= "user error (should fail but didn't)"))+ ]

@@ -0,0 +1,10 @@+module Main where++import qualified BddTest+import Control.Monad (void)+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++main :: IO ()+main = defaultMain (hUnitTestToTests BddTest.tests)