diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/Test/Chuchu.hs b/Test/Chuchu.hs new file mode 100644 --- /dev/null +++ b/Test/Chuchu.hs @@ -0,0 +1,186 @@ +-- | +-- Module : Test.Chuchu +-- Copyright : (c) Marco Túlio Pimenta Gontijo 2012 +-- License : Apache 2.0 (see the file LICENSE) +-- +-- Maintainer : Marco Túlio Pimenta Gontijo +-- Stability : unstable +-- Portability : non-portable (DeriveDataTypeable) +-- +-- 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\` []) +-- @ + +module + Test.Chuchu + (chuchuMain, module Test.Chuchu.Types, module Test.Chuchu.Parser) + where + +-- base +import Control.Applicative +import Control.Monad +import System.Environment +import System.Exit +import System.IO + +-- transformers +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader + +-- parsec +import Text.Parsec +import Text.Parsec.Text + +-- cmdargs +import System.Console.CmdArgs + +-- abacate +import Language.Abacate hiding (StepKeyword (..)) + +-- chuchu +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 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 + +type CM m a = ReaderT (Parser (m ())) m a + +processAbacate :: MonadIO m => Abacate -> CM m Bool +processAbacate feature + = do + bCode + <- case fBackground feature of + Nothing -> return True + Just background -> processBasicScenario background + feCode <- processFeatureElements $ fFeatureElements feature + return $ bCode && feCode + +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 (FESO _) + = liftIO (hPutStrLn stderr "Scenario Outlines are not supported yet.") + >> return False +processFeatureElement (FES sc) = processBasicScenario $ scBasicScenario sc + +processBasicScenario :: MonadIO m => BasicScenario -> CM m Bool +processBasicScenario = processSteps . bsSteps + +processSteps :: MonadIO m => Steps -> CM m Bool +processSteps steps + = do + codes <- mapM processStep steps + return $ and codes + +processStep :: MonadIO m => Step -> CM m Bool +processStep step + = do + cc <- ask + case parse cc "processStep" $ stBody step of + Left e + -> do + liftIO + $ hPutStrLn stderr + $ "The step " + ++ show (stBody step) + ++ " doesn't match any step definitions I know." + ++ show e + return False + Right m -> lift m >> return True + +data Options + = Options {file_ :: FilePath} + deriving (Eq, Show, Typeable, Data) + +getPath :: IO FilePath +getPath + = do + progName <- getProgName + file_ + <$> cmdArgs + (Options (def &= typ "PATH" &= argPos 0) + &= program progName + &= details + ["Run test scenarios specified on the abacate file at PATH."]) diff --git a/Test/Chuchu/Email.hs b/Test/Chuchu/Email.hs new file mode 100644 --- /dev/null +++ b/Test/Chuchu/Email.hs @@ -0,0 +1,32 @@ +-- | +-- Module : Test.Chuchu.Parsec +-- Copyright : (c) Marco Túlio Pimenta Gontijo 2012 +-- License : Apache 2.0 (see the file LICENSE) +-- +-- Maintainer : Marco Túlio Pimenta Gontijo +-- Stability : unstable +-- Portability : portable +-- +-- This is a very simplified parser for e-mail, which does not follow RFC5322. +-- Basically, it parses @TEXT\@TEXT@, where TEXT is @alphaNum <|> oneOf +-- "!#$%&'*+-/=?^_`{|}~."@. It's loosely based on +-- . +module Test.Chuchu.Email (addrSpecSimple) where + +-- base +import Control.Applicative hiding ((<|>), many, optional) + +-- parsec +import Text.Parsec +import Text.Parsec.Text + +-- | Parses a simplified e-mail address and return everything that was parsed as +-- a simple 'String'. +addrSpecSimple :: Parser String +addrSpecSimple = concat <$> sequence [atomWithDot, string "@", atomWithDot] + +atomWithDot :: Parser String +atomWithDot = many1 atomTextWithDot + +atomTextWithDot :: Parser Char +atomTextWithDot = alphaNum <|> oneOf "!#$%&'*+-/=?^_`{|}~." diff --git a/Test/Chuchu/Parsec.hs b/Test/Chuchu/Parsec.hs new file mode 100644 --- /dev/null +++ b/Test/Chuchu/Parsec.hs @@ -0,0 +1,215 @@ +{-# OPTIONS_GHC -w #-} +-- | +-- Module : Test.Chuchu.Parsec +-- Copyright : (c) Marco Túlio Pimenta Gontijo 2012 +-- License : Apache 2.0 (see the file LICENSE) +-- +-- Maintainer : Marco Túlio Pimenta Gontijo +-- Stability : unstable +-- Portability : portable +-- +-- This is from the where clause of 'makeTokenParser' with types included and +-- calls to 'lexeme' removed in the functions where this is noted. +-- +-- Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- This software is provided by the copyright holders "as is" and any express or +-- implied warranties, including, but not limited to, the implied warranties of +-- merchantability and fitness for a particular purpose are disclaimed. In no +-- event shall the copyright holders be liable for any direct, indirect, +-- incidental, special, exemplary, or consequential damages (including, but not +-- limited to, procurement of substitute goods or services; loss of use, data, +-- or profits; or business interruption) however caused and on any theory of +-- liability, whether in contract, strict liability, or tort (including +-- negligence or otherwise) arising in any way out of the use of this software, +-- even if advised of the possibility of such damage. + + +module Test.Chuchu.Parsec (stringLiteral, natFloat, int) where + +-- base +import Data.Char + +-- parsec +import Text.Parsec +import Text.Parsec.Text + +{-# ANN module ("HLint: ignore" :: String) #-} +-- | 'lexeme' removed. +stringLiteral :: Parser String +stringLiteral = do{ str <- between (char '"') + (char '"' "end of string") + (many stringChar) + ; return (foldr (maybe id (:)) "" str) + } + "literal string" + +stringChar :: Parser (Maybe Char) +stringChar = do{ c <- stringLetter; return (Just c) } + <|> stringEscape + "string character" + + +stringLetter :: Parser Char +stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026')) + +stringEscape :: Parser (Maybe Char) +stringEscape = do{ char '\\' + ; do{ escapeGap ; return Nothing } + <|> do{ escapeEmpty; return Nothing } + <|> do{ esc <- escapeCode; return (Just esc) } + } + +escapeEmpty :: Parser Char +escapeEmpty = char '&' + + +escapeGap :: Parser Char +escapeGap = do{ many1 space + ; char '\\' "end of string gap" + } + +escapeCode :: Parser Char +escapeCode = charEsc <|> charNum <|> charAscii <|> charControl + "escape code" + +charControl :: Parser Char +charControl = do{ char '^' + ; code <- upper + ; return (toEnum (fromEnum code - fromEnum 'A')) + } + +charNum :: Parser Char +charNum = do{ code <- decimal + <|> do{ char 'o'; number 8 octDigit } + <|> do{ char 'x'; number 16 hexDigit } + ; return (toEnum (fromInteger code)) + } + +charEsc :: Parser Char +charEsc = choice (map parseEsc escMap) + where + parseEsc (c,code) = do{ char c; return code } + +charAscii :: Parser Char +charAscii = choice (map parseAscii asciiMap) + where + parseAscii (asc,code) = try (do{ string asc; return code }) + + +-- escape code tables +escMap = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'") +asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) + +ascii2codes = ["BS","HT","LF","VT","FF","CR","SO","SI","EM", + "FS","GS","RS","US","SP"] +ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL", + "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB", + "CAN","SUB","ESC","DEL"] + +ascii2 = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI', + '\EM','\FS','\GS','\RS','\US','\SP'] +ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK', + '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK', + '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL'] + + +natFloat :: Parser (Either Integer Double) +natFloat = do{ char '0' + ; zeroNumFloat + } + <|> decimalFloat + +zeroNumFloat :: Parser (Either Integer Double) +zeroNumFloat = do{ n <- hexadecimal <|> octal + ; return (Left n) + } + <|> decimalFloat + <|> fractFloat 0 + <|> return (Left 0) + +decimalFloat :: Parser (Either Integer Double) +decimalFloat = do{ n <- decimal + ; option (Left n) + (fractFloat n) + } + +fractFloat :: Integer -> Parser (Either Integer Double) +fractFloat n = do{ f <- fractExponent n + ; return (Right f) + } + +fractExponent :: Integer -> Parser Double +fractExponent n = do{ fract <- fraction + ; expo <- option 1.0 exponent' + ; return ((fromInteger n + fract)*expo) + } + <|> + do{ expo <- exponent' + ; return ((fromInteger n)*expo) + } +fraction :: Parser Double +fraction = do{ char '.' + ; digits <- many1 digit "fraction" + ; return (foldr op 0.0 digits) + } + "fraction" + where + op d f = (f + fromIntegral (digitToInt d))/10.0 + +exponent' :: Parser Double +exponent' = do{ oneOf "eE" + ; f <- sign + ; e <- decimal "exponent" + ; return (power (f e)) + } + "exponent" + where + power e | e < 0 = 1.0/power(-e) + | otherwise = fromInteger (10^e) + +-- | 'lexeme' removed. +int :: Parser Integer +int = do{ f <- sign + ; n <- nat + ; return (f n) + } + +sign :: Num a => Parser (a -> a) +sign = (char '-' >> return negate) + <|> (char '+' >> return id) + <|> return id + +nat :: Parser Integer +nat = zeroNumber <|> decimal + +zeroNumber :: Parser Integer +zeroNumber = do{ char '0' + ; hexadecimal <|> octal <|> decimal <|> return 0 + } + "" + +decimal :: Parser Integer +decimal = number 10 digit + +hexadecimal :: Parser Integer +hexadecimal = do{ oneOf "xX"; number 16 hexDigit } + +octal :: Parser Integer +octal = do{ oneOf "oO"; number 8 octDigit } + +number base baseDigit + = do{ digits <- many1 baseDigit + ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits + ; seq n (return n) + } diff --git a/Test/Chuchu/Parser.hs b/Test/Chuchu/Parser.hs new file mode 100644 --- /dev/null +++ b/Test/Chuchu/Parser.hs @@ -0,0 +1,56 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | +-- Module : Test.Chuchu.Parser +-- Copyright : (c) Marco Túlio Pimenta Gontijo 2012 +-- License : Apache 2.0 (see the file LICENSE) +-- +-- Maintainer : Marco Túlio Pimenta Gontijo +-- Stability : unstable +-- Portability : non-portable (TypeSynonymInstances, FlexibleInstances) +-- +-- This modules provides some utility parsers for creating step rules. +module Test.Chuchu.Parser (number, int, text, wildcard, email) where + +-- base +import Control.Applicative hiding ((<|>)) +import Control.Monad +import GHC.Exts + +-- parsec +import Text.Parsec +import Text.Parsec.Text + +-- chuchu +import qualified Test.Chuchu.Parsec as P +import Test.Chuchu.Email + +instance IsString (Parser a) where + fromString s = void (string s) >> return undefined + +-- | Parses a floating point number, with the same syntax as accepted by +-- Haskell. +number :: Parser Double +number = nofToDouble <$> P.natFloat + +nofToDouble :: Either Integer Double -> Double +nofToDouble (Left i) = fromInteger i +nofToDouble (Right d) = d + +-- | Parses an integer. +int :: Parser Integer +int = P.int + +-- | Parses a quoted string, with the same syntax as accepted by Haskell. +text :: Parser String +text = P.stringLiteral + +-- | Parses anything until the string passed as parameter, and also the string. +wildcard :: String -> Parser () +wildcard = void . manyTill anyChar . string + +-- | Parses a simplified e-mail address and return everything that was parsed as +-- a simple 'String'. This is a very simplified parser for e-mail, which does +-- not follow RFC5322. Basically, it parses @TEXT\@TEXT@, where TEXT is +-- @alphaNum \<|> oneOf \"!#$%&\'*+-\/=?^_\`{|}~.\"@. +email :: Parser String +email = addrSpecSimple diff --git a/Test/Chuchu/Types.hs b/Test/Chuchu/Types.hs new file mode 100644 --- /dev/null +++ b/Test/Chuchu/Types.hs @@ -0,0 +1,54 @@ +-- | +-- Module : Test.Chuchu.Types +-- Copyright : (c) Marco Túlio Pimenta Gontijo 2012 +-- License : Apache 2.0 (see the file LICENSE) +-- +-- Maintainer : Marco Túlio Pimenta Gontijo +-- Stability : unstable +-- Portability : non-portable (GADTs) +module + Test.Chuchu.Types + (Chuchu, ChuchuM (Given, When, Then, And, But), runChuchu) + where + +-- base +import Control.Applicative hiding ((<|>)) + +-- parsec +import Text.Parsec +import Text.Parsec.Text + +-- | The most command 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', +-- 'Then', 'And' and 'But' are interpreted in the same way by the program. All +-- of them receive a parser and an action to run if the parser finishes +-- correctly. +data ChuchuM m a where + Given :: Parser a -> (a -> m ()) -> ChuchuM m () + When :: Parser a -> (a -> m ()) -> ChuchuM m () + Then :: Parser a -> (a -> m ()) -> ChuchuM m () + And :: Parser a -> (a -> m ()) -> ChuchuM m () + But :: Parser a -> (a -> m ()) -> ChuchuM m () + Nil :: ChuchuM m a + Cons :: ChuchuM m b -> ChuchuM m a -> ChuchuM m a + +instance Monad (ChuchuM m) where + return _ = Nil + step >>= k = Cons step $ k undefined + +-- | Converts the Monad into a single 'Parser' that executes the specified +-- action if the parser is executed correctly. It includes an 'eof' on the +-- parser of each step to avoid it from accepting prefixes of the desired rule. +runChuchu :: ChuchuM m a -> Parser (m ()) +runChuchu Nil = unexpected "Unknown step" +runChuchu (Cons cc1 cc2) = runChuchu cc1 <|> runChuchu cc2 +runChuchu (Given p f) = apply p f +runChuchu (When p f) = apply p f +runChuchu (Then p f) = apply p f +runChuchu (And p f) = apply p f +runChuchu (But p f) = apply p f + +apply :: Parser a -> (a -> m ()) -> Parser (m ()) +apply p f = try $ f <$> p <* eof diff --git a/chuchu.cabal b/chuchu.cabal new file mode 100644 --- /dev/null +++ b/chuchu.cabal @@ -0,0 +1,77 @@ +name: chuchu +version: 0.0.0.0 +cabal-version: >= 1.8 +build-type: Simple +license: OtherLicense +license-file: LICENSE +copyright: 2012 Marco Túlio Pimenta Gontijo +author: Marco Túlio Pimenta Gontijo +maintainer: Marco Túlio Pimenta Gontijo +stability: experimental +homepage: http://github.com/marcotmarcot/chuchu +bug-reports: http://github.com/marcotmarcot/chuchu/issues +synopsis: Behaviour Driven Development for Haskell +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. +category: Test +tested-with: GHC ==7.4.2 +extra-source-files: + tests/data/environment.feature, + tests/data/calculator.feature, + tests/data/prefix.feature + +library + exposed-modules: + Test.Chuchu, + Test.Chuchu.Types, + Test.Chuchu.Parser + other-modules: + Test.Chuchu.Parsec, + Test.Chuchu.Email + build-depends: + base >= 4 && < 5, + text >= 0.11 && < 0.12, + transformers >= 0.3 && < 0.4, + parsec >= 3.1 && < 3.2, + cmdargs >= 0.9 && < 0.10, + abacate >= 0.0 && < 0.1 + extensions: DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances, GADTs + ghc-options: -Wall + +Test-Suite environment + type: exitcode-stdio-1.0 + main-is: environment.hs + hs-source-dirs: tests + build-depends: + base >= 4 && < 5, + unix >= 2.5 && < 2.6, + chuchu, + HUnit >= 1.2 && < 1.3 + extensions: OverloadedStrings + ghc-options: -Wall + +Test-Suite calculator + type: exitcode-stdio-1.0 + main-is: calculator.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 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 diff --git a/tests/calculator.hs b/tests/calculator.hs new file mode 100644 --- /dev/null +++ b/tests/calculator.hs @@ -0,0 +1,61 @@ +-- Copyright 2012 Marco Túlio Pimenta Gontijo +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- base +import Control.Applicative +import System.Environment + +-- transformers +import Control.Monad.IO.Class +import Control.Monad.Trans.State + +-- chuchu +import Test.Chuchu + +-- HUnit +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 $ (n1 / n2) : 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 + = withArgs ["tests/data/calculator.feature"] + $ chuchuMain defs (`evalStateT` []) diff --git a/tests/data/calculator.feature b/tests/data/calculator.feature new file mode 100644 --- /dev/null +++ b/tests/data/calculator.feature @@ -0,0 +1,27 @@ +# Copyright 2012 Marco Túlio Pimenta Gontijo +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +# Of course it needs calc! +@needs_calc +@nice_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 2 into the calculator + # Comment! =) + And that I have entered 3 into the calculator + When I press divide + Then the result should be 1.5 on the screen diff --git a/tests/data/environment.feature b/tests/data/environment.feature new file mode 100644 --- /dev/null +++ b/tests/data/environment.feature @@ -0,0 +1,26 @@ +# Copyright 2012 Marco Túlio Pimenta Gontijo +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +Feature: Environment + In order to use the enviroment variables + Programmers must be able to write and read environment variables + + Scenario: Write then read + When I set the variable as "environment" into the environment + # Comment! =) + Then the variable should have "environment" on its content + + Scenario: E-mail variables + When I set the as e-mail marcotmarcot@gmail.com into the environment + Then the should have e-mail marcotmarcot@gmail.com on its content diff --git a/tests/data/prefix.feature b/tests/data/prefix.feature new file mode 100644 --- /dev/null +++ b/tests/data/prefix.feature @@ -0,0 +1,22 @@ +# Copyright 2012 Marco Túlio Pimenta Gontijo +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +Feature: Don't match prefixes + In order to write scenarios without worrying + Programmers must be able to write steps that are prefix of others + + Scenario: Prefixes + When I add 1 + And I add 1 2 times + Then the result should be 3 diff --git a/tests/environment.hs b/tests/environment.hs new file mode 100644 --- /dev/null +++ b/tests/environment.hs @@ -0,0 +1,50 @@ +-- Copyright 2012 Marco Túlio Pimenta Gontijo +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- base +import Control.Applicative +import Data.Maybe +import System.Environment hiding (getEnv) + +-- unix +import System.Posix.Env + +-- chuchu +import Test.Chuchu + +-- HUnit +import Test.HUnit + +defs :: Chuchu IO +defs + = do + When ("I set the " *> wildcard " as " *> text <* " into the environment") + $ \x -> setEnv "environment" x True + Then ("the " *> wildcard " should have " *> text <* " on its content") + $ \n -> fromJust <$> getEnv "environment" >>= (@?= n) + When + ("I set the " + *> wildcard " as e-mail " + *> email + <* " into the environment") + $ \x -> setEnv "environment" x True + Then + ("the " + *> wildcard " should have e-mail " + *> email + <* " on its content") + $ \n -> fromJust <$> getEnv "environment" >>= (@?= n) + +main :: IO () +main = withArgs ["tests/data/environment.feature"] $ chuchuMain defs id diff --git a/tests/prefix.hs b/tests/prefix.hs new file mode 100644 --- /dev/null +++ b/tests/prefix.hs @@ -0,0 +1,42 @@ +-- Copyright 2012 Marco Túlio Pimenta Gontijo +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- base +import Control.Applicative +import System.Environment + +-- transformers +import Control.Monad.IO.Class +import Control.Monad.Trans.State + +-- chuchu +import Test.Chuchu + +-- HUnit +import Test.HUnit + +type CalculatorT m = StateT Integer m + +defs :: Chuchu (CalculatorT IO) +defs + = do + When ("I add " *> int) $ \x -> modify (+ x) + When ((,) <$ "I add " <*> int <* " " <*> int <* " times") + $ \(n, x) -> modify (+ n * x) + When ("the result should be " *> int) $ \x -> get >>= liftIO . (@?= x) + +main :: IO () +main + = withArgs ["tests/data/prefix.feature"] + $ chuchuMain defs (`evalStateT` 0)