argotk.hs 3.19 KB
Newer Older
1 2
#! /usr/bin/env runhaskell

3
{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
4 5 6

import           Argo.Stack
import           Argo.Utils
7
import           Argo.Args
8 9 10 11 12 13 14 15 16 17
import           Turtle
import           Prelude                 hiding ( FilePath )
import           Data.Default
import           Control.Concurrent.Async
import           System.Environment
import           System.Console.ANSI
import           System.Console.ANSI.Types      ( Color )
import           Options.Applicative
import           System.Posix.Signals
import           Control.Monad
18
import           Data.Either
19
import           Data.Maybe
20

21 22 23 24 25
opts :: StackArgs -> Parser (IO ())
opts sa = hsubparser
  (  command "clean"
             (info (pure $ runClean sa) (progDesc "Clean sockets, logfiles."))
  <> command
26
       "daemon-only"
27
       (info
28
         (runDaemon <$> parseExtendStackArgs sa)
29 30 31 32 33 34
         (progDesc
           "Set up and launch the daemon in synchronous mode, \
           \with properly cleaned sockets, logfiles."
         )
       )
  <> command
35 36
       "full-stack"
       (info (runStack <$> parseExtendStackArgs sa)
37 38
             (progDesc "Setup stack and run a command in a container.")
       )
39 40 41
  <> command
       "helloworld"
       (info
42 43 44 45 46 47 48 49
         (runStack <$> parseExtendStackArgs
           (let msg = "Hello-Moto"
            in  sa { app           = "echo"
                   , args          = [msg]
                   , messageCmdOut = Just msg
                   , messageCmdErr = Just msg
                   }
           )
50
         )
51
         (progDesc
52
           "Test 1: Setup stack and check that a hello world app sends \
53 54 55
           \message back to cmd."
         )
       )
56 57 58
  <> command
       "perfwrapper"
       (info
59 60 61
         (runStack <$> parseExtendStackArgs
           (sa { manifestName     = "perfwrap.json"
               , app              = "sleep"
62
               , args             = ["15"]
63 64
               , messageDaemonOut = Just "progress"
               , messageDaemonErr = Just "progress"
65 66 67
               }
           )
         )
68
         (progDesc
69 70
           "Test 2: Setup stack and check that argo-perf-wrapper sends \
           \ at least one progress message up."
71 72
         )
       )
73 74 75 76
  <> help
       "Type of test to run. There are extensive options under each action,\
       \ but be careful, these do not all have the same defaults. The default\
       \ values are printed when you call --help on these actions."
77 78 79 80 81
  )

main :: IO ()
main = do
  manifests <- getEnv "MANIFESTS"
82 83
  let a = def { manifestDir = decodeString manifests }
  join $ execParser (info (opts a <**> helper) idm)
84

85 86 87 88 89
runStack :: StackArgs -> IO ()
runStack a@StackArgs {..} = sh $ runSimpleStack a >>= \case
  FoundMessage -> printSuccess "Found message!\n" >> exit ExitSuccess
  DaemonDied ->
    printError "Daemon died unexpectedly.\n" >> exit (ExitFailure 1)
90 91 92 93 94 95 96 97
  CmdDied -> do
    when
        (   or
        $   isJust
        <$> [messageDaemonOut, messageDaemonErr, messageCmdOut, messageCmdErr]
        )
      $ printError "Did not find message.\n"
    exit (ExitFailure 1)
98

99
runClean :: StackArgs -> IO ()
100
runClean = sh . cleanLeftovers
101

102
runDaemon :: StackArgs -> IO ()
103
runDaemon a = sh $ cleanLeftovers a >> prepareDaemon a >>= liftIO