#! /usr/bin/env runhaskell {-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} import Argo.Stack import Argo.Utils import Argo.Args 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 import Data.Either import Data.Maybe opts :: StackArgs -> Parser (IO ()) opts sa = hsubparser ( command "clean" (info (pure $ runClean sa) (progDesc "Clean sockets, logfiles.")) <> command "daemon-only" (info (runDaemon <$> parseExtendStackArgs sa) (progDesc "Set up and launch the daemon in synchronous mode, \ \with properly cleaned sockets, logfiles." ) ) <> command "full-stack" (info (runStack <$> parseExtendStackArgs sa) (progDesc "Setup stack and run a command in a container.") ) <> command "helloworld" (info (runStack <$> parseExtendStackArgs (let msg = "Hello-Moto" in sa { app = "echo" , args = [msg] , messageCmdOut = Just msg , messageCmdErr = Just msg } ) ) (progDesc "Test 1: Setup stack and check that a hello world app sends \ \message back to cmd." ) ) <> command "perfwrapper" (info (runStack <$> parseExtendStackArgs (sa { manifestName = "perfwrap.json" , app = "sleep" , args = ["15"] , messageDaemonOut = Just "progress" , messageDaemonErr = Just "progress" } ) ) (progDesc "Test 2: Setup stack and check that argo-perf-wrapper sends \ \ at least one progress message up." ) ) <> 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." ) main :: IO () main = do manifests <- getEnv "MANIFESTS" let a = def { manifestDir = decodeString manifests } join $ execParser (info (opts a <**> helper) idm) 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) CmdDied -> do when ( or $ isJust <$> [messageDaemonOut, messageDaemonErr, messageCmdOut, messageCmdErr] ) $ printError "Did not find message.\n" exit (ExitFailure 1) runClean :: StackArgs -> IO () runClean = sh . cleanLeftovers runDaemon :: StackArgs -> IO () runDaemon a = sh $ cleanLeftovers a >> prepareDaemon a >>= liftIO