test-sandbox-compose-0.1.0: Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

import Test.Sandbox.Compose
import Options.Applicative

import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Shelly hiding (command,run,FilePath)
import Network.HTTP.Conduit
import Control.Monad
import Control.Concurrent

default (T.Text)

type Port=Int

data Command
  = Up [String]
  | Status [String]
  | Conf
  | Kill [String]
  | Logs [String]
  | Destroy
  | Daemon FilePath
  deriving Show

up :: Parser Command
up = Up <$> many (argument str (metavar "TARGET..."))

status :: Parser Command
status = Status <$> many (argument str (metavar "TARGET..."))

conf :: Parser Command
conf = pure Conf

kill :: Parser Command
kill = Kill <$> many (argument str (metavar "TARGET..."))

logs :: Parser Command
logs = Logs <$> many (argument str (metavar "TARGET..."))

destroy :: Parser Command
destroy = pure Destroy

daemon :: Parser Command
daemon = Daemon <$> strOption (long "conf" <> value "test-sandbox-compose.yml" <> metavar "CONFFILE(Yaml)")

parse :: Parser Command
parse = subparser $ foldr1 (<>) [
        command "up"      (info up (progDesc "up registered service"))
      , command "status"  (info status (progDesc "show sandbox-state"))
      , command "conf"    (info conf (progDesc "show internal-conf-file"))
      , command "kill"    (info kill (progDesc "kill service"))
      , command "logs"    (info logs (progDesc "show logs"))
      , command "destroy" (info destroy (progDesc "destroy deamon"))
      , command "daemon" (info daemon (progDesc "start daemon"))
      ]

setup :: IO Port
setup = shelly $ do
  unlessM (test_e ".sandbox/port") $
    liftIO $ do
    runServer "test-sandbox-compose.yml" False
    threadDelay $ 1*1000*1000
  content <- readfile ".sandbox/port"
  return $ read $ T.unpack content


runCmd' :: [String] -> String -> IO ()
runCmd' xs cmd' = do
  port' <- setup
  case xs of
    [] -> simpleHttp ("http://localhost:" <> show port' <> "/" <> cmd') >>= L.putStr
    xs' -> forM_ xs' $ \x ->
      simpleHttp ("http://localhost:" <> show port' <> "/" <> cmd' <> "/" <> x) >>= L.putStr

runCmd :: Command -> IO ()
runCmd (Up targets) = runCmd' targets "up"
runCmd (Status targets) = runCmd' targets "status"
runCmd (Kill targets) = runCmd' targets "kill"
runCmd (Logs targets) = runCmd' targets "logs"
runCmd Conf = runCmd' [] "conf"
runCmd Destroy = runCmd' [] "destroy"
runCmd (Daemon conf) = runServer conf True
  
opts :: ParserInfo Command
opts = info (parse <**> helper) idm

main :: IO ()
main = execParser opts >>= runCmd