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
56
|
{-# 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 cfg = Plan
{ help :: Docopt.Docopt,
move :: Docopt.Arguments -> IO (),
test :: Tasty.TestTree,
tidy :: cfg -> IO ()
}
main :: Plan cfg -> 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
|
