From e77cdc025b0e80049344f258d9ca170d0953d0d7 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 15 Jan 2021 21:11:30 -0500 Subject: Implement Biz.Test with tasty Also changes the --test option to a 'test' command. This is because running the tests for a namespace/exe should never be combined with anything else: you either want to run the tests, or not. --- Biz/Cli.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'Biz/Cli.hs') diff --git a/Biz/Cli.hs b/Biz/Cli.hs index f2d7fad..cdd2f80 100644 --- a/Biz/Cli.hs +++ b/Biz/Cli.hs @@ -14,13 +14,16 @@ module Biz.Cli where import Alpha +import qualified Data.Text as Text import qualified System.Console.Docopt as Docopt import qualified System.Environment as Environment +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.Runners as Tasty data Plan = Plan { help :: Docopt.Docopt, move :: Docopt.Arguments -> IO (), - test :: Docopt.Arguments -> IO () + test :: Tasty.TestTree } main :: Plan -> IO () @@ -28,9 +31,18 @@ main Plan {..} = Environment.getArgs >>= Docopt.parseArgsOrExit help >>= \args -> - if args `has` Docopt.longOption "test" - then test args + if args `has` Docopt.command "test" + then runTests test else move args +runTests :: Tasty.TestTree -> IO () +runTests tree = do + Tasty.installSignalHandlers + case Tasty.tryIngredients Tasty.defaultIngredients mempty tree of + Nothing -> do + hPutStrLn stderr <| Text.pack "no ingredients agreed to run" + exitFailure + Just act -> act >>= \ok -> if ok then exitSuccess else exitFailure + has :: Docopt.Arguments -> Docopt.Option -> Bool has = Docopt.isPresent -- cgit v1.2.3