--getDisplay
--defs
module
Test.Chuchu
(chuchuMain, module Test.Chuchu.Types, module Test.Chuchu.Parser)
where
import Control.Applicative
import Control.Monad
import System.Environment
import System.Exit
import System.IO
import qualified Data.IORef as I
import qualified Data.Text as T
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Text.Parsec
import Text.Parsec.Text
import System.Console.CmdArgs
import qualified Text.PrettyPrint.ANSI.Leijen as D
import Language.Abacate hiding (StepKeyword (..))
import Test.Chuchu.Types
import Test.Chuchu.Parser
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
data ExecutionPlan =
ExecutionPlan
{ epBackground :: Maybe Background
, epScenario :: FeatureElement
}
deriving (Show)
createExecutionPlans :: Abacate -> [ExecutionPlan]
createExecutionPlans feature =
ExecutionPlan (fBackground feature) `map` fFeatureElements feature
type Execution m a = ReaderT (Parser (m ())) m a
putDoc :: (MonadIO m, Applicative m) => D.Doc -> m ()
putDoc = liftIO . D.putDoc . (D.<> D.linebreak)
t2d :: T.Text -> D.Doc
t2d = D.text . T.unpack
runExecution :: (MonadIO m, Applicative m) =>
Chuchu m -> (m () -> IO ()) -> Execution m () -> IO ()
runExecution cc runMIO act = runMIO $ runReaderT act $ runChuchu cc
processAbacate :: (MonadIO m, Applicative m) =>
Chuchu m
-> (m () -> IO ())
-> Abacate
-> IO Bool
processAbacate cc runMIO feature = do
putDoc $ describeAbacate feature
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
processExecutionPlan :: (MonadIO m, Applicative m) => ExecutionPlan -> Execution m Bool
processExecutionPlan (ExecutionPlan mbackground scenario) = do
putDoc D.empty
(&&) <$> maybe (return True) (processBasicScenario BackgroundKind) mbackground
<*> processFeatureElement scenario
describeAbacate :: Abacate -> D.Doc
describeAbacate feature =
D.vsep $
describeTags (fTags feature) ++ [D.white $ t2d $ fHeader feature]
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)
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
putDoc $ describeStep SuccessfulStep step
lift m
return True
data StepResult = SuccessfulStep | UnknownStep
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."])