summaryrefslogtreecommitdiff
path: root/Biz/Cli.hs
blob: 0f7b6d4612e46679d732e30f404cbdff444a0346 (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
{-# 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 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