argotk.hs 1.98 KB
Newer Older
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 57 58 59
#! /usr/bin/env nix-shell
#! nix-shell -i runhaskell -A test

{-# LANGUAGE
    OverloadedStrings
  , LambdaCase
  , RecordWildCards #-}

import Argotest
import Turtle
import Data.Default
import Control.Concurrent.Async
import System.Console.ANSI
import System.Console.ANSI.Types (Color)
import Options.Applicative
import System.Posix.Signals
import Control.Monad

opts :: Parser (IO ())
opts = subparser
  ( command "clean" (info (pure $ runClean def) idm)<> help "Target for the greeting"
 <> command "daemon"  (info (pure $ runDaemon def) idm)
 <> command "helloworld"  (info (pure $ runArgoTest def) idm) )

main :: IO ()
main = join $ execParser (info (opts <**>helper) idm)

runArgoTest :: StackArgs -> IO ()
runArgoTest a@StackArgs{..} = sh $ do
  cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log

  daemonShell <- prepareDaemonShell dargs daemon_out daemon_err nrm_log
  daemonAsync <- fork $ sh $ daemonShell
  let handler = do
                sh $ printInfo "Interrupted. Killing daemon..."
                cancel daemonAsync
                sh $ colorShell Green $ printf "Killed daemon.\n"
  liftIO $ installHandler keyboardSignal (Catch handler) Nothing

  printInfo "Launching the application through cmd.\n"
  (_,t) <- time $
    shell (format ("cmd run -u toto "%fp%"  "%fp%" > "%fp%" 2>"%fp) manifest app cmd_out cmd_err) empty >>= \case
      ExitSuccess   -> printInfo "cmd has exited successfuly.\n"
      ExitFailure n -> die ("cmd failed with exit code " <> repr n <>
        " . The application logs are at " <> repr cmd_out <> " " <> repr cmd_err )
  liftIO $ writeTextFile time_file (repr t)

  printInfo "Killing the daemon.\n"
  liftIO $ cancel daemonAsync
  printInfo "Daemon killed.\n"

runClean :: StackArgs -> IO ()
runClean StackArgs{..} = sh $
  cleanLeftovers daemon_out daemon_err cmd_out cmd_err time_file nrm_log

runDaemon :: StackArgs -> IO ()
runDaemon StackArgs{..} = sh $ do
  daemonShell <- prepareDaemonShell dargs daemon_out daemon_err nrm_log
  daemonShell