chuchu 0.1.4 → 0.2
raw patch · 12 files changed
+694/−692 lines, 12 filesdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: text
API changes (from Hackage documentation)
- Test.Chuchu.Parser: email :: ChuchuParser String
+ Test.Chuchu.Parser: email :: ChuchuParser Text
- Test.Chuchu.Parser: text :: ChuchuParser String
+ Test.Chuchu.Parser: text :: ChuchuParser Text
- Test.Chuchu.Parser: wildcard :: String -> ChuchuParser ()
+ Test.Chuchu.Parser: wildcard :: Text -> ChuchuParser ()
Files
- Test/Chuchu.hs +0/−314
- Test/Chuchu/Email.hs +0/−32
- Test/Chuchu/Parsec.hs +0/−215
- Test/Chuchu/Parser.hs +0/−59
- Test/Chuchu/Types.hs +0/−67
- chuchu.cabal +3/−1
- src/Test/Chuchu.hs +314/−0
- src/Test/Chuchu/Email.hs +32/−0
- src/Test/Chuchu/Parsec.hs +215/−0
- src/Test/Chuchu/Parser.hs +56/−0
- src/Test/Chuchu/Types.hs +67/−0
- tests/environment.hs +7/−4
− Test/Chuchu.hs
@@ -1,314 +0,0 @@--- |--- Module : Test.Chuchu--- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012--- License : Apache 2.0 (see the file LICENSE)------ Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>--- 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-import qualified Data.IORef as I---- text-import qualified Data.Text as T---- 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---- ansi-wl-pprint-import qualified Text.PrettyPrint.ANSI.Leijen as D---- 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, Applicative m) => Chuchu m -> (m () -> IO ()) -> IO ()-chuchuMain cc runMIO- = do- path <- getPath- parsed <- parseFile path- case parsed of- Right abacate -> do- ret <- processAbacate cc runMIO abacate- unless ret exitFailure- Left e -> error $ "Could not parse " ++ path ++ ": " ++ show e------------------------------------------------------------------------------ | 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, 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 =- D.vsep $- describeTags (fTags feature) ++ [D.white $ t2d $ fHeader feature]----- | Creates a vertical list of tags.-describeTags :: Tags -> [D.Doc]-describeTags = map (D.dullcyan . ("@" D.<>) . t2d)----------------------------------------------------------------------------processFeatureElement :: (MonadIO m, Applicative m) => FeatureElement -> Execution m Bool-processFeatureElement (FESO _)- = liftIO (hPutStrLn stderr "Scenario Outlines are not supported yet.")- >> return False-processFeatureElement (FES sc) =- processBasicScenario (ScenarioKind $ scTags sc) $ scBasicScenario sc---data BasicScenarioKind = BackgroundKind | ScenarioKind Tags---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 =- D.indent 2 $- prettyTags kind $- D.bold ((describeBasicScenarioKind kind) D.<+> t2d (bsName scenario))- where describeBasicScenarioKind BackgroundKind = "Background:"- describeBasicScenarioKind (ScenarioKind _) = "Scenario:"-- prettyTags BackgroundKind = id- prettyTags (ScenarioKind tags) = D.vsep . (describeTags tags ++) . (:[])----------------------------------------------------------------------------processSteps :: (MonadIO m, Applicative m) => Steps -> Execution m Bool-processSteps steps- = do- codes <- mapM processStep steps- return $ and codes---processStep :: (MonadIO m, Applicative m) => Step -> Execution m Bool-processStep step- = do- cc <- ask- case parse cc "processStep" $ stBody step of- Left e- -> do- putDoc $ describeStep UnknownStep step- liftIO- $ hPutStrLn stderr- $ "The step "- ++ show (stBody step)- ++ " doesn't match any step definitions I know."- ++ show e- return False- Right m -> do- -- TODO: Catch failures and treat them nicely.- putDoc $ describeStep SuccessfulStep step- 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 =- D.indent 4 $- color result (D.text (show $ stStepKeyword step) D.<+> t2d (stBody step))- where- color SuccessfulStep = D.green- color UnknownStep = D.yellow----------------------------------------------------------------------------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."])
− Test/Chuchu/Email.hs
@@ -1,32 +0,0 @@--- |--- Module : Test.Chuchu.Parsec--- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012--- License : Apache 2.0 (see the file LICENSE)------ Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>--- 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--- <http://porg.es/blog/email-address-validation-simpler-faster-more-correct>.-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 "!#$%&'*+-/=?^_`{|}~."
− Test/Chuchu/Parsec.hs
@@ -1,215 +0,0 @@-{-# OPTIONS_GHC -w #-}--- |--- Module : Test.Chuchu.Parsec--- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012--- License : Apache 2.0 (see the file LICENSE)------ Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>--- 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)- }
− Test/Chuchu/Parser.hs
@@ -1,59 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--- |--- Module : Test.Chuchu.Parser--- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012--- License : Apache 2.0 (see the file LICENSE)------ Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>--- Stability : unstable--- Portability : non-portable (TypeSynonymInstances, FlexibleInstances)------ This modules provides some utility parsers for creating step rules.-module Test.Chuchu.Parser- ( ChuchuParser- , number- , int- , text- , wildcard- , email- ) where---- base-import Control.Applicative hiding ((<|>))-import Control.Monad---- parsec-import Text.Parsec---- chuchu-import Test.Chuchu.Types (ChuchuParser(..))-import qualified Test.Chuchu.Parsec as P-import Test.Chuchu.Email---- | Parses a floating point number, with the same syntax as accepted by--- Haskell.-number :: ChuchuParser Double-number = ChuchuParser $ nofToDouble <$> P.natFloat--nofToDouble :: Either Integer Double -> Double-nofToDouble (Left i) = fromInteger i-nofToDouble (Right d) = d---- | Parses an integer.-int :: ChuchuParser Integer-int = ChuchuParser P.int---- | Parses a quoted string, with the same syntax as accepted by Haskell.-text :: ChuchuParser String-text = ChuchuParser P.stringLiteral---- | Parses anything until the string passed as parameter, and also the string.-wildcard :: String -> ChuchuParser ()-wildcard = ChuchuParser . 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 :: ChuchuParser String-email = ChuchuParser addrSpecSimple
− Test/Chuchu/Types.hs
@@ -1,67 +0,0 @@--- |--- Module : Test.Chuchu.Types--- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012--- License : Apache 2.0 (see the file LICENSE)------ Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>--- Stability : unstable--- Portability : non-portable (GADTs, GeneralizedNewtypeDeriving)-module- Test.Chuchu.Types- (ChuchuParser (..), Chuchu, ChuchuM (Given, When, Then, And, But), runChuchu)- where---- base-import Control.Applicative hiding ((<|>))-import Control.Monad (MonadPlus)-import Data.String---- parsec-import Text.Parsec-import Text.Parsec.Text----- | @newtype@ for Parsec's 'Parser' used on this library. The--- main reason for not using 'Parser' directly is to be able to--- define the 'IsString' instance.-newtype ChuchuParser a = ChuchuParser (Parser a)- deriving (Functor, Applicative, Alternative, Monad, MonadPlus)--instance (a ~ ()) => IsString (ChuchuParser a) where- fromString s = ChuchuParser (string s >> return ())----- | 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',--- '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 :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()- When :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()- Then :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()- And :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()- But :: ChuchuParser 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 $ error "(>>=): ChuchuM does not support 'return'."---- | 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 :: ChuchuParser a -> (a -> m ()) -> Parser (m ())-apply (ChuchuParser p) f = try $ f <$> p <* eof
chuchu.cabal view
@@ -1,5 +1,5 @@ name: chuchu-version: 0.1.4+version: 0.2 cabal-version: >= 1.8 build-type: Simple license: OtherLicense@@ -29,6 +29,7 @@ location: git://github.com/marcotmarcot/chuchu.git library+ hs-source-dirs: src exposed-modules: Test.Chuchu, Test.Chuchu.Types,@@ -54,6 +55,7 @@ build-depends: base >= 4 && < 5, unix >= 2.5 && < 2.6,+ text, chuchu, HUnit >= 1.2 && < 1.3 extensions: OverloadedStrings
+ src/Test/Chuchu.hs view
@@ -0,0 +1,314 @@+-- |+-- Module : Test.Chuchu+-- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012+-- License : Apache 2.0 (see the file LICENSE)+--+-- Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>+-- 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+import qualified Data.IORef as I++-- text+import qualified Data.Text as T++-- 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++-- ansi-wl-pprint+import qualified Text.PrettyPrint.ANSI.Leijen as D++-- 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, Applicative m) => Chuchu m -> (m () -> IO ()) -> IO ()+chuchuMain cc runMIO+ = do+ path <- getPath+ parsed <- parseFile path+ case parsed of+ Right abacate -> do+ ret <- processAbacate cc runMIO abacate+ unless ret exitFailure+ Left e -> error $ "Could not parse " ++ path ++ ": " ++ show e+++----------------------------------------------------------------------+++-- | 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, 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 =+ D.vsep $+ describeTags (fTags feature) ++ [D.white $ t2d $ fHeader feature]+++-- | Creates a vertical list of tags.+describeTags :: Tags -> [D.Doc]+describeTags = map (D.dullcyan . ("@" D.<>) . t2d)+++----------------------------------------------------------------------+++processFeatureElement :: (MonadIO m, Applicative m) => FeatureElement -> Execution m Bool+processFeatureElement (FESO _)+ = liftIO (hPutStrLn stderr "Scenario Outlines are not supported yet.")+ >> return False+processFeatureElement (FES sc) =+ processBasicScenario (ScenarioKind $ scTags sc) $ scBasicScenario sc+++data BasicScenarioKind = BackgroundKind | ScenarioKind Tags+++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 =+ D.indent 2 $+ prettyTags kind $+ D.bold ((describeBasicScenarioKind kind) D.<+> t2d (bsName scenario))+ where describeBasicScenarioKind BackgroundKind = "Background:"+ describeBasicScenarioKind (ScenarioKind _) = "Scenario:"++ prettyTags BackgroundKind = id+ prettyTags (ScenarioKind tags) = D.vsep . (describeTags tags ++) . (:[])+++----------------------------------------------------------------------+++processSteps :: (MonadIO m, Applicative m) => Steps -> Execution m Bool+processSteps steps+ = do+ codes <- mapM processStep steps+ return $ and codes+++processStep :: (MonadIO m, Applicative m) => Step -> Execution m Bool+processStep step+ = do+ cc <- ask+ case parse cc "processStep" $ stBody step of+ Left e+ -> do+ putDoc $ describeStep UnknownStep step+ liftIO+ $ hPutStrLn stderr+ $ "The step "+ ++ show (stBody step)+ ++ " doesn't match any step definitions I know."+ ++ show e+ return False+ Right m -> do+ -- TODO: Catch failures and treat them nicely.+ putDoc $ describeStep SuccessfulStep step+ 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 =+ D.indent 4 $+ color result (D.text (show $ stStepKeyword step) D.<+> t2d (stBody step))+ where+ color SuccessfulStep = D.green+ color UnknownStep = D.yellow+++----------------------------------------------------------------------+++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."])
+ src/Test/Chuchu/Email.hs view
@@ -0,0 +1,32 @@+-- |+-- Module : Test.Chuchu.Parsec+-- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012+-- License : Apache 2.0 (see the file LICENSE)+--+-- Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>+-- 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+-- <http://porg.es/blog/email-address-validation-simpler-faster-more-correct>.+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 "!#$%&'*+-/=?^_`{|}~."
+ src/Test/Chuchu/Parsec.hs view
@@ -0,0 +1,215 @@+{-# OPTIONS_GHC -w #-}+-- |+-- Module : Test.Chuchu.Parsec+-- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012+-- License : Apache 2.0 (see the file LICENSE)+--+-- Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>+-- 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)+ }
+ src/Test/Chuchu/Parser.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Test.Chuchu.Parser+-- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012+-- License : Apache 2.0 (see the file LICENSE)+--+-- Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>+-- Stability : unstable+-- Portability : non-portable (TypeSynonymInstances, FlexibleInstances)+--+-- This modules provides some utility parsers for creating step rules.+module Test.Chuchu.Parser+ ( ChuchuParser+ , number+ , int+ , text+ , wildcard+ , email+ ) where++import Control.Applicative hiding ((<|>))+import Control.Monad+import Text.Parsec+import qualified Data.Text as T++import Test.Chuchu.Types (ChuchuParser(..))+import Test.Chuchu.Email+import qualified Test.Chuchu.Parsec as P++-- | Parses a floating point number, with the same syntax as accepted by+-- Haskell.+number :: ChuchuParser Double+number = ChuchuParser $ nofToDouble <$> P.natFloat++nofToDouble :: Either Integer Double -> Double+nofToDouble (Left i) = fromInteger i+nofToDouble (Right d) = d++-- | Parses an integer.+int :: ChuchuParser Integer+int = ChuchuParser P.int++-- | Parses a quoted string, with the same syntax as accepted by Haskell.+text :: ChuchuParser T.Text+text = T.pack <$> ChuchuParser P.stringLiteral++-- | Parses anything until the string passed as parameter, and also the string.+wildcard :: T.Text -> ChuchuParser ()+wildcard = ChuchuParser . void . manyTill anyChar . string . T.unpack++-- | Parses a simplified e-mail address and return everything that was parsed as+-- a simple 'T.Text'. 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 :: ChuchuParser T.Text+email = T.pack <$> ChuchuParser addrSpecSimple
+ src/Test/Chuchu/Types.hs view
@@ -0,0 +1,67 @@+-- |+-- Module : Test.Chuchu.Types+-- Copyright : (c) Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> 2012+-- License : Apache 2.0 (see the file LICENSE)+--+-- Maintainer : Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com>+-- Stability : unstable+-- Portability : non-portable (GADTs, GeneralizedNewtypeDeriving)+module+ Test.Chuchu.Types+ (ChuchuParser (..), Chuchu, ChuchuM (Given, When, Then, And, But), runChuchu)+ where++-- base+import Control.Applicative hiding ((<|>))+import Control.Monad (MonadPlus)+import Data.String++-- parsec+import Text.Parsec+import Text.Parsec.Text+++-- | @newtype@ for Parsec's 'Parser' used on this library. The+-- main reason for not using 'Parser' directly is to be able to+-- define the 'IsString' instance.+newtype ChuchuParser a = ChuchuParser (Parser a)+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus)++instance (a ~ ()) => IsString (ChuchuParser a) where+ fromString s = ChuchuParser (string s >> return ())+++-- | 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',+-- '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 :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()+ When :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()+ Then :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()+ And :: ChuchuParser a -> (a -> m ()) -> ChuchuM m ()+ But :: ChuchuParser 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 $ error "(>>=): ChuchuM does not support 'return'."++-- | 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 :: ChuchuParser a -> (a -> m ()) -> Parser (m ())+apply (ChuchuParser p) f = try $ f <$> p <* eof
tests/environment.hs view
@@ -17,6 +17,9 @@ import Data.Maybe import System.Environment hiding (getEnv) +-- text+import qualified Data.Text as T+ -- unix import System.Posix.Env @@ -31,21 +34,21 @@ = do Given "that I start the test" $ \() -> return () When ("I set the " *> wildcard " as " *> text <* " into the environment")- $ \x -> setEnv "environment" x True+ $ \x -> setEnv "environment" (T.unpack x) True Then ("the " *> wildcard " should have " *> text <* " on its content")- $ \n -> fromJust <$> getEnv "environment" >>= (@?= n)+ $ \n -> fromJust <$> getEnv "environment" >>= (@?= T.unpack n) When ("I set the " *> wildcard " as e-mail " *> email <* " into the environment")- $ \x -> setEnv "environment" x True+ $ \x -> setEnv "environment" (T.unpack x) True Then ("the " *> wildcard " should have e-mail " *> email <* " on its content")- $ \n -> fromJust <$> getEnv "environment" >>= (@?= n)+ $ \n -> fromJust <$> getEnv "environment" >>= (@?= T.unpack n) main :: IO () main = withArgs ["tests/data/environment.feature"] $ chuchuMain defs id