add --json-output flag to status command

camus2.cabal

@@ -48,6 +48,7 @@ executable c2
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , aeson >= 1.0 && < 1.5
+                     , aeson-pretty >= 0.8.7 && < 0.9
                      , amazonka >= 1.4 && < 1.7
                      , amazonka-core >= 1.4 && < 1.7
                      , amazonka-ecr >= 1.4 && < 1.7

src/Commands/ProxyMode.hs

@@ -15,8 +15,10 @@ module Commands.ProxyMode(
 
 import qualified ADL.Core.StringMap as SM
 import qualified Data.Aeson as JS
+import qualified Data.Aeson.Encode.Pretty as JS
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map as M
+import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
@@ -25,7 +27,7 @@ import qualified Network.HTTP.Client as HC
 import qualified Network.AWS.EC2.Metadata as EC2M
 
 import ADL.Config(EndPoint(..), EndPointType(..))
-import ADL.Core(adlFromJsonFile', adlToJsonFile)
+import ADL.Core(adlFromJsonFile', adlToJsonFile, adlToJson)
 import ADL.Release(ReleaseConfig(..))
 import ADL.Config(ToolConfig(..), DeployMode(..), ProxyModeConfig(..), MachineLabel(..))
 import ADL.State(State(..), Deploy(..), SlaveState(..), SlaveStatus(..))
@@ -54,8 +56,42 @@ import System.Process(callCommand)
 import Types(IOR, REnv(..), getToolConfig, scopeInfo, flushlog, info, lerror)
 
 -- | Show the proxy system status, specifically the endpoints and live deploys.
-showStatus :: Bool -> IOR ()
-showStatus showSlaves = do
+showStatus :: Bool -> Bool -> IOR ()
+showStatus showSlaves jsonOutput = do
+  case jsonOutput of
+     True  -> jsonStatus showSlaves
+     False -> textStatus showSlaves
+
+jsonStatus :: Bool -> IOR ()
+jsonStatus showSlaves = do
+  master <- fmap adlToJson getState
+  jv <- case showSlaves of
+    False -> do
+      return ( JS.toJSON ( HM.fromList [
+          ("master" :: String, master)
+        ]))
+    True -> do
+      slaves <- fmap (JS.toJSON . map slaveToJson) getSlaveStates
+      return ( JS.toJSON ( HM.fromList [
+          ("master" :: String, master),
+          ("slaves" :: String, slaves)
+        ]))
+  liftIO $ LBS.putStrLn (JS.encodePretty jv)
+
+  return ()
+  where
+    slaveToJson :: (T.Text, LastModified SlaveState) -> JS.Value
+    slaveToJson (label,slave) = JS.toJSON (HM.fromList [
+        ("label":: String, JS.toJSON label),
+        ("lastModified":: String, JS.toJSON (lm_modifiedAt slave)),
+        ("state":: String, adlToJson (lm_value slave))
+      ])
+
+
+
+
+textStatus :: Bool -> IOR ()
+textStatus showSlaves = do
   pm <- getProxyModeConfig
   state <- getState
   liftIO $ T.putStrLn "---------------------MASTER-------------------------------------------"

src/Main.hs

@@ -48,7 +48,7 @@ data Command
   | UnpackRelease (T.Text,FilePath)
   | ExpandTemplate (FilePath,FilePath)
   | AwsDockerLoginCmd
-  | Status Bool
+  | Status Bool Bool
   | Start (T.Text,Maybe T.Text)
   | Stop T.Text
   | Connect (T.Text,T.Text)
@@ -136,13 +136,18 @@ expandTemplateParser = ExpandTemplate <$> arguments
    arguments = (,) <$> fileArgument "TEMPLATE" <*> fileArgument "OUTFILE"
 
 statusParser :: Parser Command
-statusParser = Status <$> showSlaves
+statusParser = Status <$> showSlaves <*> jsonOutput
  where
    showSlaves :: Parser Bool
    showSlaves = flag False True
      (  long "show-slaves"
      <> help "include per slave status"
      )
+   jsonOutput :: Parser Bool
+   jsonOutput = flag False True
+     (  long "json-output"
+     <> help "output as json"
+     )
 
 startParser :: Parser Command
 startParser = Start <$> arguments
@@ -219,7 +224,7 @@ runCommand (FetchContext retry) = runWithConfigAndLog (U.fetchConfigContext retr
 runCommand (UnpackRelease (release,toDir)) = runWithConfigAndLog (U.unpackRelease id release toDir)
 runCommand (ExpandTemplate (templatePath,destPath)) = runWithConfigAndLog (U.injectContext id templatePath destPath)
 runCommand AwsDockerLoginCmd = runWithConfigAndLog (C.awsDockerLoginCmd)
-runCommand (Status showSlaves) = runWithConfig (P.showStatus showSlaves)
+runCommand (Status showSlaves jsonOutput) = runWithConfig (P.showStatus showSlaves jsonOutput)
 runCommand (Start (release,mdeploy)) = runWithConfigAndLog (C.createAndStart release (fromMaybe (deployNameFromRelease release) mdeploy))
 runCommand (Stop deploy) = runWithConfigAndLog (C.stopDeploy deploy)
 runCommand (Connect (endpoint,deploy)) = runWithConfigAndLog (P.connect endpoint deploy)