blob: 8398399030d0dfae20b09274b3d3b2a2a9466bc7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : dep docopt
module Biz.Cli
( Plan (..),
main,
Docopt.Docopt (..),
Docopt.Arguments,
Docopt.argument,
Docopt.docopt,
Docopt.getAllArgs,
Docopt.getArg,
Docopt.longOption,
Docopt.command,
has,
)
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 :: Tasty.TestTree
}
main :: Plan -> IO ()
main Plan {..} =
Environment.getArgs
+> Docopt.parseArgsOrExit help
+> \args ->
if args `has` Docopt.command "test"
then runTests 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
|
