diff options
| -rw-r--r-- | Biz/Cli.hs | 17 | ||||
| -rw-r--r-- | Biz/Test.hs | 13 |
2 files changed, 16 insertions, 14 deletions
@@ -18,16 +18,14 @@ 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 +import qualified Biz.Test as Test data Plan cfg = Plan { help :: Docopt.Docopt, move :: Docopt.Arguments -> IO (), - test :: Tasty.TestTree, + test :: Test.Tree, tidy :: cfg -> IO () } @@ -37,20 +35,11 @@ main Plan {..} = +> Docopt.parseArgsOrExit help +> \args -> if args `has` Docopt.command "test" - then runTests test + then Test.run test else if args `has` Docopt.longOption "help" then Docopt.exitWithUsage help 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 diff --git a/Biz/Test.hs b/Biz/Test.hs index fdd89f8..994a7ce 100644 --- a/Biz/Test.hs +++ b/Biz/Test.hs @@ -5,6 +5,7 @@ -- : dep tasty-quickcheck module Biz.Test ( Tree, + run, group, unit, prop, @@ -17,12 +18,24 @@ module Biz.Test where import Alpha hiding (group) +import qualified Data.Text as Text import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit import qualified Test.Tasty.QuickCheck as QuickCheck +import qualified Test.Tasty.Runners as Tasty type Tree = Tasty.TestTree +run :: Tree -> IO () +run 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 + + group :: Tasty.TestName -> [Tasty.TestTree] -> Tasty.TestTree group = Tasty.testGroup |